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