1{-# LANGUAGE CPP #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Data.Binary.Put 5-- Copyright : Lennart Kolmodin 6-- License : BSD3-style (see LICENSE) 7-- 8-- Maintainer : Lennart Kolmodin <kolmodin@dtek.chalmers.se> 9-- Stability : stable 10-- Portability : Portable to Hugs and GHC. Requires MPTCs 11-- 12-- The Put monad. A monad for efficiently constructing lazy bytestrings using 13-- the Builder developed for blaze-html. 14-- 15----------------------------------------------------------------------------- 16 17module Throughput.BlazePutMonad ( 18 19 -- * The Put type 20 Put 21 , PutM(..) 22 , runPut 23 , runPutM 24 , putBuilder 25 , execPut 26 27 -- * Flushing the implicit parse state 28 , flush 29 30 -- * Primitives 31 , putWrite 32 , putWord8 33 , putByteString 34 , putLazyByteString 35 36 -- * Big-endian primitives 37 , putWord16be 38 , putWord32be 39 , putWord64be 40 41 -- * Little-endian primitives 42 , putWord16le 43 , putWord32le 44 , putWord64le 45 46 -- * Host-endian, unaligned writes 47 , putWordhost -- :: Word -> Put 48 , putWord16host -- :: Word16 -> Put 49 , putWord32host -- :: Word32 -> Put 50 , putWord64host -- :: Word64 -> Put 51 52 ) where 53 54import Data.Monoid 55import Blaze.ByteString.Builder (Builder, toLazyByteString) 56import qualified Blaze.ByteString.Builder as B 57 58import Data.Word 59import qualified Data.ByteString as S 60import qualified Data.ByteString.Lazy as L 61 62import Control.Applicative 63 64 65------------------------------------------------------------------------ 66 67-- XXX Strict in buffer only. 68data PairS a = PairS a {-# UNPACK #-}!Builder 69 70sndS :: PairS a -> Builder 71sndS (PairS _ b) = b 72 73-- | The PutM type. A Writer monad over the efficient Builder monoid. 74newtype PutM a = Put { unPut :: PairS a } 75 76-- | Put merely lifts Builder into a Writer monad, applied to (). 77type Put = PutM () 78 79instance Functor PutM where 80 fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w 81 {-# INLINE fmap #-} 82 83instance Applicative PutM where 84 pure = return 85 m <*> k = Put $ 86 let PairS f w = unPut m 87 PairS x w' = unPut k 88 in PairS (f x) (w `mappend` w') 89 90-- Standard Writer monad, with aggressive inlining 91instance Monad PutM where 92 return a = Put $ PairS a mempty 93 {-# INLINE return #-} 94 95 m >>= k = Put $ 96 let PairS a w = unPut m 97 PairS b w' = unPut (k a) 98 in PairS b (w `mappend` w') 99 {-# INLINE (>>=) #-} 100 101 m >> k = Put $ 102 let PairS _ w = unPut m 103 PairS b w' = unPut k 104 in PairS b (w `mappend` w') 105 {-# INLINE (>>) #-} 106 107tell :: Builder -> Put 108tell b = Put $ PairS () b 109{-# INLINE tell #-} 110 111putBuilder :: Builder -> Put 112putBuilder = tell 113{-# INLINE putBuilder #-} 114 115-- | Run the 'Put' monad 116execPut :: PutM a -> Builder 117execPut = sndS . unPut 118{-# INLINE execPut #-} 119 120-- | Run the 'Put' monad with a serialiser 121runPut :: Put -> L.ByteString 122runPut = toLazyByteString . sndS . unPut 123{-# INLINE runPut #-} 124 125-- | Run the 'Put' monad with a serialiser and get its result 126runPutM :: PutM a -> (a, L.ByteString) 127runPutM (Put (PairS f s)) = (f, toLazyByteString s) 128{-# INLINE runPutM #-} 129 130------------------------------------------------------------------------ 131 132-- | Pop the ByteString we have constructed so far, if any, yielding a 133-- new chunk in the result ByteString. 134flush :: Put 135flush = tell B.flush 136{-# INLINE flush #-} 137 138-- | Efficiently write a byte into the output buffer 139putWord8 :: Word8 -> Put 140putWord8 = tell . B.fromWord8 141{-# INLINE putWord8 #-} 142 143-- | Execute a write on the output buffer. 144putWrite :: B.Write -> Put 145putWrite = tell . B.fromWrite 146 147-- | An efficient primitive to write a strict ByteString into the output buffer. 148-- It flushes the current buffer, and writes the argument into a new chunk. 149putByteString :: S.ByteString -> Put 150putByteString = tell . B.fromByteString 151{-# INLINE putByteString #-} 152 153-- | Write a lazy ByteString efficiently, simply appending the lazy 154-- ByteString chunks to the output buffer 155putLazyByteString :: L.ByteString -> Put 156putLazyByteString = tell . B.fromLazyByteString 157{-# INLINE putLazyByteString #-} 158 159-- | Write a Word16 in big endian format 160putWord16be :: Word16 -> Put 161putWord16be = tell . B.fromWord16be 162{-# INLINE putWord16be #-} 163 164-- | Write a Word16 in little endian format 165putWord16le :: Word16 -> Put 166putWord16le = tell . B.fromWord16le 167{-# INLINE putWord16le #-} 168 169-- | Write a Word32 in big endian format 170putWord32be :: Word32 -> Put 171putWord32be = tell . B.fromWord32be 172{-# INLINE putWord32be #-} 173 174-- | Write a Word32 in little endian format 175putWord32le :: Word32 -> Put 176putWord32le = tell . B.fromWord32le 177{-# INLINE putWord32le #-} 178 179-- | Write a Word64 in big endian format 180putWord64be :: Word64 -> Put 181putWord64be = tell . B.fromWord64be 182{-# INLINE putWord64be #-} 183 184-- | Write a Word64 in little endian format 185putWord64le :: Word64 -> Put 186putWord64le = tell . B.fromWord64le 187{-# INLINE putWord64le #-} 188 189------------------------------------------------------------------------ 190 191-- | /O(1)./ Write a single native machine word. The word is 192-- written in host order, host endian form, for the machine you're on. 193-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine, 194-- 4 bytes. Values written this way are not portable to 195-- different endian or word sized machines, without conversion. 196-- 197putWordhost :: Word -> Put 198putWordhost = tell . B.fromWordhost 199{-# INLINE putWordhost #-} 200 201-- | /O(1)./ Write a Word16 in native host order and host endianness. 202-- For portability issues see @putWordhost@. 203putWord16host :: Word16 -> Put 204putWord16host = tell . B.fromWord16host 205{-# INLINE putWord16host #-} 206 207-- | /O(1)./ Write a Word32 in native host order and host endianness. 208-- For portability issues see @putWordhost@. 209putWord32host :: Word32 -> Put 210putWord32host = tell . B.fromWord32host 211{-# INLINE putWord32host #-} 212 213-- | /O(1)./ Write a Word64 in native host order 214-- On a 32 bit machine we write two host order Word32s, in big endian form. 215-- For portability issues see @putWordhost@. 216putWord64host :: Word64 -> Put 217putWord64host = tell . B.fromWord64host 218{-# INLINE putWord64host #-} 219