    -- |
    -- Module      : Foundation.IO.File
    -- License     : BSD-style
    -- Maintainer  : Foundation
    -- Stability   : experimental
    -- Portability : portable
    --
    {-# LANGUAGE OverloadedStrings #-}
    module Foundation.IO.File
        ( FilePath
        , openFile
        , closeFile
        , IOMode(..)
        , withFile
        , hGet
        , hGetNonBlocking
        , hGetSome
        , hPut
        , readFile
        ) where

    import           System.IO (Handle, IOMode)
    import           System.IO.Error
    import qualified System.IO as S
    import           Foundation.Collection
    import           Foundation.VFS
    import           Basement.Types.OffsetSize
    import           Basement.Imports
    import           Foundation.Array.Internal
    import           Foundation.Numerical
    import qualified Basement.UArray.Mutable as V
    import qualified Basement.UArray as V
    import           Control.Exception (bracket)
    import           Foreign.Ptr (plusPtr)

    -- | list the file name in the given FilePath directory
    --
    -- TODO: error management and not implemented yet
    --getDirectory :: FilePath -> IO [FileName]
    --getDirectory = undefined

    -- | Open a new handle on the file
    openFile :: FilePath -> IOMode -> IO Handle
    openFile :: FilePath -> IOMode -> IO Handle
    openFile filepath :: FilePath
    filepath mode :: IOMode
    mode = do
        FilePath -> IOMode -> IO Handle
    S.openBinaryFile (FilePath -> FilePath
    filePathToLString FilePath
    filepath) IOMode
    mode

    -- | Close a handle
    closeFile :: Handle -> IO ()
    closeFile :: Handle -> IO ()
    closeFile = Handle -> IO ()
    S.hClose

    -- | Read binary data directly from the specified 'Handle'.
    --
    -- First argument is the Handle to read from, and the second is the number of bytes to read.
    -- It returns the bytes read, up to the specified size, or an empty array if EOF has been reached.
    --
    -- 'hGet' is implemented in terms of 'hGetBuf'.
    hGet :: Handle -> Int -> IO (UArray Word8)
    hGet :: Handle -> Int -> IO (UArray Word8)
    hGet h :: Handle
    h size :: Int
    size
        | Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0   = FilePath -> Handle -> Int -> IO (UArray Word8)
    forall a. FilePath -> Handle -> Int -> IO a
    invalidBufferSize "hGet" Handle
    h Int
    size
        | Bool
    otherwise  = CountOf Word8
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall ty.
    PrimType ty =>
    CountOf ty -> (Ptr ty -> IO (CountOf ty)) -> IO (UArray ty)
    V.createFromIO (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf Int
    size) ((Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8))
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr Word8
    p -> (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf (Int -> CountOf Word8) -> IO Int -> IO (CountOf Word8)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    S.hGetBuf Handle
    h Ptr Word8
    p Int
    size)

    -- | hGetNonBlocking is similar to 'hGet', except that it will never block
    -- waiting for data to become available, instead it returns only whatever data
    -- is available.  If there is no data available to be read, 'hGetNonBlocking'
    -- returns an empty array.
    --
    -- Note: on Windows, this function behaves identically to 'hGet'.
    hGetNonBlocking :: Handle -> Int -> IO (UArray Word8)
    hGetNonBlocking :: Handle -> Int -> IO (UArray Word8)
    hGetNonBlocking h :: Handle
    h size :: Int
    size
        | Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0  = FilePath -> Handle -> Int -> IO (UArray Word8)
    forall a. FilePath -> Handle -> Int -> IO a
    invalidBufferSize "hGetNonBlocking" Handle
    h Int
    size
        | Bool
    otherwise = CountOf Word8
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall ty.
    PrimType ty =>
    CountOf ty -> (Ptr ty -> IO (CountOf ty)) -> IO (UArray ty)
    V.createFromIO (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf Int
    size) ((Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8))
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr Word8
    p -> (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf (Int -> CountOf Word8) -> IO Int -> IO (CountOf Word8)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    S.hGetBufNonBlocking Handle
    h Ptr Word8
    p Int
    size)

    -- | Like 'hGet', except that a shorter array may be returned
    -- if there are not enough bytes immediately available to satisfy the
    -- whole request.  'hGetSome' only blocks if there is no data
    -- available, and EOF has not yet been reached.
    --
    hGetSome :: Handle -> Int -> IO (UArray Word8)
    hGetSome :: Handle -> Int -> IO (UArray Word8)
    hGetSome h :: Handle
    h size :: Int
    size
        | Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0  = FilePath -> Handle -> Int -> IO (UArray Word8)
    forall a. FilePath -> Handle -> Int -> IO a
    invalidBufferSize "hGetSome" Handle
    h Int
    size
        | Bool
    otherwise = CountOf Word8
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall ty.
    PrimType ty =>
    CountOf ty -> (Ptr ty -> IO (CountOf ty)) -> IO (UArray ty)
    V.createFromIO (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf Int
    size) ((Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8))
    -> (Ptr Word8 -> IO (CountOf Word8)) -> IO (UArray Word8)
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr Word8
    p -> (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf (Int -> CountOf Word8) -> IO Int -> IO (CountOf Word8)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    S.hGetBufSome Handle
    h Ptr Word8
    p Int
    size)

    hPut :: Handle -> (UArray Word8) -> IO ()
    hPut :: Handle -> UArray Word8 -> IO ()
    hPut h :: Handle
    h arr :: UArray Word8
    arr = UArray Word8 -> (Ptr Word8 -> IO ()) -> IO ()
    forall ty (prim :: * -> *) a.
    (PrimMonad prim, PrimType ty) =>
    UArray ty -> (Ptr ty -> prim a) -> prim a
    withPtr UArray Word8
    arr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ptr :: Ptr Word8
    ptr -> Handle -> Ptr Word8 -> Int -> IO ()
    forall a. Handle -> Ptr a -> Int -> IO ()
    S.hPutBuf Handle
    h Ptr Word8
    ptr (let (CountOf sz :: Int
    sz) = UArray Word8 -> CountOf (Element (UArray Word8))
    forall c. Collection c => c -> CountOf (Element c)
    length UArray Word8
    arr in Int
    sz)

    invalidBufferSize :: [Char] -> Handle -> Int -> IO a
    invalidBufferSize :: FilePath -> Handle -> Int -> IO a
    invalidBufferSize functionName :: FilePath
    functionName handle :: Handle
    handle size :: Int
    size =
        IOError -> IO a
    forall a. IOError -> IO a
    ioError (IOError -> IO a) -> IOError -> IO a
    forall a b. (a -> b) -> a -> b
    $ IOErrorType
    -> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
    mkIOError IOErrorType
    illegalOperationErrorType
                            (FilePath
    functionName FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> " invalid array size: " FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> String -> [Item String]
    forall l. IsList l => l -> [Item l]
    toList (Int -> String
    forall a. Show a => a -> String
    show Int
    size))
                            (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    handle)
                            Maybe FilePath
    forall a. Maybe a
    Nothing

    -- | @'withFile' filepath mode act@ opens a file using the mode@
    -- and run act@. the by-product handle will be closed when act finish,
    -- either normally or through an exception.
    --
    -- The value returned is the result of act@
    withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile fp :: FilePath
    fp mode :: IOMode
    mode act :: Handle -> IO r
    act = IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (FilePath -> IOMode -> IO Handle
    openFile FilePath
    fp IOMode
    mode) Handle -> IO ()
    closeFile Handle -> IO r
    act

    -- | Read a binary file and return the whole content in one contiguous buffer.
    readFile :: FilePath -> IO (UArray Word8)
    readFile :: FilePath -> IO (UArray Word8)
    readFile fp :: FilePath
    fp = FilePath
    -> IOMode -> (Handle -> IO (UArray Word8)) -> IO (UArray Word8)
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    fp IOMode
    S.ReadMode ((Handle -> IO (UArray Word8)) -> IO (UArray Word8))
    -> (Handle -> IO (UArray Word8)) -> IO (UArray Word8)
    forall a b. (a -> b) -> a -> b
    $ \h :: Handle
    h -> do
        -- TODO filesize is an integer (whyyy ?!), and transforming to Int using
        -- fromIntegral is probably the wrong thing to do here..
        Integer
    sz <- Handle -> IO Integer
    S.hFileSize Handle
    h
        MUArray Word8 RealWorld
    mv <- CountOf Word8 -> IO (MUArray Word8 (PrimState IO))
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    CountOf ty -> prim (MUArray ty (PrimState prim))
    V.newPinned (Int -> CountOf Word8
    forall ty. Int -> CountOf ty
    CountOf (Int -> CountOf Word8) -> Int -> CountOf Word8
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int
    forall a. Integral a => Integer -> a
    fromInteger Integer
    sz)
        MUArray Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    (PrimMonad prim, PrimType ty) =>
    MUArray ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    V.withMutablePtr MUArray Word8 RealWorld
    MUArray Word8 (PrimState IO)
    mv ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> Int -> Ptr Word8 -> IO ()
    forall b. Handle -> Int -> Ptr b -> IO ()
    loop Handle
    h (Integer -> Int
    forall a. Integral a => Integer -> a
    fromInteger Integer
    sz)
        MUArray Word8 (PrimState IO) -> IO (MutableFreezed (MUArray Word8))
    forall (c :: * -> *) (prim :: * -> *).
    (MutableCollection c, PrimMonad prim) =>
    c (PrimState prim) -> prim (MutableFreezed c)
    unsafeFreeze MUArray Word8 RealWorld
    MUArray Word8 (PrimState IO)
    mv
      where
        loop :: Handle -> Int -> Ptr b -> IO ()
    loop h :: Handle
    h left :: Int
    left dst :: Ptr b
    dst
            | Int
    left Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            | Bool
    otherwise = do
                let toRead :: Int
    toRead = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    blockSize Int
    left
                Int
    r <- Handle -> Ptr b -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    S.hGetBuf Handle
    h Ptr b
    dst Int
    toRead
                if Int
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && Int
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    toRead
                    then Handle -> Int -> Ptr b -> IO ()
    loop Handle
    h (Int
    left Int -> Int -> Difference Int
    forall a. Subtractive a => a -> a -> Difference a
    - Int
    r) (Ptr b
    dst Ptr b -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    r)
                    else String -> IO ()
    forall a. HasCallStack => String -> a
    error "readFile: " -- turn into proper error

    blockSize :: Int
    blockSize :: Int
    blockSize = 4096