module System.PosixFile
( openRead
, openWrite
, read
, write
, close
) where
import Foreign.C.String (CString, withCString)
import Foreign.Ptr (castPtr)
import Foreign.Marshal.Alloc (mallocBytes, free)
import Foreign.C.Types (CInt (..))
import Foreign.C.Error (throwErrno)
import Foreign.Ptr (Ptr)
import Data.Bits (Bits, (.|.))
import Data.Word (Word8)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as BU
import Prelude hiding (read)
newtype Flag = Flag CInt
deriving (Num, Bits, Show, Eq)
oRdonly :: Flag
oRdonly = Flag 0
oWronly :: Flag
oWronly = Flag 1
oCreat :: Flag
oCreat = Flag 64
foreign import ccall "open"
c_open :: CString -> Flag -> IO CInt
foreign import ccall "open"
c_open_mode :: CString -> Flag -> CInt -> IO CInt
foreign import ccall "read"
c_read :: FD -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall "write"
c_write :: FD -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall "close"
close :: FD -> IO ()
newtype FD = FD CInt
openRead :: FilePath -> IO FD
openRead fp = do
h <- withCString fp $ \str -> c_open str oRdonly
if h < 0
then throwErrno $ "Could not open file: " ++ fp
else return $ FD h
openWrite :: FilePath -> IO FD
openWrite fp = do
h <- withCString fp $ \str -> c_open_mode str (oWronly .|. oCreat) 438
if h < 0
then throwErrno $ "Could not open file: " ++ fp
else return $ FD h
read :: FD -> IO (Maybe S.ByteString)
read fd = do
cstr <- mallocBytes 4096
len <- c_read fd cstr 4096
if len == 0
then free cstr >> return Nothing
else fmap Just $ BU.unsafePackCStringFinalizer
cstr
(fromIntegral len)
(free cstr)
write :: FD -> S.ByteString -> IO ()
write _ bs | S.null bs = return ()
write fd bs = do
(written, len) <- BU.unsafeUseAsCStringLen bs $ \(cstr, len') -> do
let len = fromIntegral len'
written <- c_write fd (castPtr cstr) len
return (written, len)
case () of
()
| written == len -> return ()
| written <= 0 -> throwErrno $ "Error writing to file"
| otherwise -> write fd $ BU.unsafeDrop (fromIntegral $ len written) bs