module Raaz.Core.ByteSource
( ByteSource(..), fill, processChunks
, InfiniteSource(..), slurp
, PureByteSource
, FillResult(..)
, withFillResult
) where
import Control.Applicative
import Control.Monad (liftM)
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import Prelude hiding(length)
import System.IO (Handle)
import Raaz.Core.MonoidalAction
import Raaz.Core.Types (BYTES, Pointer, LengthUnit (..))
import Raaz.Core.Util.ByteString( unsafeCopyToPointer
, unsafeNCopyToPointer
, length
)
import Raaz.Core.Types.Pointer (hFillBuf)
data FillResult a = Remaining a
| Exhausted (BYTES Int)
instance Functor FillResult where
fmap f (Remaining a ) = Remaining $ f a
fmap _ (Exhausted sz) = Exhausted sz
withFillResult :: (a -> b)
-> (BYTES Int -> b)
-> FillResult a
-> b
withFillResult continueWith _ (Remaining a) = continueWith a
withFillResult _ endBy (Exhausted sz) = endBy sz
class ByteSource src where
fillBytes :: BYTES Int
-> src
-> Pointer
-> IO (FillResult src)
default fillBytes :: InfiniteSource src => BYTES Int -> src -> Pointer -> IO (FillResult src)
fillBytes sz src pointer = Remaining <$> slurp sz src pointer
class InfiniteSource src where
slurpBytes :: BYTES Int
-> src
-> Pointer
-> IO src
fill :: ( LengthUnit len
, ByteSource src
)
=> len
-> src
-> Pointer
-> IO (FillResult src)
fill = fillBytes . inBytes
slurp :: ( LengthUnit len
, InfiniteSource src
)
=> len
-> src
-> Pointer
-> IO src
slurp = slurpBytes . inBytes
processChunks :: ( MonadIO m, LengthUnit chunkSize, ByteSource src)
=> m a
-> (BYTES Int -> m b)
-> src
-> chunkSize
-> Pointer
-> m b
processChunks mid end source csz ptr = go source
where fillChunk src = liftIO $ fill csz src ptr
step src = mid >> go src
go src = fillChunk src >>= withFillResult step end
class ByteSource src => PureByteSource src where
instance ByteSource Handle where
fillBytes sz hand cptr = do
count <- hFillBuf hand cptr sz
return
(if count < sz then Exhausted count
else Remaining hand)
instance ByteSource B.ByteString where
fillBytes sz bs cptr | l < sz = do unsafeCopyToPointer bs cptr
return $ Exhausted l
| otherwise = do unsafeNCopyToPointer sz bs cptr
return $ Remaining rest
where l = length bs
rest = B.drop (fromIntegral sz) bs
instance ByteSource L.ByteString where
fillBytes sz bs = liftM (fmap L.fromChunks)
. fillBytes sz (L.toChunks bs)
instance ByteSource src => ByteSource (Maybe src) where
fillBytes sz ma cptr = maybe exhausted fillIt ma
where exhausted = return $ Exhausted 0
fillIt a = fmap Just <$> fillBytes sz a cptr
instance ByteSource src => ByteSource [src] where
fillBytes _ [] _ = return $ Exhausted 0
fillBytes sz (x:xs) cptr = do
result <- fillBytes sz x cptr
case result of
Exhausted rbytes -> let nptr = Sum rbytes <.> cptr
in fillBytes (sz rbytes) xs nptr
Remaining nx -> return $ Remaining $ nx:xs
instance PureByteSource B.ByteString where
instance PureByteSource L.ByteString where
instance PureByteSource src => PureByteSource [src]
instance PureByteSource src => PureByteSource (Maybe src)