{-# 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)
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
closeFile :: Handle -> IO ()
closeFile :: Handle -> IO ()
closeFile = Handle -> IO ()
S.hClose
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 :: 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)
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 -> 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
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
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: "
blockSize :: Int
blockSize :: Int
blockSize = Int
4096