halfs-0.2: Halfs/Buffer.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Halfs.Buffer
-- 
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: The Buffer represents the filesystem's IO buffer.
-- BinHandle for the FS.  All of the conversion to-and-from strings and
-- cstrings assume that each byte interpreted is a Char.  The
-- conversion functions which don't take a length assume that the
-- entire buffer is a string.  Use 'get' if you have a string whose
-- length is stored at the beginning.  There are functions for taking
-- a certain number of characters and interpreting them as strings,
-- however.
--
-- FIX: Clean up types.

module Halfs.Buffer (Buffer -- no constructor
                     ,strToBuff
                     ,strToNewBuff
                     ,buffToStrSize
                     ,buffToStr
                     ,withBuffSize
                     ,buffToCBuff
                     ,cBuffToBuff
                     ,plusBuff
                     ,buffSeek
                     ,buffGetHandle
                     ,newBuff
                     ,buffSize
                    ) where

import Foreign.C.Types (CSize)
import Foreign.Ptr(Ptr)
import Data.Word(Word8)
import Data.Array.SysArray
import Binary

newtype Buffer = Buffer (BinHandle)

newBuff :: Int -> IO Buffer
newBuff i = openBinMem i >>= return . Buffer

buffSize :: Buffer -> IO Int
buffSize (Buffer b) = sizeBinMem b

-- |Convert this string into a file buffer.  Starts at the beginning
-- of the buffer.
strToBuff :: String -> Buffer -> IO ()
strToBuff s (Buffer binHandle)
  = resetBin binHandle >> mapM_ (put_ binHandle) s

-- |Allocate a new buffer to fit this entire string.
strToNewBuff :: String -> IO Buffer
strToNewBuff [] = error "strToNewbuff empty list!"
strToNewBuff s = do
  h <- openBinMem (length s)
  let b = Buffer h
  strToBuff s b
  return b

-- |Extract /sz/ characters from this buffer and interpret them as a
-- string.  Starts at beginning of buffer.
buffToStrSize :: Int -> Buffer -> IO String
buffToStrSize sz (Buffer binHandle) = do
  resetBin binHandle
  s <- getMany binHandle sz
  return s

-- |Evaluate this entire buffer as a string, starting from the beginning.
buffToStr :: Buffer -> IO String
buffToStr buffer@(Buffer binHandle) = do
   resetBin binHandle
   len <- sizeBinMem binHandle
   buffToStrSize len buffer

-- |Internal helper function to grab the given number of chars from
-- this handle.
getMany :: BinHandle -> Int -> IO String
getMany _  0 = return []
getMany bh n = do x <- Binary.get bh
                  xs <- getMany bh (n-1)
                  return (x:xs)

-- |Allocate a new buffer of the given size and perform the given
-- function on that buffer. FIX: Free the buffer when done?
withBuffSize :: Int -> (Buffer -> IO a) -> IO a
withBuffSize sz f
    | sz <= 0 = error "withBuffSize 0!"
    | otherwise = openBinMem sz >>= f . Buffer

-- |Convert this Halfs Buffer to a C Buffer, starting at the current
-- pointer.  The buffer's pointer will be returned to its location.
buffToCBuff :: Buffer -> Ptr Word8 -> CSize -> IO ()
buffToCBuff = forwardTwixt loop
    where loop _ _ 0 = return ()
	  loop ptr (Buffer binHandle) i = do
		ptr_handle <- openFixedSysHandle 
				 (mkSysArray (fromIntegral i)
					     ptr
				             False)
		resetBin ptr_handle
		copyBytes binHandle ptr_handle (fromIntegral i)
		return ()

-- |Convert this C buffer to a Halfs Buffer, starting at the current
-- pointer.  The buffer's pointer will be returned to its location.
cBuffToBuff :: Buffer -> Ptr Word8 -> CSize -> IO ()
cBuffToBuff = forwardTwixt loop
    where loop _ _ 0 = return ()
	  loop ptr (Buffer binHandle) i = do
		ptr_handle <- openFixedSysHandle 
				 (mkSysArray (fromIntegral i)
					     ptr
				             True) -- Read Only
		resetBin ptr_handle
		copyBytes ptr_handle binHandle (fromIntegral i)
		return ()

forwardTwixt :: (Ptr Word8 -> Buffer -> CSize -> IO ()) -> Buffer -> Ptr Word8 -> CSize -> IO ()
forwardTwixt f b@(Buffer binHandle) ptr len
    | len < 0 = error "FIX: negative number to cBuffToBuff"
    | otherwise = do loc <- tellBin binHandle
                     f ptr b len
                     seekBin binHandle loc  -- put the pounter back

-- |Move the buffer's pointer forward.
plusBuff :: Buffer -> Int -> IO ()
plusBuff (Buffer binHandle) n = do
  BinPtr curr <- tellBin binHandle
  seekBin binHandle (BinPtr $ curr + n)
  return ()

-- |Seek forward or backward on this buffer.
buffSeek :: Buffer -> Int -> IO ()
buffSeek (Buffer binHandle) n
  = seekBin binHandle (BinPtr n)

-- |Get the BinHandle out of this buffer.
buffGetHandle :: Buffer -> BinHandle
buffGetHandle (Buffer b) = b