{-# LANGUAGE NoMonomorphismRestriction #-}

{- |
  Module      :  System.C.IO
  Copyright   :  (c) Matt Morrow 2008
  License     :  BSD3
  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
  Stability   :  experimental
  Portability :  portable (FFI)

  FFI bindings to @read(2)@, @write(2)@, @open(2)@, and @close(2)@.
-}

module System.C.IO (
    cread, cwrite
  , copen, cclose
  , OFlag(..), oflags
) where

import Foreign.Ptr
import Foreign.Storable(peek)
import Foreign.Marshal.Alloc
import Foreign.C.Types(CInt,CChar)
import Foreign.C.String(withCString)
import System.IO.Unsafe(unsafePerformIO)
import Data.Word(Word8)
import Data.Bits((.|.))

-- | @read(2)@
cread :: Int -> Ptr Word8 -> Int -> IO Int
cread fd p = (fi `fmap`) . c_read (fi fd) p . fi

-- | @write(2)@
cwrite :: Int -> Ptr Word8 -> Int -> IO Int
cwrite fd p = (fi `fmap`) . c_write (fi fd) p . fi

-- | @open(2)@
copen :: FilePath -> [OFlag] -> IO Int
copen fp fls = withCString fp $ \cstr ->
        fi `fmap` c_open cstr (fi . oflags $ fls)

-- | @close(2)@
cclose :: Int -> IO Bool
cclose fd = (0==) `fmap` c_close (fi fd)

fi :: (Integral a, Integral b) => a -> b
fi = fromIntegral

foreign import ccall unsafe "unistd.h read"
  c_read :: CInt -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h write"
  c_write :: CInt -> Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h open"
  c_open :: Ptr CChar -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h close"
  c_close :: CInt -> IO CInt

-- | Bitwise @or@ of the flags.
oflags :: [OFlag] -> Int
oflags = foldl (.|.) 0 . fmap fromEnum

data OFlag
  = O_RDONLY
  | O_WRONLY
  | O_RDWR
  | O_APPEND
  | O_CREAT
  | O_DSYNC
  | O_EXCL
  | O_NOCTTY
  | O_NONBLOCK
  | O_RSYNC
  | O_SYNC
  | O_TRUNC
  deriving (Eq,Ord,Show,Read)

instance Enum OFlag where
  toEnum n
    | n == oRdOnly    = O_RDONLY
    | n == oWrOnly    = O_WRONLY
    | n == oRdWr      = O_RDWR
    | n == oAppend    = O_APPEND
    | n == oCreat     = O_CREAT
    | n == oDSync     = O_DSYNC
    | n == oExcl      = O_EXCL
    | n == oNoCTTY    = O_NOCTTY
    | n == oNonblock  = O_NONBLOCK
    | n == oRSync     = O_RSYNC
    | n == oSync      = O_SYNC
    | n == oTrunc     = O_TRUNC
  fromEnum O_RDONLY   = oRdOnly
  fromEnum O_WRONLY   = oWrOnly
  fromEnum O_RDWR     = oRdWr
  fromEnum O_APPEND   = oAppend
  fromEnum O_CREAT    = oCreat
  fromEnum O_DSYNC    = oDSync
  fromEnum O_EXCL     = oExcl
  fromEnum O_NOCTTY   = oNoCTTY
  fromEnum O_NONBLOCK = oNonblock
  fromEnum O_RSYNC    = oRSync
  fromEnum O_SYNC     = oSync
  fromEnum O_TRUNC    = oTrunc

oRdOnly   = unsafePerformIO (fi `fmap` peek o_rdonly)
oWrOnly   = unsafePerformIO (fi `fmap` peek o_wronly)
oRdWr     = unsafePerformIO (fi `fmap` peek o_rdwr)
oAppend   = unsafePerformIO (fi `fmap` peek o_append)
oCreat    = unsafePerformIO (fi `fmap` peek o_creat)
oDSync    = unsafePerformIO (fi `fmap` peek o_dsync)
oExcl     = unsafePerformIO (fi `fmap` peek o_excl)
oNoCTTY   = unsafePerformIO (fi `fmap` peek o_noctty)
oNonblock = unsafePerformIO (fi `fmap` peek o_nonblock)
oRSync    = unsafePerformIO (fi `fmap` peek o_rsync)
oSync     = unsafePerformIO (fi `fmap` peek o_sync)
oTrunc    = unsafePerformIO (fi `fmap` peek o_trunc)

foreign import ccall unsafe "&" o_rdonly    :: Ptr CInt
foreign import ccall unsafe "&" o_wronly    :: Ptr CInt
foreign import ccall unsafe "&" o_rdwr      :: Ptr CInt
foreign import ccall unsafe "&" o_append    :: Ptr CInt
foreign import ccall unsafe "&" o_creat     :: Ptr CInt
foreign import ccall unsafe "&" o_dsync     :: Ptr CInt
foreign import ccall unsafe "&" o_excl      :: Ptr CInt
foreign import ccall unsafe "&" o_noctty    :: Ptr CInt
foreign import ccall unsafe "&" o_nonblock  :: Ptr CInt
foreign import ccall unsafe "&" o_rsync     :: Ptr CInt
foreign import ccall unsafe "&" o_sync      :: Ptr CInt
foreign import ccall unsafe "&" o_trunc     :: Ptr CInt