-- |
-- 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 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 Handle
h Int
size
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = FilePath -> Handle -> Int -> IO (UArray Word8)
forall a. FilePath -> Handle -> Int -> IO a
invalidBufferSize FilePath
"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
$ \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 Handle
h Int
size
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = FilePath -> Handle -> Int -> IO (UArray Word8)
forall a. FilePath -> Handle -> Int -> IO a
invalidBufferSize FilePath
"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
$ \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 Handle
h Int
size
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = FilePath -> Handle -> Int -> IO (UArray Word8)
forall a. FilePath -> Handle -> Int -> IO a
invalidBufferSize FilePath
"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
$ \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 Handle
h 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 Word8
ptr -> Handle -> Ptr Word8 -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
S.hPutBuf Handle
h Ptr Word8
ptr (let (CountOf 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 FilePath
functionName Handle
handle 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
<> FilePath
" 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 FilePath
fp IOMode
mode 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 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
$ \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 Handle
h Int
left Ptr b
dst
        | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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
> Int
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 String
"readFile: " -- turn into proper error

blockSize :: Int
blockSize :: Int
blockSize = Int
4096