{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}

-- | An abstract view over the filesystem.
module System.FS.API (
    -- * Record that abstracts over the filesystem
    HasFS (..)
    -- * Types
  , module Types
    -- * Opening and closing files
  , hClose'
  , withFile
    -- * SomeHasFS
  , SomeHasFS (..)
    -- * File I\/O with user-supplied buffers
  , BufferOffset (..)
  , hGetBufExactly
  , hGetBufExactlyAt
  , hPutBufExactly
  , hPutBufExactlyAt
  ) where

import           Control.DeepSeq (NFData (..))
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Primitive (PrimMonad (..))
import qualified Data.ByteString as BS
import           Data.Int (Int64)
import           Data.Primitive (MutableByteArray)
import           Data.Set (Set)
import           Data.Word
import           SafeWildCards
import           System.Posix.Types (ByteCount)

import           System.FS.API.Types as Types
import           System.FS.CallStack

{------------------------------------------------------------------------------
  Record that abstracts over the filesystem
------------------------------------------------------------------------------}

-- | Abstract interface for performing file I\/O
--
-- [User-supplied buffers #user-supplied-buffers#]: For functions that require
--     user-supplied buffers (i.e., 'MutableByteArray'), it is the user's
--     responsiblity to provide buffers that are large enough. Behaviour is
--     undefined if the I\/O operations access the buffer outside it's allocated
--     range.
data HasFS m h = HasFS {
    -- | Debugging: human-readable description of file system state
    forall (m :: * -> *) h. HasFS m h -> m String
dumpState                :: m String

    -- Operations of files

    -- | Open a file
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hOpen                    :: HasCallStack => FsPath -> OpenMode -> m (Handle h)

    -- | Close a file
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose                   :: HasCallStack => Handle h -> m ()

    -- | Is the handle open?
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hIsOpen                  :: HasCallStack => Handle h -> m Bool

    -- | Seek handle
    --
    -- The offset is an 'Int64' rather than a 'Word64' because it may be
    -- negative (for use in relative positioning).
    --
    -- Unlike the Posix @lseek@, 'hSeek' does not return the new seek position
    -- because the value returned by Posix is rather strange and unreliable
    -- and we don't want to emulate it's behaviour.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hSeek                    :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()

    -- | Try to read @n@ bytes from a handle
    --
    -- When at the end of the file, an empty bytestring will be returned.
    --
    -- The returned bytestring will typically have length @n@, but may be
    -- shorter in case of a partial read, see #277. However, a partial read
    -- will always return at least 1 byte, as returning 0 bytes would mean
    -- that we have reached EOF.
    --
    -- Postcondition: for the length of the returned bytestring @bs@ we have
    -- @length bs >= 0@ and @length bs <= n@.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSome                 :: HasCallStack => Handle h -> Word64 -> m BS.ByteString

    -- | Same as 'hGetSome', but does not affect the file offset. An additional argument
    -- is used to specify the offset. This allows it to be called concurrently for the
    -- same file handle. However, the actual level of parallelism achieved depends on
    -- the implementation and the operating system: generally on Unix it will be
    -- \"more parallel\" than on Windows.
  , forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt               :: HasCallStack
                             => Handle h
                             -> Word64    -- The number of bytes to read.
                             -> AbsOffset -- The offset at which to read.
                             -> m BS.ByteString

    -- | Write to a handle
    --
    -- The return value indicates the number of bytes written and will
    -- typically be equal to @l@, the length of the bytestring, but may be
    -- shorter in case of a partial write, see #277.
    --
    -- If nothing can be written at all, an exception will be thrown.
    --
    -- Postcondition: the return value @n@ is @n > 0@ and @n <= l@, unless the
    -- given bytestring is empty, in which case @n@ can be 0.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hPutSome                 :: HasCallStack => Handle h -> BS.ByteString -> m Word64

    -- | Truncate the file to the specified size
    --
    -- NOTE: Only supported in append mode.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hTruncate                :: HasCallStack => Handle h -> Word64 -> m ()

    -- | Return current file size
    --
    -- NOTE: This is not thread safe (changes made to the file in other threads
    -- may affect this thread).
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hGetSize                 :: HasCallStack => Handle h -> m Word64

    -- Operations of directories

    -- | Create new directory
  , forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
createDirectory          :: HasCallStack => FsPath -> m ()

    -- | Create new directory if it doesn't exist.
    --
    -- @createDirectoryIfMissing True@ will also try to create all parent dirs.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()

    -- | List contents of a directory
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory            :: HasCallStack => FsPath -> m (Set String)

    -- | Check if the path exists and is a directory
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist       :: HasCallStack => FsPath -> m Bool

    -- | Check if the path exists and is a file
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist            :: HasCallStack => FsPath -> m Bool

    -- | Remove the directory (which must exist) and its contents
  , forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
removeDirectoryRecursive :: HasCallStack => FsPath -> m ()

    -- | Remove the file (which must exist)
  , forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
removeFile               :: HasCallStack => FsPath -> m ()

    -- | Rename the file (which must exist) from the first path to the second
    -- path. If there is already a file at the latter path, it is replaced by
    -- the new one.
    --
    -- NOTE: only works for files within the same folder.
  , forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
renameFile               :: HasCallStack => FsPath -> FsPath -> m ()

    -- | Useful for better error reporting
  , forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath            :: FsPath -> FsErrorPath

    -- | Create an absolute 'FilePath' from a relative 'FsPath'.
    --
    -- This is an escape hatch for creating absolute paths when @m ~'IO'@.
    --
    -- Postcondition: Should throw an error for any @m@ that is not @IO@
    -- (or for which we do not have @'MonadIO' m@).
  , forall (m :: * -> *) h. HasFS m h -> FsPath -> m String
unsafeToFilePath         :: FsPath -> m FilePath

    -- === File I\/O with user-supplied buffers

    -- | Like 'hGetSome', but the bytes are read into a user-supplied buffer.
    -- See [__User-supplied buffers__](#user-supplied-buffers).
  , forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hGetBufSome   :: HasCallStack
                  => Handle h
                  -> MutableByteArray (PrimState m) -- ^ Buffer to read bytes into
                  -> BufferOffset -- ^ Offset into buffer
                  -> ByteCount -- ^ The number of bytes to read
                  -> m ByteCount
    -- | Like 'hGetSomeAt', but the bytes are read into a user-supplied buffer.
    -- See [__User-supplied buffers__](#user-supplied-buffers).
  , forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hGetBufSomeAt :: HasCallStack
                  => Handle h
                  -> MutableByteArray (PrimState m)   -- ^ Buffer to read bytes into
                  -> BufferOffset -- ^ Offset into buffer
                  -> ByteCount -- ^ The number of bytes to read
                  -> AbsOffset -- ^ The file offset at which to read
                  -> m ByteCount
    -- | Like 'hPutSome', but the bytes are written from a user-supplied buffer.
    -- See [__User-supplied buffers__](#user-supplied-buffers).
  , forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hPutBufSome   :: HasCallStack
                  => Handle h
                  -> MutableByteArray (PrimState m) -- ^ Buffer to write bytes from
                  -> BufferOffset -- ^ Offset into buffer
                  -> ByteCount -- ^ The number of bytes to write
                  -> m ByteCount
    -- | Like 'hPutSome', but the bytes are written from a user-supplied buffer
    -- at a given file offset. This offset does not affect the offset stored in
    -- the file handle (see also 'hGetSomeAt'). See [__User-supplied buffers__](#user-supplied-buffers).
  , forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hPutBufSomeAt :: HasCallStack
                  => Handle h
                  -> MutableByteArray (PrimState m)   -- ^ Buffer to write bytes from
                  -> BufferOffset -- ^ Offset into buffer
                  -> ByteCount -- ^ The number of bytes to write
                  -> AbsOffset -- ^ The file offset at which to write
                  -> m ByteCount
  }

{-------------------------------------------------------------------------------
  Opening and closing files
-------------------------------------------------------------------------------}

withFile :: (HasCallStack, MonadThrow m)
         => HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile :: forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS{m String
HasCallStack => Bool -> FsPath -> m ()
HasCallStack => Handle h -> m Bool
HasCallStack => Handle h -> m Word64
HasCallStack => Handle h -> m ()
HasCallStack => Handle h -> Word64 -> m ()
HasCallStack => Handle h -> Word64 -> m ByteString
HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
HasCallStack => Handle h -> ByteString -> m Word64
HasCallStack => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> m String
FsPath -> FsErrorPath
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
removeDirectoryRecursive :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
unsafeToFilePath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> m String
hGetBufSome :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hGetBufSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hPutBufSome :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hPutBufSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
dumpState :: m String
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
hClose :: HasCallStack => Handle h -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
createDirectory :: HasCallStack => FsPath -> m ()
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
listDirectory :: HasCallStack => FsPath -> m (Set String)
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
doesFileExist :: HasCallStack => FsPath -> m Bool
removeDirectoryRecursive :: HasCallStack => FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
mkFsErrorPath :: FsPath -> FsErrorPath
unsafeToFilePath :: FsPath -> m String
hGetBufSome :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufSomeAt :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufSome :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufSomeAt :: HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
..} FsPath
fp OpenMode
openMode = m (Handle h) -> (Handle h -> m ()) -> (Handle h -> m a) -> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen FsPath
fp OpenMode
openMode) HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose

-- | Returns 'True' when the handle was still open.
hClose' :: (HasCallStack, Monad m) => HasFS m h -> Handle h -> m Bool
hClose' :: forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> m Bool
hClose' HasFS { HasCallStack => Handle h -> m ()
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hClose :: HasCallStack => Handle h -> m ()
hClose, HasCallStack => Handle h -> m Bool
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hIsOpen :: HasCallStack => Handle h -> m Bool
hIsOpen } Handle h
h = do
    Bool
isOpen <- HasCallStack => Handle h -> m Bool
Handle h -> m Bool
hIsOpen Handle h
h
    if Bool
isOpen then do
      HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose Handle h
h
      Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else
      Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-------------------------------------------------------------------------------
  SomeHasFS
-------------------------------------------------------------------------------}

-- | It is often inconvenient to have to parameterise over @h@. This data type
-- hides an existential @h@ parameter of a 'HasFS'.
data SomeHasFS m where
  SomeHasFS :: Eq h => HasFS m h -> SomeHasFS m

{-------------------------------------------------------------------------------
  File I\/O with user-supplied buffers
-------------------------------------------------------------------------------}

-- | Absolute offset into a buffer (i.e., 'MutableByteArray').
--
-- Can be negative, because buffer offsets can be added together to change
-- offset positions. This is similar to 'plusPtr' for 'Ptr' types. However, note
-- that reading or writing from a buffer at a negative offset leads to undefined
-- behaviour.
newtype BufferOffset = BufferOffset { BufferOffset -> Int
unBufferOffset :: Int }
  deriving (BufferOffset -> BufferOffset -> Bool
(BufferOffset -> BufferOffset -> Bool)
-> (BufferOffset -> BufferOffset -> Bool) -> Eq BufferOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferOffset -> BufferOffset -> Bool
== :: BufferOffset -> BufferOffset -> Bool
$c/= :: BufferOffset -> BufferOffset -> Bool
/= :: BufferOffset -> BufferOffset -> Bool
Eq, Eq BufferOffset
Eq BufferOffset =>
(BufferOffset -> BufferOffset -> Ordering)
-> (BufferOffset -> BufferOffset -> Bool)
-> (BufferOffset -> BufferOffset -> Bool)
-> (BufferOffset -> BufferOffset -> Bool)
-> (BufferOffset -> BufferOffset -> Bool)
-> (BufferOffset -> BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset -> BufferOffset)
-> Ord BufferOffset
BufferOffset -> BufferOffset -> Bool
BufferOffset -> BufferOffset -> Ordering
BufferOffset -> BufferOffset -> BufferOffset
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BufferOffset -> BufferOffset -> Ordering
compare :: BufferOffset -> BufferOffset -> Ordering
$c< :: BufferOffset -> BufferOffset -> Bool
< :: BufferOffset -> BufferOffset -> Bool
$c<= :: BufferOffset -> BufferOffset -> Bool
<= :: BufferOffset -> BufferOffset -> Bool
$c> :: BufferOffset -> BufferOffset -> Bool
> :: BufferOffset -> BufferOffset -> Bool
$c>= :: BufferOffset -> BufferOffset -> Bool
>= :: BufferOffset -> BufferOffset -> Bool
$cmax :: BufferOffset -> BufferOffset -> BufferOffset
max :: BufferOffset -> BufferOffset -> BufferOffset
$cmin :: BufferOffset -> BufferOffset -> BufferOffset
min :: BufferOffset -> BufferOffset -> BufferOffset
Ord, Int -> BufferOffset
BufferOffset -> Int
BufferOffset -> [BufferOffset]
BufferOffset -> BufferOffset
BufferOffset -> BufferOffset -> [BufferOffset]
BufferOffset -> BufferOffset -> BufferOffset -> [BufferOffset]
(BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset)
-> (Int -> BufferOffset)
-> (BufferOffset -> Int)
-> (BufferOffset -> [BufferOffset])
-> (BufferOffset -> BufferOffset -> [BufferOffset])
-> (BufferOffset -> BufferOffset -> [BufferOffset])
-> (BufferOffset -> BufferOffset -> BufferOffset -> [BufferOffset])
-> Enum BufferOffset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BufferOffset -> BufferOffset
succ :: BufferOffset -> BufferOffset
$cpred :: BufferOffset -> BufferOffset
pred :: BufferOffset -> BufferOffset
$ctoEnum :: Int -> BufferOffset
toEnum :: Int -> BufferOffset
$cfromEnum :: BufferOffset -> Int
fromEnum :: BufferOffset -> Int
$cenumFrom :: BufferOffset -> [BufferOffset]
enumFrom :: BufferOffset -> [BufferOffset]
$cenumFromThen :: BufferOffset -> BufferOffset -> [BufferOffset]
enumFromThen :: BufferOffset -> BufferOffset -> [BufferOffset]
$cenumFromTo :: BufferOffset -> BufferOffset -> [BufferOffset]
enumFromTo :: BufferOffset -> BufferOffset -> [BufferOffset]
$cenumFromThenTo :: BufferOffset -> BufferOffset -> BufferOffset -> [BufferOffset]
enumFromThenTo :: BufferOffset -> BufferOffset -> BufferOffset -> [BufferOffset]
Enum, BufferOffset
BufferOffset -> BufferOffset -> Bounded BufferOffset
forall a. a -> a -> Bounded a
$cminBound :: BufferOffset
minBound :: BufferOffset
$cmaxBound :: BufferOffset
maxBound :: BufferOffset
Bounded, Integer -> BufferOffset
BufferOffset -> BufferOffset
BufferOffset -> BufferOffset -> BufferOffset
(BufferOffset -> BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset)
-> (BufferOffset -> BufferOffset)
-> (Integer -> BufferOffset)
-> Num BufferOffset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: BufferOffset -> BufferOffset -> BufferOffset
+ :: BufferOffset -> BufferOffset -> BufferOffset
$c- :: BufferOffset -> BufferOffset -> BufferOffset
- :: BufferOffset -> BufferOffset -> BufferOffset
$c* :: BufferOffset -> BufferOffset -> BufferOffset
* :: BufferOffset -> BufferOffset -> BufferOffset
$cnegate :: BufferOffset -> BufferOffset
negate :: BufferOffset -> BufferOffset
$cabs :: BufferOffset -> BufferOffset
abs :: BufferOffset -> BufferOffset
$csignum :: BufferOffset -> BufferOffset
signum :: BufferOffset -> BufferOffset
$cfromInteger :: Integer -> BufferOffset
fromInteger :: Integer -> BufferOffset
Num, Int -> BufferOffset -> ShowS
[BufferOffset] -> ShowS
BufferOffset -> String
(Int -> BufferOffset -> ShowS)
-> (BufferOffset -> String)
-> ([BufferOffset] -> ShowS)
-> Show BufferOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferOffset -> ShowS
showsPrec :: Int -> BufferOffset -> ShowS
$cshow :: BufferOffset -> String
show :: BufferOffset -> String
$cshowList :: [BufferOffset] -> ShowS
showList :: [BufferOffset] -> ShowS
Show)

-- | Wrapper for 'hGetBufSome' that ensures that we read exactly as many
-- bytes as requested. If EOF is found before the requested number of bytes is
-- read, an 'FsError' exception is thrown.
hGetBufExactly :: forall m h. (HasCallStack, MonadThrow m)
               => HasFS m h
               -> Handle h
               -> MutableByteArray (PrimState m) -- ^ Buffer to read bytes into
               -> BufferOffset -- ^ Offset into buffer
               -> ByteCount  -- ^ The number of bytes to read
               -> m ByteCount
hGetBufExactly :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h
-> Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufExactly HasFS m h
hfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c = ByteCount -> BufferOffset -> m ByteCount
go ByteCount
c BufferOffset
bufOff
  where
    go :: ByteCount -> BufferOffset -> m ByteCount
    go :: ByteCount -> BufferOffset -> m ByteCount
go !ByteCount
remainingCount !BufferOffset
currentBufOff
      | ByteCount
remainingCount ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0 = ByteCount -> m ByteCount
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteCount
c
      | Bool
otherwise            = do
          ByteCount
readBytes <- HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hGetBufSome HasFS m h
hfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
currentBufOff ByteCount
c
          if ByteCount
readBytes ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0 then
            FsError -> m ByteCount
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO FsError {
                fsErrorType :: FsErrorType
fsErrorType   = FsErrorType
FsReachedEOF
              , fsErrorPath :: FsErrorPath
fsErrorPath   = HasFS m h -> FsPath -> FsErrorPath
forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath HasFS m h
hfs (FsPath -> FsErrorPath) -> FsPath -> FsErrorPath
forall a b. (a -> b) -> a -> b
$ Handle h -> FsPath
forall h. Handle h -> FsPath
handlePath Handle h
h
              , fsErrorString :: String
fsErrorString = String
"hGetBufExactly found eof before reading " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteCount -> String
forall a. Show a => a -> String
show ByteCount
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes"
              , fsErrorNo :: Maybe Errno
fsErrorNo     = Maybe Errno
forall a. Maybe a
Nothing
              , fsErrorStack :: PrettyCallStack
fsErrorStack  = PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
              , fsLimitation :: Bool
fsLimitation  = Bool
False
              }
          -- We know the length <= remainingBytes, so this can't underflow.
          else ByteCount -> BufferOffset -> m ByteCount
go (ByteCount
remainingCount ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
readBytes)
                  (BufferOffset
currentBufOff BufferOffset -> BufferOffset -> BufferOffset
forall a. Num a => a -> a -> a
+ ByteCount -> BufferOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
readBytes)

-- | Wrapper for 'hGetBufSomeAt' that ensures that we read exactly as many bytes
-- as requested. If EOF is found before the requested number of bytes is read,
-- an 'FsError' exception is thrown.
hGetBufExactlyAt :: forall m h. (HasCallStack, MonadThrow m)
                 => HasFS m h
                 -> Handle h
                 -> MutableByteArray (PrimState m)   -- ^ Buffer to read bytes into
                 -> BufferOffset -- ^ Offset into buffer
                 -> ByteCount -- ^ The number of bytes to read
                 -> AbsOffset -- ^ The file offset at which to read
                 -> m ByteCount
hGetBufExactlyAt :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h
-> Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hGetBufExactlyAt HasFS m h
hfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c AbsOffset
off = ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go ByteCount
c AbsOffset
off BufferOffset
bufOff
  where
    go :: ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
    go :: ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go !ByteCount
remainingCount !AbsOffset
currentOffset !BufferOffset
currentBufOff
      | ByteCount
remainingCount ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0 = ByteCount -> m ByteCount
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteCount
c
      | Bool
otherwise            = do
          ByteCount
readBytes <- HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hGetBufSomeAt HasFS m h
hfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
currentBufOff ByteCount
c AbsOffset
currentOffset
          if ByteCount
readBytes ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0 then
            FsError -> m ByteCount
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO FsError {
                fsErrorType :: FsErrorType
fsErrorType   = FsErrorType
FsReachedEOF
              , fsErrorPath :: FsErrorPath
fsErrorPath   = HasFS m h -> FsPath -> FsErrorPath
forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
mkFsErrorPath HasFS m h
hfs (FsPath -> FsErrorPath) -> FsPath -> FsErrorPath
forall a b. (a -> b) -> a -> b
$ Handle h -> FsPath
forall h. Handle h -> FsPath
handlePath Handle h
h
              , fsErrorString :: String
fsErrorString = String
"hGetBufExactlyAt found eof before reading " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteCount -> String
forall a. Show a => a -> String
show ByteCount
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes"
              , fsErrorNo :: Maybe Errno
fsErrorNo     = Maybe Errno
forall a. Maybe a
Nothing
              , fsErrorStack :: PrettyCallStack
fsErrorStack  = PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack
              , fsLimitation :: Bool
fsLimitation  = Bool
False
              }
          -- We know the length <= remainingBytes, so this can't underflow.
          else ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go (ByteCount
remainingCount ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
readBytes)
                  (AbsOffset
currentOffset AbsOffset -> AbsOffset -> AbsOffset
forall a. Num a => a -> a -> a
+ ByteCount -> AbsOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
readBytes)
                  (BufferOffset
currentBufOff BufferOffset -> BufferOffset -> BufferOffset
forall a. Num a => a -> a -> a
+ ByteCount -> BufferOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
readBytes)

-- | Wrapper for 'hPutBufSome' that ensures we write exactly as many bytes as
-- requested.
hPutBufExactly :: forall m h. (HasCallStack, MonadThrow m)
                 => HasFS m h
                 -> Handle h
                 -> MutableByteArray (PrimState m) -- ^ Buffer to write bytes from
                 -> BufferOffset -- ^ Offset into buffer
                 -> ByteCount  -- ^ The number of bytes to write
                 -> m ByteCount
hPutBufExactly :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h
-> Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufExactly HasFS m h
hbfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c = ByteCount -> BufferOffset -> m ByteCount
go ByteCount
c BufferOffset
bufOff
  where
    go :: ByteCount -> BufferOffset -> m ByteCount
    go :: ByteCount -> BufferOffset -> m ByteCount
go !ByteCount
remainingCount !BufferOffset
currentBufOff = do
      ByteCount
writtenBytes <- HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> m ByteCount
hPutBufSome HasFS m h
hbfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
currentBufOff ByteCount
remainingCount
      let remainingCount' :: ByteCount
remainingCount' = ByteCount
remainingCount ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
writtenBytes
      if ByteCount
remainingCount' ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0
        then ByteCount -> m ByteCount
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteCount
c
        else ByteCount -> BufferOffset -> m ByteCount
go ByteCount
remainingCount'
                (BufferOffset
currentBufOff BufferOffset -> BufferOffset -> BufferOffset
forall a. Num a => a -> a -> a
+ ByteCount -> BufferOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
writtenBytes)

-- | Wrapper for 'hPutBufSomeAt' that ensures we write exactly as many bytes as
-- requested.
hPutBufExactlyAt :: forall m h. (HasCallStack, MonadThrow m)
                 => HasFS m h
                 -> Handle h
                 -> MutableByteArray (PrimState m)   -- ^ Buffer to write bytes from
                 -> BufferOffset -- ^ Offset into buffer
                 -> ByteCount -- ^ The number of bytes to write
                 -> AbsOffset -- ^ The file offset at which to write
                 -> m ByteCount
hPutBufExactlyAt :: forall (m :: * -> *) h.
(HasCallStack, MonadThrow m) =>
HasFS m h
-> Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufExactlyAt HasFS m h
hbfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
bufOff ByteCount
c AbsOffset
off = ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go ByteCount
c AbsOffset
off BufferOffset
bufOff
  where
    go :: ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
    go :: ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go !ByteCount
remainingCount !AbsOffset
currentOffset !BufferOffset
currentBufOff = do
      ByteCount
writtenBytes <- HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
forall (m :: * -> *) h.
HasFS m h
-> HasCallStack =>
   Handle h
   -> MutableByteArray (PrimState m)
   -> BufferOffset
   -> ByteCount
   -> AbsOffset
   -> m ByteCount
hPutBufSomeAt HasFS m h
hbfs Handle h
h MutableByteArray (PrimState m)
buf BufferOffset
currentBufOff ByteCount
remainingCount AbsOffset
currentOffset
      let remainingCount' :: ByteCount
remainingCount' = ByteCount
remainingCount ByteCount -> ByteCount -> ByteCount
forall a. Num a => a -> a -> a
- ByteCount
writtenBytes
      if ByteCount
remainingCount' ByteCount -> ByteCount -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCount
0
        then ByteCount -> m ByteCount
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteCount
c
        else ByteCount -> AbsOffset -> BufferOffset -> m ByteCount
go ByteCount
remainingCount'
                (AbsOffset
currentOffset AbsOffset -> AbsOffset -> AbsOffset
forall a. Num a => a -> a -> a
+ ByteCount -> AbsOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
writtenBytes)
                (BufferOffset
currentBufOff BufferOffset -> BufferOffset -> BufferOffset
forall a. Num a => a -> a -> a
+ ByteCount -> BufferOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
writtenBytes)

{-------------------------------------------------------------------------------
  Other
--------------------------------------------------------------------------------}

-- Without this, the module won't compile because the instance below is in the
-- same declaration group as the datatype definition. For more info, see
-- https://blog.monadfix.com/th-groups.
$(pure[])

instance NFData (HasFS m h) where
  rnf :: HasFS m h -> ()
rnf $(fields 'HasFS) =
      m String
dumpState m String -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> OpenMode -> m (Handle h)
hOpen (FsPath -> OpenMode -> m (Handle h)) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Handle h -> m ()
Handle h -> m ()
hClose (Handle h -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Handle h -> m Bool
Handle h -> m Bool
hIsOpen (Handle h -> m Bool) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
Handle h -> SeekMode -> Int64 -> m ()
hSeek (Handle h -> SeekMode -> Int64 -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq`
      HasCallStack => Handle h -> Word64 -> m ByteString
Handle h -> Word64 -> m ByteString
hGetSome (Handle h -> Word64 -> m ByteString) -> () -> ()
forall a b. a -> b -> b
`seq`HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt (Handle h -> Word64 -> AbsOffset -> m ByteString) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Handle h -> ByteString -> m Word64
Handle h -> ByteString -> m Word64
hPutSome (Handle h -> ByteString -> m Word64) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Handle h -> Word64 -> m ()
Handle h -> Word64 -> m ()
hTruncate (Handle h -> Word64 -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq`
      HasCallStack => Handle h -> m Word64
Handle h -> m Word64
hGetSize (Handle h -> m Word64) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> m ()
FsPath -> m ()
createDirectory (FsPath -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => Bool -> FsPath -> m ()
Bool -> FsPath -> m ()
createDirectoryIfMissing (Bool -> FsPath -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq`
      HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory (FsPath -> m (Set String)) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> m Bool
FsPath -> m Bool
doesDirectoryExist (FsPath -> m Bool) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> m Bool
FsPath -> m Bool
doesFileExist (FsPath -> m Bool) -> () -> ()
forall a b. a -> b -> b
`seq`
      HasCallStack => FsPath -> m ()
FsPath -> m ()
removeDirectoryRecursive (FsPath -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> m ()
FsPath -> m ()
removeFile (FsPath -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack => FsPath -> FsPath -> m ()
FsPath -> FsPath -> m ()
renameFile (FsPath -> FsPath -> m ()) -> () -> ()
forall a b. a -> b -> b
`seq`
      FsPath -> FsErrorPath
mkFsErrorPath (FsPath -> FsErrorPath) -> () -> ()
forall a b. a -> b -> b
`seq` FsPath -> m String
unsafeToFilePath (FsPath -> m String) -> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufSome (Handle h
 -> MutableByteArray (PrimState m)
 -> BufferOffset
 -> ByteCount
 -> m ByteCount)
-> () -> ()
forall a b. a -> b -> b
`seq`
      HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hGetBufSomeAt (Handle h
 -> MutableByteArray (PrimState m)
 -> BufferOffset
 -> ByteCount
 -> AbsOffset
 -> m ByteCount)
-> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufSome (Handle h
 -> MutableByteArray (PrimState m)
 -> BufferOffset
 -> ByteCount
 -> m ByteCount)
-> () -> ()
forall a b. a -> b -> b
`seq` HasCallStack =>
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
Handle h
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufSomeAt (Handle h
 -> MutableByteArray (PrimState m)
 -> BufferOffset
 -> ByteCount
 -> AbsOffset
 -> m ByteCount)
-> () -> ()
forall a b. a -> b -> b
`seq` ()