{-# LANGUAGE FlexibleContexts #-}
module Raaz.Core.ByteSource
(
ByteSource(..), PureByteSource
, FillResult(..)
, fill, processChunks
, withFillResult
) where
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Raaz.Core.Prelude
import Raaz.Core.Types (BYTES, Ptr, LengthUnit (..), movePtr)
import Raaz.Core.Util.ByteString( unsafeCopyToPointer
, unsafeNCopyToPointer
, length
)
import Raaz.Core.Types.Pointer (hFillBuf, Pointer, unsafeWithPointer)
data FillResult a = Remaining a
| Exhausted (BYTES Int)
deriving (Int -> FillResult a -> ShowS
[FillResult a] -> ShowS
FillResult a -> String
(Int -> FillResult a -> ShowS)
-> (FillResult a -> String)
-> ([FillResult a] -> ShowS)
-> Show (FillResult a)
forall a. Show a => Int -> FillResult a -> ShowS
forall a. Show a => [FillResult a] -> ShowS
forall a. Show a => FillResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FillResult a -> ShowS
showsPrec :: Int -> FillResult a -> ShowS
$cshow :: forall a. Show a => FillResult a -> String
show :: FillResult a -> String
$cshowList :: forall a. Show a => [FillResult a] -> ShowS
showList :: [FillResult a] -> ShowS
Show, FillResult a -> FillResult a -> Bool
(FillResult a -> FillResult a -> Bool)
-> (FillResult a -> FillResult a -> Bool) -> Eq (FillResult a)
forall a. Eq a => FillResult a -> FillResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FillResult a -> FillResult a -> Bool
== :: FillResult a -> FillResult a -> Bool
$c/= :: forall a. Eq a => FillResult a -> FillResult a -> Bool
/= :: FillResult a -> FillResult a -> Bool
Eq)
instance Functor FillResult where
fmap :: forall a b. (a -> b) -> FillResult a -> FillResult b
fmap a -> b
f (Remaining a
a ) = b -> FillResult b
forall a. a -> FillResult a
Remaining (b -> FillResult b) -> b -> FillResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
fmap a -> b
_ (Exhausted BYTES Int
sz) = BYTES Int -> FillResult b
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
sz
withFillResult :: (a -> b)
-> (BYTES Int -> b)
-> FillResult a
-> b
withFillResult :: forall a b. (a -> b) -> (BYTES Int -> b) -> FillResult a -> b
withFillResult a -> b
continueWith BYTES Int -> b
_ (Remaining a
a) = a -> b
continueWith a
a
withFillResult a -> b
_ BYTES Int -> b
endBy (Exhausted BYTES Int
sz) = BYTES Int -> b
endBy BYTES Int
sz
class ByteSource src where
fillBytes :: BYTES Int
-> src
-> Ptr a
-> IO (FillResult src)
fill :: ( Pointer ptr
, LengthUnit len
, ByteSource src
)
=> len
-> src
-> ptr a
-> IO (FillResult src)
fill :: forall (ptr :: * -> *) len src a.
(Pointer ptr, LengthUnit len, ByteSource src) =>
len -> src -> ptr a -> IO (FillResult src)
fill len
len src
src = (Ptr a -> IO (FillResult src)) -> ptr a -> IO (FillResult src)
forall (ptr :: * -> *) a b.
Pointer ptr =>
(Ptr a -> b) -> ptr a -> b
unsafeWithPointer ((Ptr a -> IO (FillResult src)) -> ptr a -> IO (FillResult src))
-> (Ptr a -> IO (FillResult src)) -> ptr a -> IO (FillResult src)
forall a b. (a -> b) -> a -> b
$ BYTES Int -> src -> Ptr a -> IO (FillResult src)
forall a. BYTES Int -> src -> Ptr a -> IO (FillResult src)
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes (len -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes len
len) src
src
{-# INLINE fill #-}
processChunks :: ( Pointer ptr, MonadIO m, LengthUnit chunkSize, ByteSource src)
=> m a
-> (BYTES Int -> m b)
-> src
-> ptr something
-> chunkSize
-> m b
processChunks :: forall (ptr :: * -> *) (m :: * -> *) chunkSize src a b something.
(Pointer ptr, MonadIO m, LengthUnit chunkSize, ByteSource src) =>
m a
-> (BYTES Int -> m b) -> src -> ptr something -> chunkSize -> m b
processChunks m a
mid BYTES Int -> m b
end src
source ptr something
ptr chunkSize
csz = src -> m b
forall {src}. ByteSource src => src -> m b
go src
source
where fillChunk :: src -> m (FillResult src)
fillChunk src
src = IO (FillResult src) -> m (FillResult src)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FillResult src) -> m (FillResult src))
-> IO (FillResult src) -> m (FillResult src)
forall a b. (a -> b) -> a -> b
$ chunkSize -> src -> ptr something -> IO (FillResult src)
forall (ptr :: * -> *) len src a.
(Pointer ptr, LengthUnit len, ByteSource src) =>
len -> src -> ptr a -> IO (FillResult src)
fill chunkSize
csz src
src ptr something
ptr
step :: src -> m b
step src
src = m a
mid m a -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> src -> m b
go src
src
go :: src -> m b
go src
src = src -> m (FillResult src)
forall {m :: * -> *} {src}.
(MonadIO m, ByteSource src) =>
src -> m (FillResult src)
fillChunk src
src m (FillResult src) -> (FillResult src -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (src -> m b) -> (BYTES Int -> m b) -> FillResult src -> m b
forall a b. (a -> b) -> (BYTES Int -> b) -> FillResult a -> b
withFillResult src -> m b
step BYTES Int -> m b
end
class ByteSource src => PureByteSource src where
instance ByteSource Handle where
{-# INLINE fillBytes #-}
fillBytes :: forall a. BYTES Int -> Handle -> Ptr a -> IO (FillResult Handle)
fillBytes BYTES Int
sz Handle
hand Ptr a
cptr = do
BYTES Int
count <- Handle -> Ptr a -> BYTES Int -> IO (BYTES Int)
forall bufSize (ptr :: * -> *) a.
(LengthUnit bufSize, Pointer ptr) =>
Handle -> ptr a -> bufSize -> IO (BYTES Int)
hFillBuf Handle
hand Ptr a
cptr BYTES Int
sz
Bool
eof <- Handle -> IO Bool
hIsEOF Handle
hand
if Bool
eof then FillResult Handle -> IO (FillResult Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult Handle -> IO (FillResult Handle))
-> FillResult Handle -> IO (FillResult Handle)
forall a b. (a -> b) -> a -> b
$ BYTES Int -> FillResult Handle
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
count
else FillResult Handle -> IO (FillResult Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult Handle -> IO (FillResult Handle))
-> FillResult Handle -> IO (FillResult Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> FillResult Handle
forall a. a -> FillResult a
Remaining Handle
hand
instance ByteSource B.ByteString where
{-# INLINE fillBytes #-}
fillBytes :: forall a.
BYTES Int -> ByteString -> Ptr a -> IO (FillResult ByteString)
fillBytes BYTES Int
sz ByteString
bs Ptr a
cptr | BYTES Int
l BYTES Int -> BYTES Int -> Bool
forall a. Ord a => a -> a -> Bool
<= BYTES Int
sz = do ByteString -> Ptr a -> IO ()
forall (ptr :: * -> *) a.
Pointer ptr =>
ByteString -> ptr a -> IO ()
unsafeCopyToPointer ByteString
bs Ptr a
cptr
FillResult ByteString -> IO (FillResult ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult ByteString -> IO (FillResult ByteString))
-> FillResult ByteString -> IO (FillResult ByteString)
forall a b. (a -> b) -> a -> b
$ BYTES Int -> FillResult ByteString
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
l
| Bool
otherwise = do BYTES Int -> ByteString -> Ptr a -> IO ()
forall n a. LengthUnit n => n -> ByteString -> Ptr a -> IO ()
unsafeNCopyToPointer BYTES Int
sz ByteString
bs Ptr a
cptr
FillResult ByteString -> IO (FillResult ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult ByteString -> IO (FillResult ByteString))
-> FillResult ByteString -> IO (FillResult ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> FillResult ByteString
forall a. a -> FillResult a
Remaining ByteString
rest
where l :: BYTES Int
l = ByteString -> BYTES Int
length ByteString
bs
rest :: ByteString
rest = Int -> ByteString -> ByteString
B.drop (BYTES Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BYTES Int
sz) ByteString
bs
instance ByteSource L.ByteString where
{-# INLINE fillBytes #-}
fillBytes :: forall a.
BYTES Int -> ByteString -> Ptr a -> IO (FillResult ByteString)
fillBytes BYTES Int
sz ByteString
bs = (FillResult [ByteString] -> FillResult ByteString)
-> IO (FillResult [ByteString]) -> IO (FillResult ByteString)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([ByteString] -> ByteString)
-> FillResult [ByteString] -> FillResult ByteString
forall a b. (a -> b) -> FillResult a -> FillResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
L.fromChunks) (IO (FillResult [ByteString]) -> IO (FillResult ByteString))
-> (Ptr a -> IO (FillResult [ByteString]))
-> Ptr a
-> IO (FillResult ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BYTES Int -> [ByteString] -> Ptr a -> IO (FillResult [ByteString])
forall a.
BYTES Int -> [ByteString] -> Ptr a -> IO (FillResult [ByteString])
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes BYTES Int
sz (ByteString -> [ByteString]
L.toChunks ByteString
bs)
instance ByteSource src => ByteSource (Maybe src) where
{-# INLINE fillBytes #-}
fillBytes :: forall a.
BYTES Int -> Maybe src -> Ptr a -> IO (FillResult (Maybe src))
fillBytes BYTES Int
sz Maybe src
ma Ptr a
cptr = IO (FillResult (Maybe src))
-> (src -> IO (FillResult (Maybe src)))
-> Maybe src
-> IO (FillResult (Maybe src))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (FillResult (Maybe src))
forall {a}. IO (FillResult a)
exhausted src -> IO (FillResult (Maybe src))
forall {a}. ByteSource a => a -> IO (FillResult (Maybe a))
fillIt Maybe src
ma
where exhausted :: IO (FillResult a)
exhausted = FillResult a -> IO (FillResult a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult a -> IO (FillResult a))
-> FillResult a -> IO (FillResult a)
forall a b. (a -> b) -> a -> b
$ BYTES Int -> FillResult a
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
0
fillIt :: a -> IO (FillResult (Maybe a))
fillIt a
a = (a -> Maybe a) -> FillResult a -> FillResult (Maybe a)
forall a b. (a -> b) -> FillResult a -> FillResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (FillResult a -> FillResult (Maybe a))
-> IO (FillResult a) -> IO (FillResult (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BYTES Int -> a -> Ptr a -> IO (FillResult a)
forall a. BYTES Int -> a -> Ptr a -> IO (FillResult a)
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes BYTES Int
sz a
a Ptr a
cptr
instance ByteSource src => ByteSource [src] where
fillBytes :: forall a. BYTES Int -> [src] -> Ptr a -> IO (FillResult [src])
fillBytes BYTES Int
_ [] Ptr a
_ = FillResult [src] -> IO (FillResult [src])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult [src] -> IO (FillResult [src]))
-> FillResult [src] -> IO (FillResult [src])
forall a b. (a -> b) -> a -> b
$ BYTES Int -> FillResult [src]
forall a. BYTES Int -> FillResult a
Exhausted BYTES Int
0
fillBytes BYTES Int
sz (src
x:[src]
xs) Ptr a
cptr = do
FillResult src
result <- BYTES Int -> src -> Ptr a -> IO (FillResult src)
forall a. BYTES Int -> src -> Ptr a -> IO (FillResult src)
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes BYTES Int
sz src
x Ptr a
cptr
case FillResult src
result of
Remaining src
nx -> FillResult [src] -> IO (FillResult [src])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult [src] -> IO (FillResult [src]))
-> FillResult [src] -> IO (FillResult [src])
forall a b. (a -> b) -> a -> b
$ [src] -> FillResult [src]
forall a. a -> FillResult a
Remaining ([src] -> FillResult [src]) -> [src] -> FillResult [src]
forall a b. (a -> b) -> a -> b
$ src
nxsrc -> [src] -> [src]
forall a. a -> [a] -> [a]
:[src]
xs
Exhausted BYTES Int
bytesX -> let nptr :: Ptr a
nptr = Ptr a -> BYTES Int -> Ptr a
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
movePtr Ptr a
cptr BYTES Int
bytesX
whenXSExhausted :: BYTES Int -> m (FillResult a)
whenXSExhausted BYTES Int
bytesXS = FillResult a -> m (FillResult a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult a -> m (FillResult a))
-> FillResult a -> m (FillResult a)
forall a b. (a -> b) -> a -> b
$ BYTES Int -> FillResult a
forall a. BYTES Int -> FillResult a
Exhausted (BYTES Int -> FillResult a) -> BYTES Int -> FillResult a
forall a b. (a -> b) -> a -> b
$ BYTES Int
bytesX BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
+ BYTES Int
bytesXS
whenXSRemains :: a -> IO (FillResult a)
whenXSRemains = FillResult a -> IO (FillResult a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FillResult a -> IO (FillResult a))
-> (a -> FillResult a) -> a -> IO (FillResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FillResult a
forall a. a -> FillResult a
Remaining
in BYTES Int -> [src] -> Ptr a -> IO (FillResult [src])
forall a. BYTES Int -> [src] -> Ptr a -> IO (FillResult [src])
forall src a.
ByteSource src =>
BYTES Int -> src -> Ptr a -> IO (FillResult src)
fillBytes (BYTES Int
sz BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BYTES Int
bytesX) [src]
xs Ptr a
nptr
IO (FillResult [src])
-> (FillResult [src] -> IO (FillResult [src]))
-> IO (FillResult [src])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([src] -> IO (FillResult [src]))
-> (BYTES Int -> IO (FillResult [src]))
-> FillResult [src]
-> IO (FillResult [src])
forall a b. (a -> b) -> (BYTES Int -> b) -> FillResult a -> b
withFillResult [src] -> IO (FillResult [src])
forall {a}. a -> IO (FillResult a)
whenXSRemains BYTES Int -> IO (FillResult [src])
forall {m :: * -> *} {a}. Monad m => BYTES Int -> m (FillResult a)
whenXSExhausted
instance PureByteSource B.ByteString where
instance PureByteSource L.ByteString where
instance PureByteSource src => PureByteSource [src]
instance PureByteSource src => PureByteSource (Maybe src)