1-- | 2-- Module : Foundation.IO.File 3-- License : BSD-style 4-- Maintainer : Foundation 5-- Stability : experimental 6-- Portability : portable 7-- 8{-# LANGUAGE OverloadedStrings #-} 9module Foundation.IO.File 10 ( FilePath 11 , openFile 12 , closeFile 13 , IOMode(..) 14 , withFile 15 , hGet 16 , hGetNonBlocking 17 , hGetSome 18 , hPut 19 , readFile 20 ) where 21 22import System.IO (Handle, IOMode) 23import System.IO.Error 24import qualified System.IO as S 25import Foundation.Collection 26import Foundation.VFS 27import Basement.Types.OffsetSize 28import Basement.Imports 29import Foundation.Array.Internal 30import Foundation.Numerical 31import qualified Basement.UArray.Mutable as V 32import qualified Basement.UArray as V 33import Control.Exception (bracket) 34import Foreign.Ptr (plusPtr) 35 36-- | list the file name in the given FilePath directory 37-- 38-- TODO: error management and not implemented yet 39--getDirectory :: FilePath -> IO [FileName] 40--getDirectory = undefined 41 42-- | Open a new handle on the file 43openFile :: FilePath -> IOMode -> IO Handle 44openFile filepath mode = do 45 S.openBinaryFile (filePathToLString filepath) mode 46 47-- | Close a handle 48closeFile :: Handle -> IO () 49closeFile = S.hClose 50 51-- | Read binary data directly from the specified 'Handle'. 52-- 53-- First argument is the Handle to read from, and the second is the number of bytes to read. 54-- It returns the bytes read, up to the specified size, or an empty array if EOF has been reached. 55-- 56-- 'hGet' is implemented in terms of 'hGetBuf'. 57hGet :: Handle -> Int -> IO (UArray Word8) 58hGet h size 59 | size < 0 = invalidBufferSize "hGet" h size 60 | otherwise = V.createFromIO (CountOf size) $ \p -> (CountOf <$> S.hGetBuf h p size) 61 62-- | hGetNonBlocking is similar to 'hGet', except that it will never block 63-- waiting for data to become available, instead it returns only whatever data 64-- is available. If there is no data available to be read, 'hGetNonBlocking' 65-- returns an empty array. 66-- 67-- Note: on Windows, this function behaves identically to 'hGet'. 68hGetNonBlocking :: Handle -> Int -> IO (UArray Word8) 69hGetNonBlocking h size 70 | size < 0 = invalidBufferSize "hGetNonBlocking" h size 71 | otherwise = V.createFromIO (CountOf size) $ \p -> (CountOf <$> S.hGetBufNonBlocking h p size) 72 73-- | Like 'hGet', except that a shorter array may be returned 74-- if there are not enough bytes immediately available to satisfy the 75-- whole request. 'hGetSome' only blocks if there is no data 76-- available, and EOF has not yet been reached. 77-- 78hGetSome :: Handle -> Int -> IO (UArray Word8) 79hGetSome h size 80 | size < 0 = invalidBufferSize "hGetSome" h size 81 | otherwise = V.createFromIO (CountOf size) $ \p -> (CountOf <$> S.hGetBufSome h p size) 82 83hPut :: Handle -> (UArray Word8) -> IO () 84hPut h arr = withPtr arr $ \ptr -> S.hPutBuf h ptr (let (CountOf sz) = length arr in sz) 85 86invalidBufferSize :: [Char] -> Handle -> Int -> IO a 87invalidBufferSize functionName handle size = 88 ioError $ mkIOError illegalOperationErrorType 89 (functionName <> " invalid array size: " <> toList (show size)) 90 (Just handle) 91 Nothing 92 93-- | @'withFile' filepath mode act@ opens a file using the mode@ 94-- and run act@. the by-product handle will be closed when act finish, 95-- either normally or through an exception. 96-- 97-- The value returned is the result of act@ 98withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r 99withFile fp mode act = bracket (openFile fp mode) closeFile act 100 101-- | Read a binary file and return the whole content in one contiguous buffer. 102readFile :: FilePath -> IO (UArray Word8) 103readFile fp = withFile fp S.ReadMode $ \h -> do 104 -- TODO filesize is an integer (whyyy ?!), and transforming to Int using 105 -- fromIntegral is probably the wrong thing to do here.. 106 sz <- S.hFileSize h 107 mv <- V.newPinned (CountOf $ fromInteger sz) 108 V.withMutablePtr mv $ loop h (fromInteger sz) 109 unsafeFreeze mv 110 where 111 loop h left dst 112 | left == 0 = return () 113 | otherwise = do 114 let toRead = min blockSize left 115 r <- S.hGetBuf h dst toRead 116 if r > 0 && r <= toRead 117 then loop h (left - r) (dst `plusPtr` r) 118 else error "readFile: " -- turn into proper error 119 120blockSize :: Int 121blockSize = 4096 122