uniform-io/src/System/IO/Uniform/File.hs

module System.IO.Uniform.File (
  FileIO,
  openFile
  ) where

import System.IO.Uniform
import System.IO.Uniform.External

import Foreign
import Foreign.C.String
import Foreign.C.Error
import qualified Data.ByteString as BS
import Control.Monad

import System.Posix.Types (Fd(..))


-- | UniformIO type for file IO.
instance UniformIO FileIO where
  uRead s n = allocaArray n (
    \b -> do
      count <- c_recv (fd s) b $ fromIntegral n
      if count < 0
        then throwErrno "could not read"
        else  BS.packCStringLen (b, fromIntegral count)
    )
  uPut s t = BS.useAsCStringLen t (
    \(str, n) -> do
      count <- c_send (fd s) str $ fromIntegral n
      when (count < 0) $ throwErrno "could not write"
    )
  uClose s = do
    f <- Fd <$> c_prepareToClose (fd s)
    closeFd f
  startTls _ = return
  isSecure _ = True
  
  
-- | Open a file for bidirectional IO.
openFile :: String -> IO FileIO
openFile fileName = do
  r <- withCString fileName (
    fmap FileIO . c_createFile
    )
  if fd r == nullPtr
    then throwErrno "could not open file"
    else return r