module System.Process.Pipe.Plumbing
( Tap(..), Sink(..)
, bufferSize
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Foldable (toList)
import Data.Sequence (Seq)
import qualified Data.Sequence as S
import Data.Word (Word8)
import Foreign.Marshal.Array (peekArray, pokeArray)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable, sizeOf)
import System.IO (Handle, hGetBuf, hPutBuf, hIsEOF)
class Tap a where
flowOut :: a -> Ptr Word8 -> Int -> IO (a, Int)
exhausted :: a -> IO Bool
class Sink a where
flowIn :: a -> Ptr Word8 -> Int -> IO a
bufferSize :: Int
bufferSize = 32*1024
instance Tap Handle where flowOut h b s = hGetBuf h b s >>= return . (,) h
exhausted = hIsEOF
instance Sink Handle where flowIn h b s = hPutBuf h b s >> return h
instance Storable a => Tap [a] where
exhausted = return . null
flowOut x buf sz = do
let size = sizeOf (head x)
(xs, ys) = splitAt (sz `div` size) x
sz' = if null ys then size * length xs else sz
pokeArray (castPtr buf) xs
return (ys, sz')
instance Storable a => Sink [a] where
flowIn x buf sz = do
xs <- peekArray (sz `div` sizeOf (head x)) (castPtr buf)
return (x ++ xs)
instance Storable a => Tap (Seq a) where
exhausted = return . S.null
flowOut x buf sz = do
let size = sizeOf (S.index x 0)
(xs, ys) = S.splitAt (sz `div` size) x
pokeArray (castPtr buf) (toList xs)
return (ys, size * S.length xs)
instance Storable a => Sink (Seq a) where
flowIn x buf sz = do
xs <- peekArray (sz `div` sizeOf (S.index x 0)) (castPtr buf)
return (x S.>< S.fromList xs)
instance Tap BS.ByteString where
exhausted = return . BS.null
flowOut x buf sz = do
let (xs, ys) = BS.splitAt sz x
pokeArray (castPtr buf) (BS.unpack xs)
return (ys, BS.length xs)
instance Tap BL.ByteString where
exhausted = return . BL.null
flowOut x buf sz = do
let (xs, ys) = BL.splitAt (fromIntegral sz) x
pokeArray (castPtr buf) (BL.unpack xs)
return (ys, fromIntegral . BL.length $ xs)
instance Sink BS.ByteString where
flowIn x buf sz = do
xs <- peekArray sz (castPtr buf)
return (x `BS.append` BS.pack xs)
instance Sink BL.ByteString where
flowIn x buf sz = do
xs <- peekArray sz (castPtr buf)
return (x `BL.append` BL.pack xs)