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

-- {-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE ExistentialQuantification #-}
-- {-# LANGUAGE ForeignFunctionInterface #-}
-- {-# LANGUAGE InterruptibleFFI #-}
-- {-# LANGUAGE EmptyDataDecls #-}

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

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

import Foreign
--import Foreign.C.Types
import Foreign.C.String
import Foreign.C.Error
--import qualified Data.IP as IP
--import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
--import qualified Data.ByteString.Lazy as LBS
--import qualified Data.ByteString.Builder as BSBuild
--import qualified Data.List as L
--import Control.Exception
import Control.Applicative ((<$>))
--import Data.Monoid (mappend)
--import qualified Network.Socket as Soc
--import System.IO.Error
--import Control.Concurrent.MVar

--import Data.Default.Class

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


-- | UniformIO type for file IO.
instance UniformIO FileIO where
  uRead s n = do
    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 = do
    BS.useAsCStringLen t (
      \(str, n) -> do
        count <- c_send (fd s) str $ fromIntegral n
        if count < 0
          then throwErrno "could not write"
          else return ()
      )
  uClose s = do
    f <- Fd <$> c_prepareToClose (fd s)
    closeFd f
  -- Not implemented yet.
  startTls _ _ = return . TlsIO $ nullPtr
  isSecure _ = False
  
  
-- | Open a file for bidirectional IO.
openFile :: String -> IO FileIO
openFile fileName = do
  r <- withCString fileName (
    \f -> fmap FileIO $ c_createFile f
    )
  if fd r == nullPtr
    then throwErrno "could not open file"
    else return r