[added HSP.HTMLBuilder until fixed upstream. Do not run sanitizeBalance since page authors should be allow to put arbitrary html on the page
Jeremy Shaw <jeremy@seereason.com>**20120327020455
 Ignore-this: 13639809039e8d083bd11bc85d4413d9
] hunk ./clckwrks/Clckwrks/Markup/HsColour.hs 41
-                return (Right (sanitizeBalance (T.pack m)))
+                return (Right ({- sanitizeBalance -} (T.pack m)))
hunk ./clckwrks/Clckwrks/Markup/Markdown.hs 26
-       _ <- forkIO $ do T.hPutStr inh txt 
+       _ <- forkIO $ do T.hPutStr inh txt
hunk ./clckwrks/Clckwrks/Markup/Markdown.hs 41
-                return (Right (sanitizeBalance (T.pack m)))
+                return (Right ({- sanitizeBalance -} (T.pack m)))
hunk ./clckwrks/Clckwrks/Monad.hs 77
-import Language.Javascript.JMacro    
+import Language.Javascript.JMacro
hunk ./clckwrks/Clckwrks/Monad.hs 87
-data ClckState 
-    = ClckState { acidState        :: Acid 
+data ClckState
+    = ClckState { acidState        :: Acid
hunk ./clckwrks/Clckwrks/Monad.hs 131
-getUnique = 
+getUnique =
hunk ./clckwrks/Clckwrks/Monad.hs 177
-instance ToJExpr Text.Text where    
+instance ToJExpr Text.Text where
hunk ./clckwrks/Clckwrks/Monad.hs 216
-getUserId = 
+getUserId =
hunk ./clckwrks/Clckwrks/Monad.hs 243
-                 xs -> xs                       
+                 xs -> xs
hunk ./clckwrks/Clckwrks/Monad.hs 259
-    asAttr = return . (:[]) . FAttr 
+    asAttr = return . (:[]) . FAttr
hunk ./clckwrks/Clckwrks/Monad.hs 278
-    asAttr (n := u) = 
+    asAttr (n := u) =
hunk ./clckwrks/Clckwrks/Monad.hs 283
-    asAttr (n := u) = 
+    asAttr (n := u) =
hunk ./clckwrks/Clckwrks/Monad.hs 290
-    asAttr (n := u) = 
+    asAttr (n := u) =
hunk ./clckwrks/Clckwrks/Monad.hs 326
-    asChild c = 
+    asChild c =
hunk ./clckwrks/Clckwrks/Monad.hs 331
-    asChild c = 
+    asChild c =
hunk ./clckwrks/Clckwrks/Monad.hs 374
-data Content 
+data Content
hunk ./clckwrks/Clckwrks/Monad.hs 385
-    do clckState <- get 
+    do clckState <- get
hunk ./clckwrks/Clckwrks/Monad.hs 420
-    case Map.lookup name handlers of 
-      Nothing -> return $ "<span class='preprocessor-error'>Invalid processor name: " `mappend` 
-                             (B.fromText name) `mappend` 
+    case Map.lookup name handlers of
+      Nothing -> return $ "<span class='preprocessor-error'>Invalid processor name: " `mappend`
+                             (B.fromText name) `mappend`
hunk ./clckwrks/Clckwrks/Monad.hs 428
-processSegments handlers segments = 
+processSegments handlers segments =
hunk ./clckwrks/Clckwrks/Monad.hs 435
-      Right segs -> 
+      Right segs ->
hunk ./clckwrks/Clckwrks/Monad.hs 442
-requiresRole :: (Happstack m) => Role -> url -> ClckT ClckURL m url 
+requiresRole :: (Happstack m) => Role -> url -> ClckT ClckURL m url
hunk ./clckwrks/Clckwrks/Monad.hs 447
-         (Just uid) -> 
+         (Just uid) ->
adddir ./clckwrks/HSP
addfile ./clckwrks/HSP/HTMLBuilder.hs
hunk ./clckwrks/HSP/HTMLBuilder.hs 1
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  HSP.HTML
+-- Copyright   :  (c) Niklas Broberg, Jeremy Shaw 2008
+-- License     :  BSD-style (see the file LICENSE.txt)
+--
+-- Maintainer  :  Niklas Broberg, nibro@cs.chalmers.se
+-- Stability   :  experimental
+-- Portability :  Haskell 98
+--
+-- Attempt to render XHTML as well-formed HTML 4.01:
+--
+--  1. no short tags are used, e.g., \<script\>\<\/script\> instead of \<script \/\>
+--
+--  2. the end tag is forbidden for some elements, for these we:
+--
+--    * render only the open tag, e.g., \<br\>
+--
+--    * throw an error if the tag contains children
+--
+--  3. optional end tags are always rendered
+--
+-- Currently no validation is performed.
+-----------------------------------------------------------------------------
+module HSP.HTMLBuilder (
+                  Style(..)
+                 -- * Functions
+                , renderAsHTML
+                , htmlEscapeChars
+                ) where
+
+import Data.List
+import Data.Monoid (mappend, mconcat, mempty)
+import Data.Text.Lazy (unpack)
+import Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText)
+import HSP.XML
+import HSP.XML.PCDATA(escaper)
+
+-- | Pretty-prints HTML values.
+--
+-- Error Handling:
+--
+-- Some tags (such as img) can not contain children in HTML. However,
+-- there is nothing to stop the caller from passing in XML which
+-- contains an img tag with children. There are three basic ways to
+-- handle this:
+--
+--  1. drop the bogus children silently
+--
+--  2. call 'error' \/ raise an exception
+--
+--  3. render the img tag with children -- even though it is invalid
+--
+-- Currently we are taking approach #3, since no other attempts to
+-- validate the data are made in this function. Instead, you can run
+-- the output through a full HTML validator to detect the errors.
+--
+-- #1 seems like a poor choice, since it makes is easy to overlook the
+-- fact that data went missing.
+--
+-- We could raising errors, but you have to be in the IO monad to
+-- catch them. Also, you have to use evaluate if you want to check for
+-- errors. This means you can not start sending the page until the
+-- whole page has been rendered. And you have to store the whole page
+-- in RAM at once. Similar problems occur if we return Either
+-- instead. We mostly care about catching errors and showing them in
+-- the browser during testing, so perhaps this can be configurable.
+--
+-- Another solution would be a compile time error if an empty-only
+-- tag contained children.
+--
+-- FIXME: also verify that the domain is correct
+--
+-- FIXME: what to do if a namespace is encountered
+
+renderAsHTML :: Style -> XML -> Builder
+renderAsHTML style xml = renderAsHTML' style 0 xml
+
+data TagType = Open | Close
+
+data Style = Compact | Expanded
+
+renderAsHTML' :: Style -> Int -> XML -> Builder
+renderAsHTML' _ _ (CDATA needsEscape cd) = fromString (if needsEscape then (escaper htmlEscapeChars cd) else cd)
+
+renderAsHTML' style n elm@(Element name@(Nothing,nm) attrs children)
+    | nm == "area"	= renderTagEmpty children
+    | nm == "base"	= renderTagEmpty children
+    | nm == "br"        = renderTagEmpty children
+    | nm == "col"       = renderTagEmpty children
+    | nm == "hr"        = renderTagEmpty children
+    | nm == "img"       = renderTagEmpty children
+    | nm == "input"     = renderTagEmpty children
+    | nm == "link"      = renderTagEmpty children
+    | nm == "meta"      = renderTagEmpty children
+    | nm == "param"     = renderTagEmpty children
+    | nm == "script"    = renderElement style n (Element name attrs (map asCDATA children))
+    | nm == "style"     = renderElement style n (Element name attrs (map asCDATA children))
+    where
+      renderTagEmpty [] = renderTag style Open n name attrs
+      renderTagEmpty _ = renderElement style n elm -- this case should not happen in valid HTML
+      -- for and script\/style, render text in element as CDATA not PCDATA
+      asCDATA :: XML -> XML
+      asCDATA (CDATA _ cd) = (CDATA False cd)
+      asCDATA o = o -- this case should not happen in valid HTML
+renderAsHTML' style n e = renderElement style n e
+
+renderElement :: Style -> Int -> XML -> Builder
+renderElement style n (Element name attrs children) =
+        let open  = renderTag style Open n name attrs
+            cs    = renderChildren n children
+            close = renderTag style Close n name []
+         in mconcat [open, cs, close]
+  where renderChildren :: Int -> Children -> Builder
+        renderChildren n' cs = mconcat $ map (renderAsHTML' style (n'+2)) cs
+renderElement _ _ _ = error "internal error: renderElement only suports the Element constructor."
+
+
+renderTag :: Style -> TagType -> Int -> Name -> Attributes -> Builder
+renderTag style typ n name attrs =
+        let (start,end) = case typ of
+                           Open   -> (singleton  '<' , singleton '>')
+                           Close  -> (fromString "</", singleton '>')
+            nam = showName name
+            as  = renderAttrs attrs
+         in mconcat [start, nam, as, end]
+
+  where renderAttrs :: Attributes -> Builder
+        renderAttrs [] = nl
+        renderAttrs attrs' = mconcat [singleton ' ', ats, nl]
+          where ats = mconcat $ intersperse (singleton ' ') $ fmap renderAttr attrs'
+
+        renderAttr :: Attribute -> Builder
+        renderAttr (MkAttr (nam, (Value needsEscape val))) =
+            mconcat [ showName nam, singleton '=', renderAttrVal (if needsEscape then (escaper htmlEscapeChars val) else val)]
+
+        renderAttrVal :: String -> Builder
+        renderAttrVal s =
+            mconcat [singleton '\"', fromString s, singleton '\"']
+
+        showName (Nothing, s) = fromString s
+        showName (Just d, s)  = mconcat [fromString d, singleton ':', fromString s]
+
+        nl =
+            case style of
+              Compact  -> mempty
+              Expanded -> singleton '\n' `mappend` (fromString $ replicate n ' ')
+
+-- This list should be extended.
+htmlEscapeChars :: [(Char, String)]
+htmlEscapeChars = [
+	('&',	"amp"	),
+	('\"',	"quot"	),
+	('<',	"lt"	),
+	('>',	"gt"	)
+	]
hunk ./clckwrks/clckwrks.cabal 2
-Version:             0.1.1
+Version:             0.1.2
hunk ./clckwrks/clckwrks.cabal 52
+                   HSP.HTMLBuilder