packages feed

mason 0.2.1 → 0.2.2

raw patch · 4 files changed

+112/−15 lines, 4 files

Files

CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for mason +## 0.2.2++* Added `withPopper` and `toStreamingBody`+* Added `viaShow`+* Added `intersperse`, `unwords` and `unlines`+* Optmised the internal representation++## 0.2.1+ * Added `Mason.Builder.Compat`  ## 0.2
mason.cabal view
@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                mason-version:             0.2.1+version:             0.2.2 synopsis:            Fast and extensible bytestring builder description:   This package provides efficient implementation of bytestring builders.
src/Mason/Builder.hs view
@@ -21,6 +21,8 @@   , hPutBuilderLen   , hPutBuilder   , sendBuilder+  , withPopper+  , toStreamingBody   -- * Primitives   , flush   -- * Bytes@@ -98,12 +100,18 @@   , wordVLQBP   , prefixVarInt   , prefixVarIntBP+  -- * Combinators+  , intersperse+  , Mason.Builder.unwords+  , Mason.Builder.unlines+  , viaShow   -- * Advanced   , paddedBoundedPrim   , zeroPaddedBoundedPrim   , primFixed   , primBounded   , lengthPrefixedWithin+   ) where  import Control.Monad@@ -718,3 +726,21 @@               go (ptr `plusPtr` 1) (n `shiftR` 8)       go ptr0 $! (2 * x + 1) `shiftL` (bytes - 1) {-# INLINE CONLIKE prefixVarIntBP #-}++intersperse :: Buildable e => BuilderFor e -> [BuilderFor e] -> BuilderFor e+intersperse d (x0 : xs) = x0 <> foldr (\x r -> d <> x <> r) mempty xs+intersperse _ [] = mempty+{-# INLINE intersperse #-}++unwords :: Buildable e => [BuilderFor e] -> BuilderFor e+unwords = intersperse (word8 32)+{-# INLINE unwords #-}++unlines :: Buildable e => [BuilderFor e] -> BuilderFor e+unlines = foldMap (<>word8 10)+{-# INLINE unlines #-}++-- | Turn a value into a 'Builder' using the 'Show' instance.+viaShow :: Show a => a -> Builder+viaShow = string8 . show+{-# INLINE viaShow #-}
src/Mason/Builder/Internal.hs view
@@ -4,16 +4,24 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} module Mason.Builder.Internal (Builder   , BuilderFor(..)+  , BState   , Buildable(..)   , GrowingBuffer(..)   , Buffer(..)+  , pattern Builder+  , unBuilder   , byteStringCopy   , shortByteString   , toStrictByteString   , Channel(..)   , toLazyByteString+  , withPopper+  , StreamingEnv(..)+  , toStreamingBody   , stringUtf8   , lengthPrefixedWithin   , primBounded@@ -49,6 +57,7 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Internal as BL import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as B import Data.Text.Internal.Unsafe.Shift (shiftR)@@ -68,18 +77,32 @@ import qualified Data.Text.Internal as T import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Network.Socket as S-import GHC.Prim (eqWord#, plusAddr#, indexWord8OffAddr#)+import GHC.Prim (eqWord#, plusAddr#, indexWord8OffAddr#, RealWorld, Addr#, State# ) import GHC.Ptr (Ptr(..)) import GHC.Word (Word8(..)) import GHC.Types (isTrue#)-import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build)+import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build, IO(..), unIO)  -- | The Builder type. Requires RankNTypes extension type Builder = forall s. Buildable s => BuilderFor s  -- | Builder specialised for a backend-newtype BuilderFor s = Builder { unBuilder :: s -> Buffer -> IO Buffer }+newtype BuilderFor s = RawBuilder { unRawBuilder :: s -> BState -> BState } +unBuilder :: BuilderFor s -> s -> Buffer -> IO Buffer+unBuilder (RawBuilder f) = \env (Buffer (Ptr ptr) (Ptr end)) -> IO (\s -> case f env (# ptr, end, s #) of+   (# ptr', end', s' #) -> (# s', Buffer (Ptr ptr') (Ptr end') #))+{-# INLINE unBuilder #-}++pattern Builder :: (s -> Buffer -> IO Buffer) -> BuilderFor s+pattern Builder f <- (unBuilder -> f) where+  Builder f = RawBuilder $ \env (# ptr, end, s #) -> case unIO (f env (Buffer (Ptr ptr) (Ptr end))) s of+    (# s', Buffer (Ptr ptr') (Ptr end') #) -> (# ptr', end', s' #)++{-# COMPLETE Builder #-}++type BState = (#Addr#, Addr#, State# RealWorld #)+ -- | This class is used to provide backend-specific operations for running a 'Builder'. class Buildable s where   -- | Put a 'B.ByteString'.@@ -160,11 +183,11 @@   {-# INLINE allocate #-}  instance Semigroup (BuilderFor s) where-  Builder f <> Builder g = Builder $ \e -> f e >=> g e+  RawBuilder f <> RawBuilder g = RawBuilder $ \e s -> g e (f e s)   {-# INLINE[1] (<>) #-}  instance Monoid (BuilderFor a) where-  mempty = Builder $ const pure+  mempty = RawBuilder (\_ s -> s)   {-# INLINE mempty #-}  -- | UTF-8 encode a 'String'.@@ -320,10 +343,21 @@  -- | Create a lazy 'BL.ByteString'. Threaded runtime is required. toLazyByteString :: BuilderFor Channel -> BL.ByteString-toLazyByteString body = unsafePerformIO $ do+toLazyByteString body = unsafePerformIO $ withPopper body $ \pop -> do+  let go _ = unsafePerformIO $ do+        bs <- pop+        return $! if B.null bs+          then BL.empty+          else BL.Chunk bs (go ())+  return $ go ()+{-# INLINE toLazyByteString #-}++-- | Use 'Builder' as a <http://hackage.haskell.org/package/http-client-0.7.1/docs/Network-HTTP-Client.html#t:GivesPopper GivesPopper'+withPopper :: BuilderFor Channel -> (IO B.ByteString -> IO a) -> IO a+withPopper body cont = do   resp <- newEmptyMVar -  let initialSize = 4096+  let initialSize = 4080   fptr <- mallocForeignPtrBytes initialSize   ref <- newIORef fptr   let ptr = unsafeForeignPtrToPtr fptr@@ -333,13 +367,8 @@   _ <- flip forkFinally final $ unBuilder (body <> flush) (Channel resp ref)     $ Buffer (ptr `plusPtr` initialSize) ptr -  let go _ = unsafePerformIO $ do-        bs <- takeMVar resp-        return $! if B.null bs-          then BL.empty-          else BL.Chunk bs (go ())-  return $ go ()-{-# INLINE toLazyByteString #-}+  cont $ takeMVar resp+{-# INLINE withPopper #-}  -- | Environment for handle output data PutEnv = PutEnv@@ -512,3 +541,36 @@  foreign import ccall unsafe "static grisu3"   c_grisu3 :: CDouble -> Ptr Word8 -> Ptr CInt -> Ptr CInt -> IO CInt++data StreamingEnv = StreamingEnv+  { sePush :: !(B.ByteString -> IO ())+  , seBuffer :: !(IORef (ForeignPtr Word8))+  }++instance Buildable StreamingEnv where+  byteString bs+    | B.length bs < 4096 = byteStringCopy bs+    | otherwise = flush <> Builder (\env b -> b <$ sePush env bs)+  {-# INLINE byteString #-}+  flush = Builder $ \(StreamingEnv push ref) (Buffer end ptr) -> do+    ptr0 <- unsafeForeignPtrToPtr <$> readIORef ref+    let len = minusPtr ptr ptr0+    when (len > 0) $ push $! B.unsafeCreate len $ \dst -> B.memcpy dst ptr0 len+    return $! Buffer end ptr0+  {-# INLINE flush #-}+  allocate = allocateConstant seBuffer+  {-# INLINE allocate #-}++-- | Convert a 'Builder' into a <http://hackage.haskell.org/package/wai-3.2.2.1/docs/Network-Wai.html#t:StreamingBody StreamingBody>.+toStreamingBody :: BuilderFor StreamingEnv -> (BB.Builder -> IO ()) -> IO () -> IO ()+toStreamingBody body = \write _ -> do+  let initialSize = 4080+  fptr <- mallocForeignPtrBytes initialSize+  ref <- newIORef fptr+  let ptr = unsafeForeignPtrToPtr fptr+  Buffer _ ptr2 <- unBuilder body+    (StreamingEnv (write . BB.byteString) ref)+    (Buffer (ptr `plusPtr` initialSize) ptr)+  fptr' <- readIORef ref+  let ptr1 = unsafeForeignPtrToPtr fptr'+  write $ BB.byteString $ B.PS fptr' 0 (minusPtr ptr2 ptr1)