diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Matt Morrow. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The names of the author may not be used to endorse or promote + products derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +> import Distribution.Simple +> main :: IO () +> main = defaultMain diff --git a/c-io.cabal b/c-io.cabal new file mode 100644 --- /dev/null +++ b/c-io.cabal @@ -0,0 +1,22 @@ +name: c-io +version: 0.1.0 +cabal-version: >= 1.5 +build-type: Simple +license: BSD3 +license-file: LICENSE +category: System +author: Matt Morrow +copyright: (c) Matt Morrow +maintainer: Matt Morrow +stability: experimental +synopsis: C IO. +description: FFI bindings to read(2), write(2), open(2), and close(2). + +library + build-depends: base + ghc-options: -O2 + extensions: ForeignFunctionInterface + hs-source-dirs: src + includes: unistd.h + c-sources: cbits/c_io.c + exposed-modules: System.C.IO diff --git a/cbits/c_io.c b/cbits/c_io.c new file mode 100644 --- /dev/null +++ b/cbits/c_io.c @@ -0,0 +1,15 @@ +#include + +int o_rdonly = O_RDONLY; +int o_wronly = O_WRONLY; +int o_rdwr = O_RDWR; +int o_append = O_APPEND; +int o_creat = O_CREAT; +int o_dsync = O_DSYNC; +int o_excl = O_EXCL; +int o_noctty = O_NOCTTY; +int o_nonblock = O_NONBLOCK; +int o_rsync = O_RSYNC; +int o_sync = O_SYNC; +int o_trunc = O_TRUNC; + diff --git a/src/System/C/IO.hs b/src/System/C/IO.hs new file mode 100644 --- /dev/null +++ b/src/System/C/IO.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +{- | + Module : System.C.IO + Copyright : (c) Matt Morrow 2008 + License : BSD3 + Maintainer : Matt Morrow + 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 + + + + + + +