diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +2009.9.1 +-------- + +### Feature + +* use bytestring internally for performance +* more markdown helper +* add prim element tag, for no escape, but indented element + 2009.8.25 --------- diff --git a/moe.cabal b/moe.cabal --- a/moe.cabal +++ b/moe.cabal @@ -1,5 +1,5 @@ Name: moe -Version: 2009.8.28 +Version: 2009.9.1 Build-type: Simple Synopsis: html with style Description: @@ -18,7 +18,7 @@ library ghc-options: -Wall - build-depends: base >= 4 && < 5, mtl, mps >= 2009.8.18.1, data-default + build-depends: base >= 4 && < 5, mtl, mps >= 2009.8.18.1, data-default, bytestring hs-source-dirs: src/ exposed-modules: Text.HTML.Moe @@ -27,3 +27,4 @@ Text.HTML.Moe.DSL.Markdown Text.HTML.Moe.DSL.Kawaii Text.HTML.Moe.Type + Text.HTML.Moe.Utils diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -9,8 +9,9 @@ import Prelude hiding ((/), (-), head, (>), (.), div) import MPS.Light ((-)) import Text.HTML.Moe + import Data.ByteString - test_page :: String + test_page :: Text 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 @@ -9,68 +9,64 @@ ) where -import Control.Monad.Writer (tell, execWriter) -import Prelude hiding ((/), (-), head, (>), (.)) -import MPS.Light ((-), (>), (.), join, times) +import Control.Monad.Writer (execWriter) +import Prelude hiding ((/), (-), head, (>), (.), concat, concatMap, (+)) +import qualified Prelude as P +import MPS.Light ((>), (.), times) import Text.HTML.Moe.Type hiding (name, value) 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 (/) :: MoeUnit (/) = return () render :: MoeUnit -> String -render = execWriter > map render_element > join "\n" +render = execWriter > map render_element > intercalate (pack "\n") > unpack -indent_space :: Int -indent_space = 2 +_indent_space :: Int +_indent_space = 2 -render_element' :: Int -> Element -> String -render_element' _ (Raw x) = x +new_line :: ByteString +new_line = pack "\n" -render_element' _ (Pre x) = escape x +space :: ByteString +space = pack " " -render_element' n (Data x) = execWriter - do - tell - (n * indent_space).times ' ' - tell - escape - x - tell - "\n" - -render_element' n x = execWriter - do - tell - _indent - tell - "<" ++ x.T.name ++ "" - tell - x.attributes.map render_attribute. join_attribute - tell - ">" - tell - "\n" - - tell - x.elements.map (render_element' (n+1)) .concat - - tell - _indent - tell - "" - tell - "\n" +_indent :: Int -> ByteString +_indent n = (n * _indent_space).times space.concat + +render_element' :: Int -> Element -> ByteString +render_element' _ (Raw x) = x +render_element' _ (Pre x) = x +render_element' n (Prim x) = _indent n + x + new_line +render_element' n (Data x) = _indent n + x + new_line +render_element' n x = + [ _indent n + , "<".pack + , x.T.name + , x.attributes.map render_attribute. join_attribute + , ">".pack + , new_line + , x.elements.map (render_element' (n P.+ 1)) .concat + , _indent n + , "".pack + , new_line + ] + .concat where - join_attribute xs = xs.map (" " ++) .concat - _indent - | x.indent = (n * indent_space).times ' ' - | otherwise = "" + join_attribute xs = xs.map (pack " " `append`) .concat -render_element :: Element -> String +render_element :: Element -> ByteString render_element = render_element' 0 -render_attribute :: Attribute -> String -render_attribute x = x.key ++ "=" ++ "\"" ++ x.T.value.escape ++ "\"" - -escape :: String -> String -escape = escape_html +render_attribute :: Attribute -> ByteString +render_attribute x = + [x.key, pack "=", pack "\"", x.T.value, pack "\""].concat -escape_html :: String -> String -escape_html = concatMap fixChar - where - fixChar '&' = "&" - fixChar '<' = "<" - fixChar '>' = ">" - fixChar '\'' = "'" - fixChar '"' = """ - fixChar x = [x] 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,10 +1,12 @@ module Text.HTML.Moe.Attribute where import Text.HTML.Moe.Type -import Prelude hiding (id) +import Prelude hiding (id, (-)) +import MPS.Light ((-)) +import Text.HTML.Moe.Utils -attr :: String -> String -> Attribute -attr = Attribute +attr :: String -> String -> Attribute +attr x y = Attribute (pack x) (pack - escape - y) _class :: String -> Attribute _data :: String -> Attribute @@ -20,7 +22,7 @@ classid :: String -> Attribute colspan :: String -> Attribute content :: String -> Attribute -height :: String -> Attribute +height :: String -> Attribute href :: String -> Attribute http_equiv :: String -> Attribute id :: String -> Attribute @@ -32,6 +34,7 @@ quality :: String -> Attribute rel :: String -> Attribute rowspan :: String -> Attribute +selected :: String -> Attribute src :: String -> Attribute size :: String -> Attribute target :: String -> Attribute @@ -65,8 +68,9 @@ method = attr "method" name = attr "name" quality = attr "quality" -rel = attr "rel" +rel = attr "rel" rowspan = attr "rowspan" +selected = attr "selected" src = attr "src" size = attr "size" target = attr "target" @@ -75,5 +79,3 @@ width = attr "width" xml_lang = attr "xml:lang" xmlns = attr "xmlns" - - diff --git a/src/Text/HTML/Moe/DSL/Kawaii.hs b/src/Text/HTML/Moe/DSL/Kawaii.hs --- a/src/Text/HTML/Moe/DSL/Kawaii.hs +++ b/src/Text/HTML/Moe/DSL/Kawaii.hs @@ -3,6 +3,7 @@ import Text.HTML.Moe import Text.HTML.Moe.Type (MoeUnit) +import Text.HTML.Moe.DSL.Markdown import Prelude hiding ((-), (/), div) c :: String -> MoeUnit -> MoeUnit @@ -10,3 +11,6 @@ css :: String -> MoeUnit css x = link [rel "stylesheet", _type "text/css", href x] (/) + +(~>) :: String -> String -> MoeUnit +(~>) = (<>) diff --git a/src/Text/HTML/Moe/DSL/Markdown.hs b/src/Text/HTML/Moe/DSL/Markdown.hs --- a/src/Text/HTML/Moe/DSL/Markdown.hs +++ b/src/Text/HTML/Moe/DSL/Markdown.hs @@ -1,13 +1,16 @@ -module Text.HTML.Moe.DSL.Markdown +module Text.HTML.Moe.DSL.Markdown ( - (#) -, (##) + (#) +, (##) , (###) -, (>>) -, (*) +, (####) +, (#####) +, (######) +, (>>) +, (*) , (***) --- , _ --- , __ +-- , _ +-- , __ , (!) , (<>) , o @@ -24,29 +27,35 @@ single_line f = f . str r = single_line -(#) :: String -> MoeUnit -(##) :: String -> MoeUnit -(###) :: String -> MoeUnit -(>>) :: String -> MoeUnit -(*) :: String -> MoeUnit --- _ :: String -> MoeUnit --- __ :: String -> MoeUnit -o :: String -> MoeUnit -block :: String -> MoeUnit -(***) :: MoeUnit -(!) :: String -> String -> MoeUnit -(<>) :: String -> String -> MoeUnit +(#) :: String -> MoeUnit +(##) :: String -> MoeUnit +(###) :: String -> MoeUnit +(####) :: String -> MoeUnit +(#####) :: String -> MoeUnit +(######) :: String -> MoeUnit +(>>) :: String -> MoeUnit +(*) :: String -> MoeUnit +-- _ :: String -> MoeUnit +-- __ :: String -> MoeUnit +o :: String -> MoeUnit +block :: String -> MoeUnit +(***) :: MoeUnit +(!) :: String -> String -> MoeUnit +(<>) :: String -> String -> MoeUnit (#) = r h1' (##) = r h2' (###) = r h3' +(####) = r h4' +(#####) = r h5' +(######) = r h6' (>>) = r blockquote' (*) = r ul' -- _ = r em' -- __ = r strong' o = r li' -block = pre' . code' . str +block = pre' . code' . _pre (***) = hr' (/) (!) x y = img [src y, alt x] (/) (<>) x y = a [href y] - str x 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 @@ -1,34 +1,37 @@ module Text.HTML.Moe.Element where import Text.HTML.Moe.Type +import Text.HTML.Moe.Utils import Data.Default import Control.Monad.Writer -import Prelude hiding (id, span, div, head) +import Prelude hiding (id, span, div, head, (>), (.), (-)) +import MPS.Light ((-)) + element' :: String -> MoeCombinator element' x xs u = tell [ def { - name = x + name = pack - escape x , attributes = xs - , elements = execWriter u + , elements = execWriter u } ] -element :: (String -> MoeCombinator) -> (String -> MoeCombinator') -element x = flip x [] - e :: String -> MoeCombinator e = element' + +element :: (String -> MoeCombinator) -> (String -> MoeCombinator') +element x = flip x [] no_indent_element :: String -> MoeCombinator no_indent_element x xs u = tell [ def { - name = x + name = pack - x , attributes = xs - , elements = execWriter u - , indent = False + , elements = execWriter u + , indent = False } ] @@ -234,6 +237,7 @@ str, raw, _pre :: String -> MoeUnit -str x = tell [Data x] -raw x = tell [Raw x] -_pre x = tell [Pre x] +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)] 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,32 +2,34 @@ import Data.Default import Control.Monad.Writer +import Data.ByteString data Element = Element { - name :: String + name :: ByteString , attributes :: [Attribute] , elements :: [Element] , indent :: Bool } - | Raw String -- for preformatted html strings, no escape - | Pre String -- for space sensitive tags, textarea/pre - | Data String -- normal string, auto escaped + | Raw ByteString -- no escape, no indent + | Pre ByteString -- escape, no indent + | Data ByteString -- escape, indent + | Prim ByteString -- no escape, indent deriving (Show) instance Default Element where - def = Element def def def True + def = Element empty def def True data Attribute = Attribute { - key :: String - , value :: String + key :: ByteString + , value :: ByteString } deriving (Show) instance Default Attribute where - def = Attribute def def + def = Attribute empty empty type MoeUnitT a = Writer [Element] a type MoeUnit = MoeUnitT () diff --git a/src/Text/HTML/Moe/Utils.hs b/src/Text/HTML/Moe/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Text/HTML/Moe/Utils.hs @@ -0,0 +1,29 @@ +module Text.HTML.Moe.Utils where + +import Data.ByteString.UTF8 (fromString, toString) +import Data.ByteString.Char8 (ByteString) +import Prelude hiding ((+)) +import Data.Monoid + +escape :: String -> String +escape = escape_html + +escape_html :: String -> String +escape_html = concatMap fixChar + where + fixChar '&' = "&" + fixChar '<' = "<" + fixChar '>' = ">" + fixChar '\'' = "'" + fixChar '"' = """ + fixChar x = [x] + +pack :: String -> ByteString +pack = fromString + +unpack :: ByteString -> String +unpack = toString + +(+) :: (Monoid a) => a -> a -> a +(+) = mappend +infixl 5 +