packages feed

blaze-builder (empty) → 0.1

raw patch · 6 files changed

+426/−0 lines, 6 filesdep +basedep +bytestringdep +textsetup-changed

Dependencies added: base, bytestring, text

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Jasper Van der Jeugt 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jasper Van der Jeugt nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Blaze/Builder/Core.hs view
@@ -0,0 +1,219 @@+-- | The builder monoid from BlazeHtml.+--+-- Usage is fairly straightforward. Builders can be constructed from many+-- values, including 'String' and 'Text' values.+--+-- > strings :: [String]+-- > strings = replicate 10000 "Hello there!"+--+-- Concatenation should happen through the 'Monoid' interface.+--+-- > concatenation :: Builder+-- > concatenation = mconcat $ map fromString strings+--+-- There is only one way to efficiently obtain the result: to convert the+-- 'Builder' to a lazy 'L.ByteString' using 'toLazyByteString'.+--+-- > result :: L.ByteString+-- > result = toLazyByteString concatenation+--+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+module Text.Blaze.Builder.Core+    ( +      -- * Main builder type+      Builder++      -- * Custom writes to the builder+    , Write (..)+    , writeByte+    , writeByteString+    , writeSingleton+    , writeList++      -- * Creating builders+    , singleton+    , fromByteString++      -- * Extracting the result from a builder+    , toLazyByteString+    ) where++import Foreign+import Data.Monoid (Monoid, mempty, mappend, mconcat)+import qualified Data.ByteString.Char8 ()+import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L++-- | Main builder type. It simply contains a function to extract the actual+-- data.+--+newtype Builder = Builder (BuildStep -> BuildStep)++-- | A buildsignal is a signal returned from a write to the builder, it tells us+-- what should happen next.+--+data BuildSignal+  -- | Signal the completion of the write process.+  = Done {-# UNPACK #-} !(Ptr Word8)  -- ^ Pointer to the next free byte+  -- | Signal that the buffer is full and a new one needs to be allocated.+  -- It contains the minimal size required for the next buffer, a pointer to the+  -- next free byte, and a continuation.+  | BufferFull+      {-# UNPACK #-} !Int+      {-# UNPACK #-} !(Ptr Word8)+      {-# UNPACK #-} !BuildStep++-- | Type for a single build step. Every build step checks that+--+-- > free + bytes-written <= last+--+type BuildStep =  Ptr Word8       -- ^ Ptr to the next free byte in the buffer+               -> Ptr Word8       -- ^ Ptr to the first byte AFTER the buffer+               -> IO BuildSignal  -- ^ Signal the next step to be taken++instance Monoid Builder where+    mempty = Builder id+    {-# INLINE mempty #-}+    mappend (Builder f) (Builder g) = Builder $ f . g+    {-# INLINE mappend #-}+    mconcat = foldr mappend mempty+    {-# INLINE mconcat #-}++-- | Write abstraction so we can avoid some gory and bloody details. A write+-- abstration holds the exact size of the write in bytes, and a function to+-- carry out the write operation.+--+data Write = Write+    {-# UNPACK #-} !Int+    (Ptr Word8 -> IO ())++-- A monoid interface for the write actions.+instance Monoid Write where+    mempty = Write 0 (const $ return ())+    {-# INLINE mempty #-}+    mappend (Write l1 f1) (Write l2 f2) = Write (l1 + l2) $ \ptr -> do+        f1 ptr+        f2 (ptr `plusPtr` l1)+    {-# INLINE mappend #-}++-- | Write a single byte.+--+writeByte :: Word8  -- ^ Byte to write+          -> Write  -- ^ Resulting write+writeByte x = Write 1 (\pf -> poke pf x)+{-# INLINE writeByte #-}++-- | Write a strict 'S.ByteString'.+--+writeByteString :: S.ByteString  -- ^ 'S.ByteString' to write+                -> Write         -- ^ Resulting write+writeByteString bs = Write l io+  where+  (fptr, o, l) = S.toForeignPtr bs+  io pf = withForeignPtr fptr $ \p -> copyBytes pf (p `plusPtr` o) l+{-# INLINE writeByteString #-}++-- | Construct a 'Builder' from a single 'Write' abstraction.+--+writeSingleton :: (a -> Write)  -- ^ 'Write' abstraction+               -> a             -- ^ Actual value to write+               -> Builder       -- ^ Resulting 'Builder'+writeSingleton 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+{-# INLINE writeSingleton #-}++-- | Construct a builder writing a list of data from a write abstraction.+--+writeList :: (a -> Write)  -- ^ 'Write' abstraction+          -> [a]           -- ^ List of values to write+          -> Builder       -- ^ Resulting 'Builder'+writeList 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'+{-# INLINE writeList #-}++-- | Construct a 'Builder' from a single byte.+--+singleton :: Word8    -- ^ Byte to create a 'Builder' from+          -> Builder  -- ^ Resulting 'Builder'+singleton = writeSingleton writeByte++-- | /O(n)./ A Builder taking a 'S.ByteString`, copying it.+--+fromByteString :: S.ByteString  -- ^ Strict 'S.ByteString' to copy+               -> Builder       -- ^ Resulting 'Builder'+fromByteString = writeSingleton writeByteString+{-# INLINE fromByteString #-}++-- | Copied from Data.ByteString.Lazy.+--+defaultSize :: Int+defaultSize = 32 * k - overhead+    where k = 1024+          overhead = 2 * sizeOf (undefined :: Int)++-- | Run the builder with the default buffer size.+--+runBuilder :: Builder -> [S.ByteString] -> [S.ByteString]+runBuilder = runBuilderWith defaultSize+{-# INLINE runBuilder #-}++-- | Run the builder with buffers of at least the given size.+--+-- Note that the builders should guarantee that on average the desired buffer+-- size is attained almost perfectly. "Almost" because builders may decide to+-- start a new buffer and not completely fill the existing buffer, if this is+-- faster. However, they should not spill too much of the buffer, if they+-- cannot compensate for it.+--+runBuilderWith :: Int -> Builder -> [S.ByteString] -> [S.ByteString]+runBuilderWith bufSize (Builder b) k = +    S.inlinePerformIO $ go bufSize (b finalStep)+  where+    finalStep pf _ = return $ Done pf++    go !size !step = do+        buf <- S.mallocByteString size+        withForeignPtr buf $ \pf -> do+            next <- step pf (pf `plusPtr` size)+            case next of+                Done pf'+                  | pf == pf' -> return k+                  | otherwise -> return $ S.PS buf 0 (pf' `minusPtr` pf) : k +                BufferFull newSize pf' nextStep+                  | pf == pf' -> bufferFullError+                  | otherwise -> return $ S.PS buf 0 (pf' `minusPtr` pf) : +                       S.inlinePerformIO (go (max newSize bufSize) nextStep)++    bufferFullError =+        error "runBuilder: buffer cannot be full; no data was written."++-- | /O(n)./ Extract the lazy 'L.ByteString' from the builder.+--+toLazyByteString :: Builder       -- ^ 'Builder' to evaluate+                 -> L.ByteString  -- ^ Resulting UTF-8 encoded 'L.ByteString'+toLazyByteString = L.fromChunks . flip runBuilder []+{-# INLINE toLazyByteString #-}
+ Text/Blaze/Builder/Html.hs view
@@ -0,0 +1,55 @@+-- | A module that extends the builder monoid from BlazeHtml with function to+-- insert HTML, including HTML escaping and the like.+--+{-# LANGUAGE OverloadedStrings #-}+module Text.Blaze.Builder.Html+    ( +      -- * Custom writes to the builder+      writeHtmlEscapedChar++      -- * Creating builders+    , fromHtmlEscapedChar+    , fromHtmlEscapedString+    , fromHtmlEscapedText+    ) where++import Data.ByteString.Char8 ()+import Data.Monoid (mempty, mappend)++import Data.Text (Text)+import qualified Data.Text as T++import Text.Blaze.Builder.Core+import Text.Blaze.Builder.Utf8++-- | Write an unicode character to a 'Builder', doing HTML escaping.+--+writeHtmlEscapedChar :: Char   -- ^ Character to write+                     -> Write  -- ^ Resulting write+writeHtmlEscapedChar '<'  = writeByteString "&lt;"+writeHtmlEscapedChar '>'  = writeByteString "&gt;"+writeHtmlEscapedChar '&'  = writeByteString "&amp;"+writeHtmlEscapedChar '"'  = writeByteString "&quot;"+writeHtmlEscapedChar '\'' = writeByteString "&apos;"+writeHtmlEscapedChar c    = writeChar c+{-# INLINE writeHtmlEscapedChar #-}++-- | A HTML escaped 'Char'.+--+fromHtmlEscapedChar :: Char     -- ^ Character to write+                    -> Builder  -- ^ Resulting 'Builder'+fromHtmlEscapedChar = writeSingleton writeHtmlEscapedChar++-- | A HTML escaped 'String'.+--+fromHtmlEscapedString :: String   -- ^ String to create a 'Builder' from+                      -> Builder  -- ^ Resulting 'Builder'+fromHtmlEscapedString = writeList writeHtmlEscapedChar++-- | An HTML escaped piece of 'Text'.+--+fromHtmlEscapedText :: Text     -- ^ 'Text' to insert+                    -> Builder  -- ^ Resulting 'Builder'+fromHtmlEscapedText = writeSingleton (T.foldl appendChar mempty)+  where+    appendChar w c = w `mappend` writeHtmlEscapedChar c
+ Text/Blaze/Builder/Utf8.hs view
@@ -0,0 +1,91 @@+-- | A module that extends the builder monoid from BlazeHtml with a number of+-- functions to insert unicode as UTF-8.+--+module Text.Blaze.Builder.Utf8+    ( +      -- * Custom writes to the builder+      writeChar++      -- * Creating builders+    , fromChar+    , fromString+    , fromText+    ) where++import Foreign+import Data.Char (ord)+import Data.Monoid (mempty, mappend)++import Data.Text (Text)+import qualified Data.Text as T++import Text.Blaze.Builder.Core++-- | Write a Unicode character, encoding it as UTF-8.+--+writeChar :: Char   -- ^ Character to write+          -> Write  -- ^ Resulting write+writeChar = encodeCharUtf8 f1 f2 f3 f4+  where+    f1 x = Write 1 $ \ptr -> poke ptr x++    f2 x1 x2 = Write 2 $ \ptr -> do poke ptr x1+                                    poke (ptr `plusPtr` 1) x2++    f3 x1 x2 x3 = Write 3 $ \ptr -> do poke ptr x1+                                       poke (ptr `plusPtr` 1) x2+                                       poke (ptr `plusPtr` 2) x3++    f4 x1 x2 x3 x4 = Write 4 $ \ptr -> do poke ptr x1+                                          poke (ptr `plusPtr` 1) x2+                                          poke (ptr `plusPtr` 2) x3+                                          poke (ptr `plusPtr` 3) x4+{-# INLINE writeChar #-}++-- | Encode a Unicode character to another datatype, using UTF-8. This function+-- acts as an abstract way of encoding characters, as it is unaware of what+-- needs to happen with the resulting bytes: you have to specify functions to+-- deal with those.+--+encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8+               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8+               -> Char                                     -- ^ Input 'Char'+               -> a                                        -- ^ Result+encodeCharUtf8 f1 f2 f3 f4 c = case ord c of+    x | x <= 0x7F -> f1 $ fromIntegral x+      | x <= 0x07FF ->+           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0+               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80+           in f2 x1 x2+      | x <= 0xFFFF ->+           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0+               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x3 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f3 x1 x2 x3+      | otherwise ->+           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0+               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80+               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x4 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f4 x1 x2 x3 x4+{-# INLINE encodeCharUtf8 #-}++-- | An unescaped, utf8 encoded character.+--+fromChar :: Char     -- ^ 'Char' to insert+         -> Builder  -- ^ Resulting 'Builder'+fromChar = writeSingleton writeChar++-- | A list of unescaped, utf8 encoded characters.+--+fromString :: String   -- ^ 'String' to insert+           -> Builder  -- ^ Resulting 'Builder'+fromString = writeList writeChar++-- | Create an UTF-8 encoded 'Builder' from some 'Text'.+--+fromText :: Text     -- ^ 'Text' to insert+         -> Builder  -- ^ Resulting 'Builder'+fromText = writeSingleton (T.foldl (\w c -> w `mappend` writeChar c) mempty)
+ blaze-builder.cabal view
@@ -0,0 +1,29 @@+Name:                blaze-builder+Version:             0.1+Synopsis:            Builder to efficiently append text.+Description:         Builder to efficiently append text, optimized for+                     HTML generation. There is a small usage example in the+                     Text.Blaze.Builder.Core module, you should begin by+                     reading that.+Homepage:            http://jaspervdj.be/blaze+Bug-Reports:         http://github.com/jaspervdj/BlazeHtml/issues+License:             BSD3+License-file:        LICENSE+Author:              Jasper Van der Jeugt, Simon Meier+Maintainer:          jaspervdj@gmail.com, simon.meier@inf.ethz.ch+Stability:           Experimental+Category:            Text+Build-type:          Simple+Cabal-version:       >=1.2+Library+  Ghc-Options:       -Wall++  -- Modules exported by the library.+  Exposed-modules:   Text.Blaze.Builder.Core+                     Text.Blaze.Builder.Utf8+                     Text.Blaze.Builder.Html+  +  -- Packages needed in order to build this package.+  Build-depends:     base >= 4 && < 5,+                     text >= 0.7,+                     bytestring >= 0.9