diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +2009.9.2 +-------- + +### Feature + +* use DList in writer to further boost performance, bytestring internal + DList is about as fast as it gets for writer monad + 2009.9.1 -------- diff --git a/moe.cabal b/moe.cabal --- a/moe.cabal +++ b/moe.cabal @@ -1,5 +1,5 @@ Name: moe -Version: 2009.9.1.1 +Version: 2009.9.2 Build-type: Simple Synopsis: html with style Description: @@ -17,8 +17,8 @@ data-files: readme.md, changelog.md, known-issues.md, Nemesis, src/test.hs library - ghc-options: -Wall - build-depends: base >= 4 && < 5, mtl, mps >= 2009.8.18.1, data-default, bytestring, utf8-string + ghc-options: -Wall -fno-warn-orphans + build-depends: base >= 4 && < 5, mtl, mps >= 2009.8.18.1, data-default, bytestring, utf8-string, dlist hs-source-dirs: src/ exposed-modules: Text.HTML.Moe @@ -28,3 +28,6 @@ Text.HTML.Moe.DSL.Kawaii Text.HTML.Moe.Type Text.HTML.Moe.Utils + Text.HTML.Moe.Backend.ByteString + other-modules: + Text.HTML.Moe.Backend.DList diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -9,9 +9,8 @@ import Prelude hiding ((/), (-), head, (>), (.), div) import MPS.Light ((-)) import Text.HTML.Moe - import Data.ByteString - test_page :: Text + test_page :: String test_page = render - html' - do head' - do diff --git a/src/Text/HTML/Moe.hs b/src/Text/HTML/Moe.hs --- a/src/Text/HTML/Moe.hs +++ b/src/Text/HTML/Moe.hs @@ -6,6 +6,7 @@ , module Text.HTML.Moe.Attribute , (/) , render + , render' ) where @@ -17,28 +18,32 @@ import qualified Text.HTML.Moe.Type as T import Text.HTML.Moe.Element import Text.HTML.Moe.Attribute -import Data.ByteString.Char8 (ByteString, concat, append, intercalate) import Text.HTML.Moe.Utils +import qualified Data.ByteString.Char8 as B +import Data.DList (toList) (/) :: MoeUnit (/) = return () render :: MoeUnit -> String -render = execWriter > map render_element > intercalate (pack "\n") > unpack +render = render' > B.unpack +render' :: MoeUnit -> B.ByteString +render' = execWriter > toList > map render_element > intercalate new_line > to_bs + _indent_space :: Int _indent_space = 2 -new_line :: ByteString +new_line :: Internal new_line = pack "\n" -space :: ByteString +space :: Internal space = pack " " -_indent :: Int -> ByteString +_indent :: Int -> Internal _indent n = (n * _indent_space).times space.concat -render_element' :: Int -> Element -> ByteString +render_element' :: Int -> Element -> Internal render_element' _ (Raw x) = x render_element' _ (Pre x) = x render_element' n (Prim x) = _indent n + x + new_line @@ -63,10 +68,10 @@ join_attribute xs = xs.map (pack " " `append`) .concat -render_element :: Element -> ByteString +render_element :: Element -> Internal render_element = render_element' 0 -render_attribute :: Attribute -> ByteString +render_attribute :: Attribute -> Internal render_attribute x = [x.key, pack "=", pack "\"", x.T.value, pack "\""].concat diff --git a/src/Text/HTML/Moe/Attribute.hs b/src/Text/HTML/Moe/Attribute.hs --- a/src/Text/HTML/Moe/Attribute.hs +++ b/src/Text/HTML/Moe/Attribute.hs @@ -1,6 +1,7 @@ module Text.HTML.Moe.Attribute where import Text.HTML.Moe.Type +import Text.HTML.Moe.Utils import Prelude hiding (id, (-)) import MPS.Light ((-)) import Text.HTML.Moe.Utils diff --git a/src/Text/HTML/Moe/Backend/ByteString.hs b/src/Text/HTML/Moe/Backend/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Text/HTML/Moe/Backend/ByteString.hs @@ -0,0 +1,27 @@ +module Text.HTML.Moe.Backend.ByteString where + +import qualified Data.ByteString.Char8 as B +import Data.ByteString.UTF8 (fromString, toString) + +type Internal = B.ByteString + +pack :: String -> Internal +pack = fromString + +unpack :: Internal -> String +unpack = toString + +none :: Internal +none = B.empty + +concat :: [Internal] -> Internal +concat = B.concat + +append :: Internal -> Internal -> Internal +append = B.append + +intercalate :: Internal -> [Internal] -> Internal +intercalate = B.intercalate + +to_bs :: Internal -> B.ByteString +to_bs = id diff --git a/src/Text/HTML/Moe/Backend/DList.hs b/src/Text/HTML/Moe/Backend/DList.hs new file mode 100644 --- /dev/null +++ b/src/Text/HTML/Moe/Backend/DList.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Text.HTML.Moe.Backend.DList where + +import qualified Data.ByteString.Char8 as B +import Data.ByteString.UTF8 (fromString) +import qualified Data.DList as D +import qualified Data.List as L + +type Internal = D.DList Char + +instance Show (D.DList Char) where + show = D.toList + +pack :: String -> Internal +pack = D.fromList + +unpack :: Internal -> String +unpack = D.toList + +none :: Internal +none = D.empty + +concat :: [Internal] -> Internal +concat = D.concat + +append :: Internal -> Internal -> Internal +append = D.append + +intercalate :: Internal -> [Internal] -> Internal +intercalate x = D.concat . L.intersperse x + +to_bs :: Internal -> B.ByteString +to_bs = fromString . D.toList diff --git a/src/Text/HTML/Moe/Element.hs b/src/Text/HTML/Moe/Element.hs --- a/src/Text/HTML/Moe/Element.hs +++ b/src/Text/HTML/Moe/Element.hs @@ -6,17 +6,17 @@ import Control.Monad.Writer import Prelude hiding (id, span, div, head, (>), (.), (-)) import MPS.Light ((-)) +import Data.DList (singleton, toList) element' :: String -> MoeCombinator -element' x xs u = tell [ +element' x xs u = tell - singleton - def { name = pack - escape x , attributes = xs - , elements = execWriter u + , elements = toList - execWriter - u } - ] e :: String -> MoeCombinator e = element' @@ -25,15 +25,14 @@ element x = flip x [] no_indent_element :: String -> MoeCombinator -no_indent_element x xs u = tell [ +no_indent_element x xs u = tell - singleton - def { name = pack - x , attributes = xs - , elements = execWriter u + , elements = toList - execWriter u , indent = False } - ] ne :: String -> MoeCombinator ne = no_indent_element @@ -237,7 +236,7 @@ str, raw, _pre, prim :: String -> MoeUnit -str x = tell [Data (pack - escape x)] -raw x = tell [Raw (pack x)] -_pre x = tell [Pre (pack - escape x)] -prim x = tell [Prim (pack x)] +str x = tell - singleton - Data (pack - escape x) +raw x = tell - singleton - Raw (pack x) +_pre x = tell - singleton - Pre (pack - escape x) +prim x = tell - singleton - Prim (pack x) diff --git a/src/Text/HTML/Moe/Type.hs b/src/Text/HTML/Moe/Type.hs --- a/src/Text/HTML/Moe/Type.hs +++ b/src/Text/HTML/Moe/Type.hs @@ -2,36 +2,37 @@ import Data.Default import Control.Monad.Writer -import Data.ByteString +import Text.HTML.Moe.Utils +import Data.DList (DList) data Element = Element { - name :: ByteString + name :: Internal , attributes :: [Attribute] , elements :: [Element] , indent :: Bool } - | Raw ByteString -- no escape, no indent - | Pre ByteString -- escape, no indent - | Data ByteString -- escape, indent - | Prim ByteString -- no escape, indent + | Raw Internal -- no escape, no indent + | Pre Internal -- escape, no indent + | Data Internal -- escape, indent + | Prim Internal -- no escape, indent deriving (Show) instance Default Element where - def = Element empty def def True + def = Element none def def True data Attribute = Attribute { - key :: ByteString - , value :: ByteString + key :: Internal + , value :: Internal } deriving (Show) instance Default Attribute where - def = Attribute empty empty + def = Attribute none none -type MoeUnitT a = Writer [Element] a +type MoeUnitT a = Writer (DList Element) a type MoeUnit = MoeUnitT () type MoeCombinator = [Attribute] -> MoeUnit -> MoeUnit diff --git a/src/Text/HTML/Moe/Utils.hs b/src/Text/HTML/Moe/Utils.hs --- a/src/Text/HTML/Moe/Utils.hs +++ b/src/Text/HTML/Moe/Utils.hs @@ -1,9 +1,12 @@ -module Text.HTML.Moe.Utils where +module Text.HTML.Moe.Utils +( escape +, (+) +, module Text.HTML.Moe.Backend.ByteString +) where -import Data.ByteString.UTF8 (fromString, toString) -import Data.ByteString.Char8 (ByteString) import Prelude hiding ((+)) import Data.Monoid +import Text.HTML.Moe.Backend.ByteString escape :: String -> String escape = escape_html @@ -17,12 +20,6 @@ fixChar '\'' = "'" fixChar '"' = """ fixChar x = [x] - -pack :: String -> ByteString -pack = fromString - -unpack :: ByteString -> String -unpack = toString (+) :: (Monoid a) => a -> a -> a (+) = mappend