{-# LANGUAGE CPP #-}{-# LANGUAGE Unsafe #-}{-# OPTIONS_HADDOCK not-home #-}-- |-- Copyright : 2010-2011 Simon Meier, 2010 Jasper van der Jeugt-- License : BSD3-style (see LICENSE)---- Maintainer : Simon Meier <iridcode@gmail.com>-- Stability : unstable, private-- Portability : GHC---- *Warning:* this module is internal. If you find that you need it please-- contact the maintainers and explain what you are trying to do and discuss-- what you would need in the public API. It is important that you do this as-- the module may not be exposed at all in future releases.---- The maintainers are glad to accept patches for further-- standard encodings of standard Haskell values.---- If you need to write your own builder primitives, then be aware that you are-- writing code with /all safety belts off/; i.e.,-- *this is the code that might make your application vulnerable to buffer-overflow attacks!*-- The "Data.ByteString.Builder.Prim.Tests" module provides you with-- utilities for testing your encodings thoroughly.--moduleData.ByteString.Builder.Prim.Internal(-- * Fixed-size builder primitivesSize ,FixedPrim ,fixedPrim ,size ,runF ,emptyF ,contramapF ,pairF -- , liftIOF,storableToF -- * Bounded-size builder primitives,BoundedPrim ,boundedPrim ,sizeBound ,runB ,emptyB ,contramapB ,pairB ,eitherB ,condB -- , liftIOB,toB ,liftFixedToBounded -- , withSizeFB-- , withSizeBB-- * Shared operators,(>$<) ,(>*<) -- * Helpers,caseWordSize_32_64 -- * Deprecated,boudedPrim )whereimportForeignimportPreludehiding(maxBound)
#include "MachDeps.h"
#include "bytestring-cpp-macros.h"
-------------------------------------------------------------------------------- Supporting infrastructure-------------------------------------------------------------------------------- | Contravariant functors as in the @contravariant@ package.classContravariant f wherecontramap ::(b ->a )->f a ->f b infixl4>$< -- | A fmap-like operator for builder primitives, both bounded and fixed size.---- Builder primitives are contravariant so it's like the normal fmap, but-- backwards (look at the type). (If it helps to remember, the operator symbol-- is like (<$>) but backwards.)---- We can use it for example to prepend and/or append fixed values to an-- primitive.---- > import Data.ByteString.Builder.Prim as P-- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'"-- > where-- > fixed3 = P.char7 >*< P.char7 >*< P.char7---- Note that the rather verbose syntax for composition stems from the-- requirement to be able to compute the size / size bound at compile time.--(>$<) ::Contravariant f =>(b ->a )->f a ->f b >$< :: forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
(>$<) =(b -> a) -> f a -> f b
forall b a. (b -> a) -> f a -> f b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
contramap instanceContravariant FixedPrim wherecontramap :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramap =(b -> a) -> FixedPrim a -> FixedPrim b
forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramapF instanceContravariant BoundedPrim wherecontramap :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramap =(b -> a) -> BoundedPrim a -> BoundedPrim b
forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB -- | Type-constructors supporting lifting of type-products.classMonoidal f wherepair ::f a ->f b ->f (a ,b )instanceMonoidal FixedPrim wherepair :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pair =FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pairF instanceMonoidal BoundedPrim wherepair :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pair =BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pairB infixr5>*< -- | A pairing/concatenation operator for builder primitives, both bounded and-- fixed size.---- For example,---- > toLazyByteString (primFixed (char7 >*< char7) ('x','y')) = "xy"---- We can combine multiple primitives using '>*<' multiple times.---- > toLazyByteString (primFixed (char7 >*< char7 >*< char7) ('x',('y','z'))) = "xyz"--(>*<) ::Monoidal f =>f a ->f b ->f (a ,b )>*< :: forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
(>*<) =f a -> f b -> f (a, b)
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
pair -- | The type used for sizes and sizeBounds of sizes.typeSize =Int-------------------------------------------------------------------------------- Fixed-size builder primitives-------------------------------------------------------------------------------- | A builder primitive that always results in a sequence of bytes of a-- pre-determined, fixed size.dataFixedPrim a =FP {-# UNPACK#-}!Int(a ->PtrWord8->IO())fixedPrim ::Int->(a ->PtrWord8->IO())->FixedPrim a fixedPrim :: forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim =Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP -- | The size of the sequences of bytes generated by this 'FixedPrim'.{-# INLINE CONLIKEsize #-}size ::FixedPrim a ->Intsize :: forall a. FixedPrim a -> Int
size (FP Int
l a -> Ptr Word8 -> IO ()
_)=Int
l {-# INLINE CONLIKErunF #-}runF ::FixedPrim a ->a ->PtrWord8->IO()runF :: forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF (FP Int
_a -> Ptr Word8 -> IO ()
io )=a -> Ptr Word8 -> IO ()
io -- | The 'FixedPrim' that always results in the zero-length sequence.{-# INLINE CONLIKEemptyF #-}emptyF ::FixedPrim a emptyF :: forall a. FixedPrim a
emptyF =Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP Int
0(\a
_Ptr Word8
_->() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return())-- | Encode a pair by encoding its first component and then its second component.{-# INLINE CONLIKEpairF #-}pairF ::FixedPrim a ->FixedPrim b ->FixedPrim (a ,b )pairF :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pairF (FP Int
l1 a -> Ptr Word8 -> IO ()
io1 )(FP Int
l2 b -> Ptr Word8 -> IO ()
io2 )=Int -> ((a, b) -> Ptr Word8 -> IO ()) -> FixedPrim (a, b)
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l2 )(\(a
x1 ,b
x2 )Ptr Word8
op ->a -> Ptr Word8 -> IO ()
io1 a
x1 Ptr Word8
op IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>b -> Ptr Word8 -> IO ()
io2 b
x2 (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`Int
l1 ))-- | Change a primitives such that it first applies a function to the value-- to be encoded.---- Note that primitives are 'Contravariant'-- <http://hackage.haskell.org/package/contravariant>. Hence, the following-- laws hold.---- >contramapF id = id-- >contramapF f . contramapF g = contramapF (g . f){-# INLINE CONLIKEcontramapF #-}contramapF ::(b ->a )->FixedPrim a ->FixedPrim b contramapF :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramapF b -> a
f (FP Int
l a -> Ptr Word8 -> IO ()
io )=Int -> (b -> Ptr Word8 -> IO ()) -> FixedPrim b
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP Int
l (a -> Ptr Word8 -> IO ()
io (a -> Ptr Word8 -> IO ()) -> (b -> a) -> b -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> a
f )-- | Convert a 'FixedPrim' to a 'BoundedPrim'.{-# INLINE CONLIKEtoB #-}toB ::FixedPrim a ->BoundedPrim a toB :: forall a. FixedPrim a -> BoundedPrim a
toB (FP Int
l a -> Ptr Word8 -> IO ()
io )=Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
l (\a
x Ptr Word8
op ->a -> Ptr Word8 -> IO ()
io a
x Ptr Word8
op IO () -> IO (Ptr Word8) -> IO (Ptr Word8)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>(Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$!Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr`Int
l ))-- | Lift a 'FixedPrim' to a 'BoundedPrim'.{-# INLINE CONLIKEliftFixedToBounded #-}liftFixedToBounded ::FixedPrim a ->BoundedPrim a liftFixedToBounded :: forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded =FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB {-# INLINE CONLIKEstorableToF #-}{-# DEPRECATEDstorableToF"Deprecated since @bytestring-0.12.1.0@.\n\nThis function is dangerous in the presence of internal padding\nand makes naive assumptions about alignment.\n\n * For a primitive Haskell type like 'Int64', use the\n corresponding primitive like 'Data.ByteString.Builder.Prim.int64Host'.\n * For other types, it is recommended to manually write a small\n function that performs the necessary unaligned write\n and zeroes or removes any internal padding bits."#-}storableToF ::foralla .Storablea =>FixedPrim a 
#if HS_UNALIGNED_POKES_OK
storableToF :: forall a. Storable a => FixedPrim a
storableToF =Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP (a -> Int
forall a. Storable a => a -> Int
sizeOf(a
forall a. HasCallStack => a
undefined::a ))(\a
x Ptr Word8
op ->Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke(Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtrPtr Word8
op )a
x )
#else
storableToF=FP(sizeOf(undefined::a))$\xop->ifptrToWordPtrop`mod`fromIntegral(alignment(undefined::a))==0thenpoke(castPtrop)xelsewithx$\tp->copyBytesop(castPtrtp)(sizeOf(undefined::a))
#endif
{-
{-# INLINE CONLIKE liftIOF #-}
liftIOF :: FixedPrim a -> FixedPrim (IO a)
liftIOF (FP l io) = FP l (\xWrapped op -> do x <- xWrapped; io x op)
-}-------------------------------------------------------------------------------- Bounded-size builder primitives-------------------------------------------------------------------------------- | A builder primitive that always results in sequence of bytes that is no longer-- than a pre-determined bound.dataBoundedPrim a =BP {-# UNPACK#-}!Int(a ->PtrWord8->IO(PtrWord8))-- | The bound on the size of sequences of bytes generated by this 'BoundedPrim'.{-# INLINE CONLIKEsizeBound #-}sizeBound ::BoundedPrim a ->IntsizeBound :: forall a. BoundedPrim a -> Int
sizeBound (BP Int
b a -> Ptr Word8 -> IO (Ptr Word8)
_)=Int
b -- | @since 0.10.12.0boundedPrim ::Int->(a ->PtrWord8->IO(PtrWord8))->BoundedPrim a boundedPrim :: forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim =Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP {-# DEPRECATEDboudedPrim"Use 'boundedPrim' instead"#-}boudedPrim ::Int->(a ->PtrWord8->IO(PtrWord8))->BoundedPrim a boudedPrim :: forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boudedPrim =Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP {-# INLINE CONLIKErunB #-}runB ::BoundedPrim a ->a ->PtrWord8->IO(PtrWord8)runB :: forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB (BP Int
_a -> Ptr Word8 -> IO (Ptr Word8)
io )=a -> Ptr Word8 -> IO (Ptr Word8)
io -- | Change a 'BoundedPrim' such that it first applies a function to the-- value to be encoded.---- Note that 'BoundedPrim's are 'Contravariant'-- <http://hackage.haskell.org/package/contravariant>. Hence, the following-- laws hold.---- >contramapB id = id-- >contramapB f . contramapB g = contramapB (g . f){-# INLINE CONLIKEcontramapB #-}contramapB ::(b ->a )->BoundedPrim a ->BoundedPrim b contramapB :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB b -> a
f (BP Int
b a -> Ptr Word8 -> IO (Ptr Word8)
io )=Int -> (b -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim b
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
b (a -> Ptr Word8 -> IO (Ptr Word8)
io (a -> Ptr Word8 -> IO (Ptr Word8))
-> (b -> a) -> b -> Ptr Word8 -> IO (Ptr Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> a
f )-- | The 'BoundedPrim' that always results in the zero-length sequence.{-# INLINE CONLIKEemptyB #-}emptyB ::BoundedPrim a emptyB :: forall a. BoundedPrim a
emptyB =Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
0(\a
_Ptr Word8
op ->Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnPtr Word8
op )-- | Encode a pair by encoding its first component and then its second component.{-# INLINE CONLIKEpairB #-}pairB ::BoundedPrim a ->BoundedPrim b ->BoundedPrim (a ,b )pairB :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pairB (BP Int
b1 a -> Ptr Word8 -> IO (Ptr Word8)
io1 )(BP Int
b2 b -> Ptr Word8 -> IO (Ptr Word8)
io2 )=Int
-> ((a, b) -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim (a, b)
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP (Int
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2 )(\(a
x1 ,b
x2 )Ptr Word8
op ->a -> Ptr Word8 -> IO (Ptr Word8)
io1 a
x1 Ptr Word8
op IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=b -> Ptr Word8 -> IO (Ptr Word8)
io2 b
x2 )-- | Encode an 'Either' value using the first 'BoundedPrim' for 'Left'-- values and the second 'BoundedPrim' for 'Right' values.---- Note that the functions 'eitherB', 'pairB', and 'contramapB' (written below-- using '>$<') suffice to construct 'BoundedPrim's for all non-recursive-- algebraic datatypes. For example,---- @--maybeB :: BoundedPrim () -> BoundedPrim a -> BoundedPrim (Maybe a)--maybeB nothing just = 'maybe' (Left ()) Right '>$<' eitherB nothing just-- @{-# INLINE CONLIKEeitherB #-}eitherB ::BoundedPrim a ->BoundedPrim b ->BoundedPrim (Eithera b )eitherB :: forall a b.
BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
eitherB (BP Int
b1 a -> Ptr Word8 -> IO (Ptr Word8)
io1 )(BP Int
b2 b -> Ptr Word8 -> IO (Ptr Word8)
io2 )=Int
-> (Either a b -> Ptr Word8 -> IO (Ptr Word8))
-> BoundedPrim (Either a b)
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP (Int -> Int -> Int
forall a. Ord a => a -> a -> a
maxInt
b1 Int
b2 )(\Either a b
x Ptr Word8
op ->caseEither a b
x ofLefta
x1 ->a -> Ptr Word8 -> IO (Ptr Word8)
io1 a
x1 Ptr Word8
op ;Rightb
x2 ->b -> Ptr Word8 -> IO (Ptr Word8)
io2 b
x2 Ptr Word8
op )-- | Conditionally select a 'BoundedPrim'.-- For example, we can implement the ASCII primitive that drops characters with-- Unicode codepoints above 127 as follows.---- @--charASCIIDrop = 'condB' (< \'\128円\') ('liftFixedToBounded' 'Data.ByteString.Builder.Prim.char7') 'emptyB'-- @{-# INLINE CONLIKEcondB #-}condB ::(a ->Bool)->BoundedPrim a ->BoundedPrim a ->BoundedPrim a condB :: forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB a -> Bool
p BoundedPrim a
be1 BoundedPrim a
be2 =(a -> Either a a) -> BoundedPrim (Either a a) -> BoundedPrim a
forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB (\a
x ->ifa -> Bool
p a
x thena -> Either a a
forall a b. a -> Either a b
Lefta
x elsea -> Either a a
forall a b. b -> Either a b
Righta
x )(BoundedPrim a -> BoundedPrim a -> BoundedPrim (Either a a)
forall a b.
BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
eitherB BoundedPrim a
be1 BoundedPrim a
be2 )-- | Select an implementation depending on bitness.-- Throw a compile time error if bitness is neither 32 nor 64.{-# INLINEcaseWordSize_32_64 #-}caseWordSize_32_64 ::a -- Value for 32-bit architecture->a -- Value for 64-bit architecture->a 
#if WORD_SIZE_IN_BITS == 32
caseWordSize_32_64=const
#endif
#if WORD_SIZE_IN_BITS == 64
caseWordSize_32_64 :: forall a. a -> a -> a
caseWordSize_32_64 =(a -> a) -> a -> a -> a
forall a b. a -> b -> a
consta -> a
forall a. a -> a
id
#endif