[Initial version using Haskell source extensions to show the web pages Neil Mitchell **20060816142419] { addfile ./src/Web/HTML.xhs hunk ./src/Web/HTML.xhs 1 + +-- generate pages, using hsx preprocessor +-- http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/ +module Web.HTML(htmlError) where + +import Web.XML + + +htmlError :: String -> String -> String +htmlError search errmsg = searchPage search $ + + + + + +
Invalid SearchNo results found
+ <+> +
+ Error, your search was invalid:
+ <% errmsg %> + +
+ + + + +searchPage :: String -> XML -> String +searchPage search inner = + "" + ++ show ( + + + + <% search %> - Hoogle + + + + + + + + + + + + + + + +
+
+ + +
+
+ + <% inner %> + + + + + ) + addfile ./src/Web/XML.hs hunk ./src/Web/XML.hs 1 + +module Web.XML where + + +-- the data + +data XML = Tag String [Attribute] XML + | PCData String + | RawData String + | XmlList [XML] + +data Pair a b = a := b + +data Attribute = Attribute String String + + +-- the generators + +a <+> b = XmlList [a,b] + +genTag :: (Maybe String, String) -> [Attribute] -> [XML] -> XML +genTag (a,b) c d = Tag b c (XmlList d) + +toAttribute :: Pair String String -> Attribute +toAttribute (a := b) = Attribute a b + +pcdata :: String -> XML +pcdata x = PCData x + +genETag :: (Maybe String, String) -> [Attribute] -> XML +genETag a b = genTag a b [] + +rawXml x = RawData x + +class ToXMLs a where + toXMLs :: a -> XML + +instance ToXMLs XML where + toXMLs x = x + +instance ToXMLs String where + toXMLs x = PCData x + + +-- the show + +instance Show XML where + show (Tag name attr inner) = "<" ++ name ++ concatMap ((' ':) . show) attr ++ ">" ++ + show inner ++ + "" + show (PCData s) = s + show (XmlList xs) = concatMap show xs + show (RawData x) = x + +instance Show Attribute where + show (Attribute name value) = name ++ "=\"" ++ value ++ "\"" + }