{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
module Raaz.Core.Transfer
(
Transfer, ReadFrom, WriteTo
, consume, consumeStorable, consumeParse
, writeEncodable
, write, writeStorable, writeVector, writeStorableVector
, writeBytes
, padWrite, prependWrite, glueWrites
, writeByteString
, transferSize
, skip
) where
import qualified Data.Vector.Generic as G
import Foreign.Storable ( Storable, poke )
import Raaz.Core.Transfer.Unsafe
import Raaz.Core.Prelude
import Raaz.Core.Parse.Unsafe
import Raaz.Core.Parse hiding (skip)
import Raaz.Core.Types.Endian
import Raaz.Core.Types.Pointer
import Raaz.Core.Encode
skip :: LengthUnit l => l -> Transfer t
skip :: forall l (t :: Mode). LengthUnit l => l -> Transfer t
skip = (l -> (Ptr Word8 -> IO ()) -> Transfer t)
-> (Ptr Word8 -> IO ()) -> l -> Transfer t
forall a b c. (a -> b -> c) -> b -> a -> c
flip l -> (Ptr Word8 -> IO ()) -> Transfer t
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer Ptr Word8 -> IO ()
forall {b}. b -> IO ()
doNothing
where doNothing :: b -> IO ()
doNothing = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
consumeParse :: Parser a -> (a -> IO b) -> ReadFrom
consumeParse :: forall a b. Parser a -> (a -> IO b) -> ReadFrom
consumeParse Parser a
p a -> IO b
action = BYTES Int -> (Ptr Word8 -> IO ()) -> ReadFrom
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (Parser a -> BYTES Int
forall a. Parser a -> BYTES Int
parseWidth Parser a
p) ((Ptr Word8 -> IO ()) -> ReadFrom)
-> (Ptr Word8 -> IO ()) -> ReadFrom
forall a b. (a -> b) -> a -> b
$
Parser a -> Ptr Word8 -> IO a
forall (ptr :: * -> *) a b.
Pointer ptr =>
Parser a -> ptr b -> IO a
unsafeRunParser Parser a
p (Ptr Word8 -> IO a) -> (a -> IO ()) -> Ptr Word8 -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> (a -> IO b) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
action
consume :: EndianStore a
=> (a -> IO b)
-> ReadFrom
consume :: forall a b. EndianStore a => (a -> IO b) -> ReadFrom
consume = Parser a -> (a -> IO b) -> ReadFrom
forall a b. Parser a -> (a -> IO b) -> ReadFrom
consumeParse Parser a
forall a. EndianStore a => Parser a
parse
consumeStorable :: Storable a
=> (a -> IO b)
-> ReadFrom
consumeStorable :: forall a b. Storable a => (a -> IO b) -> ReadFrom
consumeStorable = Parser a -> (a -> IO b) -> ReadFrom
forall a b. Parser a -> (a -> IO b) -> ReadFrom
consumeParse Parser a
forall a. Storable a => Parser a
parseStorable
writeStorable :: Storable a => a -> WriteTo
writeStorable :: forall a. Storable a => a -> WriteTo
writeStorable a
a = BYTES Int -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) Ptr Word8 -> IO ()
forall {a}. Ptr a -> IO ()
pokeIt
where pokeIt :: Ptr a -> IO ()
pokeIt = (Ptr a -> a -> IO ()) -> a -> Ptr a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke a
a (Ptr a -> IO ()) -> (Ptr a -> Ptr a) -> Ptr a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr a
forall a b. Ptr a -> Ptr b
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer
write :: EndianStore a => a -> WriteTo
write :: forall a. EndianStore a => a -> WriteTo
write a
a = BYTES Int -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) ((Ptr Word8 -> IO ()) -> WriteTo)
-> (Ptr Word8 -> IO ()) -> WriteTo
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> a -> IO ()) -> a -> Ptr Word8 -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ptr a -> a -> IO ()
forall w. EndianStore w => Ptr w -> w -> IO ()
store (Ptr a -> a -> IO ())
-> (Ptr Word8 -> Ptr a) -> Ptr Word8 -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer) a
a
writeEncodable :: Encodable a => a -> WriteTo
writeEncodable :: forall a. Encodable a => a -> WriteTo
writeEncodable = ByteString -> WriteTo
writeByteString (ByteString -> WriteTo) -> (a -> ByteString) -> a -> WriteTo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Encodable a => a -> ByteString
toByteString
writeStorableVector :: (Storable a, G.Vector v a) => v a -> WriteTo
{-# INLINE writeStorableVector #-}
writeStorableVector :: forall a (v :: * -> *). (Storable a, Vector v a) => v a -> WriteTo
writeStorableVector = (WriteTo -> a -> WriteTo) -> WriteTo -> v a -> WriteTo
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
G.foldl' WriteTo -> a -> WriteTo
forall {a}. Storable a => WriteTo -> a -> WriteTo
foldFunc WriteTo
forall a. Monoid a => a
mempty
where foldFunc :: WriteTo -> a -> WriteTo
foldFunc WriteTo
w a
a = WriteTo
w WriteTo -> WriteTo -> WriteTo
forall a. Semigroup a => a -> a -> a
<> a -> WriteTo
forall a. Storable a => a -> WriteTo
writeStorable a
a
writeVector :: (EndianStore a, G.Vector v a) => v a -> WriteTo
{-# INLINE writeVector #-}
writeVector :: forall a (v :: * -> *).
(EndianStore a, Vector v a) =>
v a -> WriteTo
writeVector = (WriteTo -> a -> WriteTo) -> WriteTo -> v a -> WriteTo
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
G.foldl' WriteTo -> a -> WriteTo
forall {a}. EndianStore a => WriteTo -> a -> WriteTo
foldFunc WriteTo
forall a. Monoid a => a
mempty
where foldFunc :: WriteTo -> a -> WriteTo
foldFunc WriteTo
w a
a = WriteTo
w WriteTo -> WriteTo -> WriteTo
forall a. Semigroup a => a -> a -> a
<> a -> WriteTo
forall a. EndianStore a => a -> WriteTo
write a
a
writeBytes :: LengthUnit n
=> Word8
-> n
-> WriteTo
writeBytes :: forall n. LengthUnit n => Word8 -> n -> WriteTo
writeBytes Word8
w8 n
n = n -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer n
n Ptr Word8 -> IO ()
forall {ptr :: * -> *} {a}. Pointer ptr => ptr a -> IO ()
memsetIt
where memsetIt :: ptr a -> IO ()
memsetIt ptr a
cptr = ptr a -> Word8 -> n -> IO ()
forall l (ptr :: * -> *) a.
(LengthUnit l, Pointer ptr) =>
ptr a -> Word8 -> l -> IO ()
memset ptr a
cptr Word8
w8 n
n
glueWrites :: LengthUnit n
=> Word8
-> n
-> WriteTo
-> WriteTo
-> WriteTo
glueWrites :: forall n.
LengthUnit n =>
Word8 -> n -> WriteTo -> WriteTo -> WriteTo
glueWrites Word8
w8 n
n WriteTo
hdr WriteTo
ftr = WriteTo
hdr WriteTo -> WriteTo -> WriteTo
forall a. Semigroup a => a -> a -> a
<> Word8 -> BYTES Int -> WriteTo
forall n. LengthUnit n => Word8 -> n -> WriteTo
writeBytes Word8
w8 BYTES Int
lglue WriteTo -> WriteTo -> WriteTo
forall a. Semigroup a => a -> a -> a
<> WriteTo
ftr
where lhead :: BYTES Int
lhead = WriteTo -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize WriteTo
hdr
lfoot :: BYTES Int
lfoot = WriteTo -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize WriteTo
ftr
lexceed :: BYTES Int
lexceed = (BYTES Int
lhead BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
+ BYTES Int
lfoot) BYTES Int -> BYTES Int -> BYTES Int
forall a. Integral a => a -> a -> a
`rem` BYTES Int
nBytes
lglue :: BYTES Int
lglue = if BYTES Int
lexceed BYTES Int -> BYTES Int -> Bool
forall a. Ord a => a -> a -> Bool
> BYTES Int
0 then BYTES Int
nBytes BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- BYTES Int
lexceed else BYTES Int
0
nBytes :: BYTES Int
nBytes = n -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes n
n
prependWrite :: LengthUnit n
=> Word8
-> n
-> WriteTo
-> WriteTo
prependWrite :: forall n. LengthUnit n => Word8 -> n -> WriteTo -> WriteTo
prependWrite Word8
w8 n
n = Word8 -> n -> WriteTo -> WriteTo -> WriteTo
forall n.
LengthUnit n =>
Word8 -> n -> WriteTo -> WriteTo -> WriteTo
glueWrites Word8
w8 n
n WriteTo
forall a. Monoid a => a
mempty
padWrite :: LengthUnit n
=> Word8
-> n
-> WriteTo
-> WriteTo
padWrite :: forall n. LengthUnit n => Word8 -> n -> WriteTo -> WriteTo
padWrite Word8
w8 n
n = (WriteTo -> WriteTo -> WriteTo) -> WriteTo -> WriteTo -> WriteTo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word8 -> n -> WriteTo -> WriteTo -> WriteTo
forall n.
LengthUnit n =>
Word8 -> n -> WriteTo -> WriteTo -> WriteTo
glueWrites Word8
w8 n
n) WriteTo
forall a. Monoid a => a
mempty