{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 0
#endif
#ifndef MIN_VERSION_bytestring
#define MIN_VERSION_bytestring(x,y,z) 0
#endif
module Data.Serialize.Put (
Put
, PutM(..)
, Putter
, runPut
, runPutM
, runPutLazy
, runPutMLazy
, runPutMBuilder
, putBuilder
, execPut
, flush
, putWord8
, putInt8
, putByteString
, putLazyByteString
, putShortByteString
, putWord16be
, putWord32be
, putWord64be
, putInt16be
, putInt32be
, putInt64be
, putWord16le
, putWord32le
, putWord64le
, putInt16le
, putInt32le
, putInt64le
, putWordhost
, putWord16host
, putWord32host
, putWord64host
, putInthost
, putInt16host
, putInt32host
, putInt64host
, putTwoOf
, putListOf
, putIArrayOf
, putSeqOf
, putTreeOf
, putMapOf
, putIntMapOf
, putSetOf
, putIntSetOf
, putMaybeOf
, putEitherOf
, putNested
) where
import Data.ByteString.Builder (Builder, toLazyByteString)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.ByteString.Short as BS
import qualified Control.Applicative as A
import Data.Array.Unboxed
#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as M
#endif
import qualified Data.Monoid as M
import qualified Data.Foldable as F
import Data.Word
import Data.Int
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Tree as T
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
import Data.Foldable (foldMap)
import Data.Monoid
#endif
#if !(MIN_VERSION_bytestring(0,10,0))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (plusPtr)
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy.Internal as L
#endif
data PairS a = PairS a !Builder
sndS :: PairS a -> Builder
sndS :: PairS a -> Builder
sndS (PairS a
_ Builder
b) = Builder
b
newtype PutM a = Put { PutM a -> PairS a
unPut :: PairS a }
type Put = PutM ()
type Putter a = a -> Put
instance Functor PutM where
fmap :: (a -> b) -> PutM a -> PutM b
fmap a -> b
f PutM a
m = PairS b -> PutM b
forall a. PairS a -> PutM a
Put (PairS b -> PutM b) -> PairS b -> PutM b
forall a b. (a -> b) -> a -> b
$ let PairS a
a Builder
w = PutM a -> PairS a
forall a. PutM a -> PairS a
unPut PutM a
m in b -> Builder -> PairS b
forall a. a -> Builder -> PairS a
PairS (a -> b
f a
a) Builder
w
{-# INLINE fmap #-}
instance A.Applicative PutM where
pure :: a -> PutM a
pure a
a = PairS a -> PutM a
forall a. PairS a -> PutM a
Put (a -> Builder -> PairS a
forall a. a -> Builder -> PairS a
PairS a
a Builder
forall a. Monoid a => a
M.mempty)
{-# INLINE pure #-}
PutM (a -> b)
m <*> :: PutM (a -> b) -> PutM a -> PutM b
<*> PutM a
k = PairS b -> PutM b
forall a. PairS a -> PutM a
Put (PairS b -> PutM b) -> PairS b -> PutM b
forall a b. (a -> b) -> a -> b
$
let PairS a -> b
f Builder
w = PutM (a -> b) -> PairS (a -> b)
forall a. PutM a -> PairS a
unPut PutM (a -> b)
m
PairS a
x Builder
w' = PutM a -> PairS a
forall a. PutM a -> PairS a
unPut PutM a
k
in b -> Builder -> PairS b
forall a. a -> Builder -> PairS a
PairS (a -> b
f a
x) (Builder
w Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`M.mappend` Builder
w')
{-# INLINE (<*>) #-}
PutM a
m *> :: PutM a -> PutM b -> PutM b
*> PutM b
k = PairS b -> PutM b
forall a. PairS a -> PutM a
Put (PairS b -> PutM b) -> PairS b -> PutM b
forall a b. (a -> b) -> a -> b
$
let PairS a
_ Builder
w = PutM a -> PairS a
forall a. PutM a -> PairS a
unPut PutM a
m
PairS b
b Builder
w' = PutM b -> PairS b
forall a. PutM a -> PairS a
unPut PutM b
k
in b -> Builder -> PairS b
forall a. a -> Builder -> PairS a
PairS b
b (Builder
w Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`M.mappend` Builder
w')
{-# INLINE (*>) #-}
instance Monad PutM where
return :: a -> PutM a
return = a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
PutM a
m >>= :: PutM a -> (a -> PutM b) -> PutM b
>>= a -> PutM b
k = PairS b -> PutM b
forall a. PairS a -> PutM a
Put (PairS b -> PutM b) -> PairS b -> PutM b
forall a b. (a -> b) -> a -> b
$
let PairS a
a Builder
w = PutM a -> PairS a
forall a. PutM a -> PairS a
unPut PutM a
m
PairS b
b Builder
w' = PutM b -> PairS b
forall a. PutM a -> PairS a
unPut (a -> PutM b
k a
a)
in b -> Builder -> PairS b
forall a. a -> Builder -> PairS a
PairS b
b (Builder
w Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`M.mappend` Builder
w')
{-# INLINE (>>=) #-}
>> :: PutM a -> PutM b -> PutM b
(>>) = PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (>>) #-}
#if MIN_VERSION_base(4,9,0)
instance M.Semigroup (PutM ()) where
<> :: PutM () -> PutM () -> PutM ()
(<>) = PutM () -> PutM () -> PutM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (<>) #-}
#endif
instance Monoid (PutM ()) where
mempty :: PutM ()
mempty = () -> PutM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend = (*>)
{-# INLINE mappend #-}
#endif
tell :: Putter Builder
tell :: Putter Builder
tell Builder
b = PairS () -> PutM ()
forall a. PairS a -> PutM a
Put (PairS () -> PutM ()) -> PairS () -> PutM ()
forall a b. (a -> b) -> a -> b
$! () -> Builder -> PairS ()
forall a. a -> Builder -> PairS a
PairS () Builder
b
{-# INLINE tell #-}
putBuilder :: Putter Builder
putBuilder :: Putter Builder
putBuilder = Putter Builder
tell
{-# INLINE putBuilder #-}
execPut :: PutM a -> Builder
execPut :: PutM a -> Builder
execPut = PairS a -> Builder
forall a. PairS a -> Builder
sndS (PairS a -> Builder) -> (PutM a -> PairS a) -> PutM a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM a -> PairS a
forall a. PutM a -> PairS a
unPut
{-# INLINE execPut #-}
runPut :: Put -> S.ByteString
runPut :: PutM () -> ByteString
runPut = ByteString -> ByteString
lazyToStrictByteString (ByteString -> ByteString)
-> (PutM () -> ByteString) -> PutM () -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM () -> ByteString
runPutLazy
{-# INLINE runPut #-}
runPutM :: PutM a -> (a, S.ByteString)
runPutM :: PutM a -> (a, ByteString)
runPutM (Put (PairS a
f Builder
s)) = (a
f, ByteString -> ByteString
lazyToStrictByteString (Builder -> ByteString
toLazyByteString Builder
s))
{-# INLINE runPutM #-}
runPutLazy :: Put -> L.ByteString
runPutLazy :: PutM () -> ByteString
runPutLazy = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (PutM () -> Builder) -> PutM () -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PairS () -> Builder
forall a. PairS a -> Builder
sndS (PairS () -> Builder)
-> (PutM () -> PairS ()) -> PutM () -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM () -> PairS ()
forall a. PutM a -> PairS a
unPut
{-# INLINE runPutLazy #-}
runPutMLazy :: PutM a -> (a, L.ByteString)
runPutMLazy :: PutM a -> (a, ByteString)
runPutMLazy (Put (PairS a
f Builder
s)) = (a
f, Builder -> ByteString
toLazyByteString Builder
s)
{-# INLINE runPutMLazy #-}
runPutMBuilder :: PutM a -> (a, Builder)
runPutMBuilder :: PutM a -> (a, Builder)
runPutMBuilder (Put (PairS a
f Builder
s)) = (a
f, Builder
s)
{-# INLINE runPutMBuilder #-}
flush :: Put
flush :: PutM ()
flush = Putter Builder
tell Builder
B.flush
{-# INLINE flush #-}
putWord8 :: Putter Word8
putWord8 :: Putter Word8
putWord8 = Putter Builder
tell Putter Builder -> (Word8 -> Builder) -> Putter Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
B.word8
{-# INLINE putWord8 #-}
putInt8 :: Putter Int8
putInt8 :: Putter Int8
putInt8 = Putter Builder
tell Putter Builder -> (Int8 -> Builder) -> Putter Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Builder
B.int8
{-# INLINE putInt8 #-}
putByteString :: Putter S.ByteString
putByteString :: Putter ByteString
putByteString = Putter Builder
tell Putter Builder -> (ByteString -> Builder) -> Putter ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.byteString
{-# INLINE putByteString #-}
putShortByteString :: Putter BS.ShortByteString
putShortByteString :: Putter ShortByteString
putShortByteString = Putter Builder
tell Putter Builder
-> (ShortByteString -> Builder) -> Putter ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Builder
B.shortByteString
putLazyByteString :: Putter L.ByteString
putLazyByteString :: Putter ByteString
putLazyByteString = Putter Builder
tell Putter Builder -> (ByteString -> Builder) -> Putter ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.lazyByteString
{-# INLINE putLazyByteString #-}
putWord16be :: Putter Word16
putWord16be :: Putter Word16
putWord16be = Putter Builder
tell Putter Builder -> (Word16 -> Builder) -> Putter Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
B.word16BE
{-# INLINE putWord16be #-}
putWord16le :: Putter Word16
putWord16le :: Putter Word16
putWord16le = Putter Builder
tell Putter Builder -> (Word16 -> Builder) -> Putter Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
B.word16LE
{-# INLINE putWord16le #-}
putWord32be :: Putter Word32
putWord32be :: Putter Word32
putWord32be = Putter Builder
tell Putter Builder -> (Word32 -> Builder) -> Putter Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
B.word32BE
{-# INLINE putWord32be #-}
putWord32le :: Putter Word32
putWord32le :: Putter Word32
putWord32le = Putter Builder
tell Putter Builder -> (Word32 -> Builder) -> Putter Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
B.word32LE
{-# INLINE putWord32le #-}
putWord64be :: Putter Word64
putWord64be :: Putter Word64
putWord64be = Putter Builder
tell Putter Builder -> (Word64 -> Builder) -> Putter Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
B.word64BE
{-# INLINE putWord64be #-}
putWord64le :: Putter Word64
putWord64le :: Putter Word64
putWord64le = Putter Builder
tell Putter Builder -> (Word64 -> Builder) -> Putter Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
B.word64LE
{-# INLINE putWord64le #-}
putWordhost :: Putter Word
putWordhost :: Putter Word
putWordhost = Putter Builder
tell Putter Builder -> (Word -> Builder) -> Putter Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Builder
B.wordHost
{-# INLINE putWordhost #-}
putWord16host :: Putter Word16
putWord16host :: Putter Word16
putWord16host = Putter Builder
tell Putter Builder -> (Word16 -> Builder) -> Putter Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
B.word16Host
{-# INLINE putWord16host #-}
putWord32host :: Putter Word32
putWord32host :: Putter Word32
putWord32host = Putter Builder
tell Putter Builder -> (Word32 -> Builder) -> Putter Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
B.word32Host
{-# INLINE putWord32host #-}
putWord64host :: Putter Word64
putWord64host :: Putter Word64
putWord64host = Putter Builder
tell Putter Builder -> (Word64 -> Builder) -> Putter Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
B.word64Host
{-# INLINE putWord64host #-}
putInt16be :: Putter Int16
putInt16be :: Putter Int16
putInt16be = Putter Builder
tell Putter Builder -> (Int16 -> Builder) -> Putter Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
B.int16BE
{-# INLINE putInt16be #-}
putInt16le :: Putter Int16
putInt16le :: Putter Int16
putInt16le = Putter Builder
tell Putter Builder -> (Int16 -> Builder) -> Putter Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
B.int16LE
{-# INLINE putInt16le #-}
putInt32be :: Putter Int32
putInt32be :: Putter Int32
putInt32be = Putter Builder
tell Putter Builder -> (Int32 -> Builder) -> Putter Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
B.int32BE
{-# INLINE putInt32be #-}
putInt32le :: Putter Int32
putInt32le :: Putter Int32
putInt32le = Putter Builder
tell Putter Builder -> (Int32 -> Builder) -> Putter Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
B.int32LE
{-# INLINE putInt32le #-}
putInt64be :: Putter Int64
putInt64be :: Putter Int64
putInt64be = Putter Builder
tell Putter Builder -> (Int64 -> Builder) -> Putter Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
B.int64BE
{-# INLINE putInt64be #-}
putInt64le :: Putter Int64
putInt64le :: Putter Int64
putInt64le = Putter Builder
tell Putter Builder -> (Int64 -> Builder) -> Putter Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
B.int64LE
{-# INLINE putInt64le #-}
putInthost :: Putter Int
putInthost :: Putter Int
putInthost = Putter Builder
tell Putter Builder -> (Int -> Builder) -> Putter Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
B.intHost
{-# INLINE putInthost #-}
putInt16host :: Putter Int16
putInt16host :: Putter Int16
putInt16host = Putter Builder
tell Putter Builder -> (Int16 -> Builder) -> Putter Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
B.int16Host
{-# INLINE putInt16host #-}
putInt32host :: Putter Int32
putInt32host :: Putter Int32
putInt32host = Putter Builder
tell Putter Builder -> (Int32 -> Builder) -> Putter Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
B.int32Host
{-# INLINE putInt32host #-}
putInt64host :: Putter Int64
putInt64host :: Putter Int64
putInt64host = Putter Builder
tell Putter Builder -> (Int64 -> Builder) -> Putter Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
B.int64Host
{-# INLINE putInt64host #-}
encodeListOf :: (a -> Builder) -> [a] -> Builder
encodeListOf :: (a -> Builder) -> [a] -> Builder
encodeListOf a -> Builder
f =
\[a]
xs -> PutM () -> Builder
forall a. PutM a -> Builder
execPut (Putter Word64
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`M.mappend`
(a -> Builder) -> [a] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> Builder
f [a]
xs
{-# INLINE encodeListOf #-}
putTwoOf :: Putter a -> Putter b -> Putter (a,b)
putTwoOf :: Putter a -> Putter b -> Putter (a, b)
putTwoOf Putter a
pa Putter b
pb (a
a,b
b) = Putter a
pa a
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter b
pb b
b
{-# INLINE putTwoOf #-}
putListOf :: Putter a -> Putter [a]
putListOf :: Putter a -> Putter [a]
putListOf Putter a
pa = \[a]
l -> do
Putter Word64
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l))
Putter a -> Putter [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter a
pa [a]
l
{-# INLINE putListOf #-}
putIArrayOf :: (Ix i, IArray a e) => Putter i -> Putter e -> Putter (a i e)
putIArrayOf :: Putter i -> Putter e -> Putter (a i e)
putIArrayOf Putter i
pix Putter e
pe a i e
a = do
Putter i -> Putter i -> Putter (i, i)
forall a b. Putter a -> Putter b -> Putter (a, b)
putTwoOf Putter i
pix Putter i
pix (a i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a i e
a)
Putter e -> Putter [e]
forall a. Putter a -> Putter [a]
putListOf Putter e
pe (a i e -> [e]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems a i e
a)
{-# INLINE putIArrayOf #-}
putSeqOf :: Putter a -> Putter (Seq.Seq a)
putSeqOf :: Putter a -> Putter (Seq a)
putSeqOf Putter a
pa = \Seq a
s -> do
Putter Word64
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
s)
Putter a -> Putter (Seq a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ Putter a
pa Seq a
s
{-# INLINE putSeqOf #-}
putTreeOf :: Putter a -> Putter (T.Tree a)
putTreeOf :: Putter a -> Putter (Tree a)
putTreeOf Putter a
pa =
Putter Builder
tell Putter Builder -> (Tree a -> Builder) -> Putter (Tree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Builder
go
where
go :: Tree a -> Builder
go (T.Node a
x Forest a
cs) = PutM () -> Builder
forall a. PutM a -> Builder
execPut (Putter a
pa a
x) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`M.mappend` (Tree a -> Builder) -> Forest a -> Builder
forall a. (a -> Builder) -> [a] -> Builder
encodeListOf Tree a -> Builder
go Forest a
cs
{-# INLINE putTreeOf #-}
putMapOf :: Putter k -> Putter a -> Putter (Map.Map k a)
putMapOf :: Putter k -> Putter a -> Putter (Map k a)
putMapOf Putter k
pk Putter a
pa = Putter (k, a) -> Putter [(k, a)]
forall a. Putter a -> Putter [a]
putListOf (Putter k -> Putter a -> Putter (k, a)
forall a b. Putter a -> Putter b -> Putter (a, b)
putTwoOf Putter k
pk Putter a
pa) Putter [(k, a)] -> (Map k a -> [(k, a)]) -> Putter (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
{-# INLINE putMapOf #-}
putIntMapOf :: Putter Int -> Putter a -> Putter (IntMap.IntMap a)
putIntMapOf :: Putter Int -> Putter a -> Putter (IntMap a)
putIntMapOf Putter Int
pix Putter a
pa = Putter (Int, a) -> Putter [(Int, a)]
forall a. Putter a -> Putter [a]
putListOf (Putter Int -> Putter a -> Putter (Int, a)
forall a b. Putter a -> Putter b -> Putter (a, b)
putTwoOf Putter Int
pix Putter a
pa) Putter [(Int, a)] -> (IntMap a -> [(Int, a)]) -> Putter (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList
{-# INLINE putIntMapOf #-}
putSetOf :: Putter a -> Putter (Set.Set a)
putSetOf :: Putter a -> Putter (Set a)
putSetOf Putter a
pa = Putter a -> Putter [a]
forall a. Putter a -> Putter [a]
putListOf Putter a
pa Putter [a] -> (Set a -> [a]) -> Putter (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList
{-# INLINE putSetOf #-}
putIntSetOf :: Putter Int -> Putter IntSet.IntSet
putIntSetOf :: Putter Int -> Putter IntSet
putIntSetOf Putter Int
pix = Putter Int -> Putter [Int]
forall a. Putter a -> Putter [a]
putListOf Putter Int
pix Putter [Int] -> (IntSet -> [Int]) -> Putter IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toAscList
{-# INLINE putIntSetOf #-}
putMaybeOf :: Putter a -> Putter (Maybe a)
putMaybeOf :: Putter a -> Putter (Maybe a)
putMaybeOf Putter a
_ Maybe a
Nothing = Putter Word8
putWord8 Word8
0
putMaybeOf Putter a
pa (Just a
a) = Putter Word8
putWord8 Word8
1 PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
pa a
a
{-# INLINE putMaybeOf #-}
putEitherOf :: Putter a -> Putter b -> Putter (Either a b)
putEitherOf :: Putter a -> Putter b -> Putter (Either a b)
putEitherOf Putter a
pa Putter b
_ (Left a
a) = Putter Word8
putWord8 Word8
0 PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter a
pa a
a
putEitherOf Putter a
_ Putter b
pb (Right b
b) = Putter Word8
putWord8 Word8
1 PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter b
pb b
b
{-# INLINE putEitherOf #-}
putNested :: Putter Int -> Put -> Put
putNested :: Putter Int -> PutM () -> PutM ()
putNested Putter Int
putLen PutM ()
putVal = do
let bs :: ByteString
bs = PutM () -> ByteString
runPut PutM ()
putVal
Putter Int
putLen (ByteString -> Int
S.length ByteString
bs)
Putter ByteString
putByteString ByteString
bs
{-# INLINE lazyToStrictByteString #-}
lazyToStrictByteString :: L.ByteString -> S.ByteString
#if MIN_VERSION_bytestring(0,10,0)
lazyToStrictByteString :: ByteString -> ByteString
lazyToStrictByteString = ByteString -> ByteString
L.toStrict
#else
lazyToStrictByteString = packChunks
packChunks :: L.ByteString -> S.ByteString
packChunks lbs = S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
where
copyChunks !L.Empty !_pf = return ()
copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
withForeignPtr fpbuf $ \pbuf ->
copyBytes pf (pbuf `plusPtr` o) l
copyChunks lbs' (pf `plusPtr` l)
#endif