module Blaze.ByteString.Builder.Write
(
Write (..)
, fromWrite
, fromWriteSingleton
, fromWrite1List
, fromWrite2List
, fromWrite4List
, fromWrite8List
, fromWrite16List
) where
import Blaze.ByteString.Builder.Internal
import Foreign
import Data.Monoid
data Write = Write
!Int
(Ptr Word8 -> IO ())
instance Monoid Write where
mempty = Write 0 (const $ return ())
mappend (Write l1 f1) (Write l2 f2) = Write (l1 + l2) $ \ptr -> do
f1 ptr
f2 (ptr `plusPtr` l1)
fromWrite :: Write -> Builder
fromWrite (Write size io) =
Builder step
where
step k pf pe
| pf `plusPtr` size <= pe = do
io pf
let pf' = pf `plusPtr` size
pf' `seq` k pf' pe
| otherwise = return $ BufferFull size pf (step k)
fromWriteSingleton :: (a -> Write) -> a -> Builder
fromWriteSingleton write = makeBuilder
where
makeBuilder x = Builder step
where
step k pf pe
| pf `plusPtr` size <= pe = do
io pf
let pf' = pf `plusPtr` size
pf' `seq` k pf' pe
| otherwise = return $ BufferFull size pf (step k)
where
Write size io = write x
fromWrite1List :: (a -> Write) -> [a] -> Builder
fromWrite1List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go [] !pf = k pf pe0
go xs@(x':xs') !pf
| pf `plusPtr` size <= pe0 = do
io pf
go xs' (pf `plusPtr` size)
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'
fromWrite2List :: (a -> Write) -> [a] -> Builder
fromWrite2List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go [] !pf = k pf pe0
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
fromWrite4List :: (a -> Write) -> [a] -> Builder
fromWrite4List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0
fromWrite8List :: (a -> Write) -> [a] -> Builder
fromWrite8List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0
fromWrite16List :: (a -> Write) -> [a] -> Builder
fromWrite16List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:x'9:x'10:x'11:x'12:x'13:x'14:x'15:x'16:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
`mappend` write x'9
`mappend` write x'10
`mappend` write x'11
`mappend` write x'12
`mappend` write x'13
`mappend` write x'14
`mappend` write x'15
`mappend` write x'16
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0