{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-}#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Unsafe #-}#endif
{-# 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 saftey 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 ,boudedPrim ,sizeBound ,runB ,emptyB ,contramapB ,pairB ,eitherB ,condB -- , liftIOB,toB ,liftFixedToBounded -- , withSizeFB-- , withSizeBB-- * Shared operators,(>$< ),(>*< ))whereimportForeignimportPreludehiding(maxBound)#if !(__GLASGOW_HASKELL__ >= 612)
-- ghc-6.10 and older do not support {-# INLINE CONLIKE #-}#define CONLIKE
#endif
-------------------------------------------------------------------------------- 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.---- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'"-- > where-- > fixed3 = char7 >*< char7 >*< 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 (>$< )=contramap instanceContravariant FixedPrim wherecontramap =contramapF instanceContravariant BoundedPrim wherecontramap =contramapB -- | Type-constructors supporting lifting of type-products.classMonoidal f wherepair ::f a ->f b ->f (a ,b )instanceMonoidal FixedPrim wherepair =pairF instanceMonoidal BoundedPrim wherepair =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 )(>*< )=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 =FP -- | The size of the sequences of bytes generated by this 'FixedPrim'.{-# INLINE CONLIKEsize#-}size::FixedPrim a ->Intsize (FP l _)=l {-# INLINE CONLIKErunF#-}runF::FixedPrim a ->a ->PtrWord8->IO()runF (FP _io )=io -- | The 'FixedPrim' that always results in the zero-length sequence.{-# INLINE CONLIKEemptyF#-}emptyF::FixedPrim a emptyF =FP 0(\__->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 (FP l1 io1 )(FP l2 io2 )=FP (l1 +l2 )(\(x1 ,x2 )op ->io1 x1 op >>io2 x2 (op `plusPtr`l1 ))-- | Change a primitives such that it first applies a function to the value-- to be encoded.---- Note that primitives are 'Contrafunctors'-- <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 f (FP l io )=FP l (\x op ->io (f x )op )-- | Convert a 'FixedPrim' to a 'BoundedPrim'.{-# INLINE CONLIKEtoB#-}toB::FixedPrim a ->BoundedPrim a toB (FP l io )=BP l (\x op ->io x op >>(return$!op `plusPtr`l ))-- | Lift a 'FixedPrim' to a 'BoundedPrim'.{-# INLINE CONLIKEliftFixedToBounded#-}liftFixedToBounded::FixedPrim a ->BoundedPrim a liftFixedToBounded =toB {-# INLINE CONLIKEstorableToF#-}storableToF::foralla .Storablea =>FixedPrim a storableToF =FP (sizeOf(undefined::a ))(\x op ->poke(castPtrop )x ){-
{-# 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 (BP b _)=b boudedPrim::Int->(a ->PtrWord8->IO(PtrWord8))->BoundedPrim a boudedPrim =BP {-# INLINE CONLIKErunB#-}runB::BoundedPrim a ->a ->PtrWord8->IO(PtrWord8)runB (BP _io )=io -- | Change a 'BoundedPrim' such that it first applies a function to the-- value to be encoded.---- Note that 'BoundedPrim's are 'Contrafunctors'-- <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 f (BP b io )=BP b (\x op ->io (f x )op )-- | The 'BoundedPrim' that always results in the zero-length sequence.{-# INLINE CONLIKEemptyB#-}emptyB::BoundedPrim a emptyB =BP 0(\_op ->returnop )-- | Encode a pair by encoding its first component and then its second component.{-# INLINE CONLIKEpairB#-}pairB::BoundedPrim a ->BoundedPrim b ->BoundedPrim (a ,b )pairB (BP b1 io1 )(BP b2 io2 )=BP (b1 +b2 )(\(x1 ,x2 )op ->io1 x1 op >>=io2 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 (BP b1 io1 )(BP b2 io2 )=BP (maxb1 b2 )(\x op ->casex ofLeftx1 ->io1 x1 op ;Rightx2 ->io2 x2 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円\') ('fromF' 'char7') 'emptyB'-- @{-# INLINE CONLIKEcondB#-}condB::(a ->Bool)->BoundedPrim a ->BoundedPrim a ->BoundedPrim a condB p be1 be2 =contramapB (\x ->ifp x thenLeftx elseRightx )(eitherB be1 be2 )