module Foundation.IO.File
( openFile
, closeFile
, IOMode(..)
, withFile
, hGet
, hGetNonBlocking
, hGetSome
, readFile
, foldTextFile
) where
import System.IO (Handle, IOMode)
import System.IO.Error
import qualified System.IO as S
import Foundation.Collection
import Foundation.VFS
import Foundation.Internal.Types
import Foundation.Internal.Base
import Foundation.String
import Foundation.Array
import Foundation.Numerical
import qualified Foundation.Array.Unboxed.Mutable as V
import qualified Foundation.Array.Unboxed as V
import qualified Foundation.String.UTF8 as S
import Control.Exception (bracket)
import Foreign.Ptr (plusPtr)
openFile :: FilePath -> IOMode -> IO Handle
openFile filepath mode = do
S.openBinaryFile (filePathToLString filepath) mode
closeFile :: Handle -> IO ()
closeFile = S.hClose
hGet :: Handle -> Int -> IO (UArray Word8)
hGet h size
| size < 0 = invalidBufferSize "hGet" h size
| otherwise = V.createFromIO size $ \p -> S.hGetBuf h p size
hGetNonBlocking :: Handle -> Int -> IO (UArray Word8)
hGetNonBlocking h size
| size < 0 = invalidBufferSize "hGetNonBlocking" h size
| otherwise = V.createFromIO size $ \p -> S.hGetBufNonBlocking h p size
hGetSome :: Handle -> Int -> IO (UArray Word8)
hGetSome h size
| size < 0 = invalidBufferSize "hGetSome" h size
| otherwise = V.createFromIO size $ \p -> S.hGetBufSome h p size
invalidBufferSize :: [Char] -> Handle -> Int -> IO a
invalidBufferSize functionName handle size =
ioError $ mkIOError illegalOperationErrorType
(functionName <> " invalid array size: " <> show size)
(Just handle)
Nothing
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile fp mode act = bracket (openFile fp mode) closeFile act
readFile :: FilePath -> IO (UArray Word8)
readFile fp = withFile fp S.ReadMode $ \h -> do
sz <- S.hFileSize h
mv <- V.newPinned (Size $ fromInteger sz)
V.withMutablePtr mv $ loop h (fromInteger sz)
unsafeFreeze mv
where
loop h left dst
| left == 0 = return ()
| otherwise = do
let toRead = min blockSize left
r <- S.hGetBuf h dst toRead
if r > 0 && r <= toRead
then loop h (left r) (dst `plusPtr` r)
else error "readFile: "
foldTextFile :: (String -> a -> IO a)
-> a
-> FilePath
-> IO a
foldTextFile chunkf ini fp = do
buf <- V.newPinned (Size blockSize)
V.withMutablePtr buf $ \ptr ->
withFile fp S.ReadMode $ doFold buf ptr
where
doFold mv ptr handle = loop 0 ini
where
loop absPos acc = do
r <- S.hGetBuf handle ptr blockSize
if r > 0 && r <= blockSize
then do
(pos, validateRet) <- S.mutableValidate mv 0 r
s <- case validateRet of
Nothing -> S.fromBytesUnsafe `fmap` V.freezeShrink mv r
Just S.MissingByte -> do
sRet <- S.fromBytesUnsafe `fmap` V.freezeShrink mv pos
V.unsafeSlide mv pos r
return sRet
Just _ ->
error ("foldTextFile: invalid UTF8 sequence: byte position: " <> show (absPos + pos))
chunkf s acc >>= loop (absPos + r)
else error ("foldTextFile: read failed")
blockSize :: Int
blockSize = 4096