\begin{code} module Main where import SBP main = do t <- parseFile "../wix/wix.g" "../wix/lasik.wix" putStrLn $ toHtml $ ((fromTree $ coalesceFlatHeadlessNodes t) :: Doc) -- url crap -- ul/ol -- glyphs ------------------------------------------------------------------------------ data Doc = Doc Header [Section] data Section = Section [Text] [Paragraph] data Paragraph = Blockquote [Text] | HR | OL | P [Text] data Text = WS | Chars String | Symbol String | Quotes [Text] | Block [Text] | Command String [Text] | Verbatim String | Link [Text] URL | Underline [Text] | Footnote [Text] | TT [Text] | Citation [Text] | Strikethrough [Text] | Superscript [Text] | Subscript [Text] | Smallcap [Text] | Bold [Text] | Keyword [Text] | Italic [Text] data Header = Header data URL = URL deriving Show {- glyph = euro:: "(e)" | r:: "(r)" | c:: "(c)" | tm:: "(tm)" | emdash:: "--" | ellipses:: "..." | cent:: "\\cent" -} ------------------------------------------------------------------------------ class FromTree a where fromTree :: Tree -> a class FromTrees a where fromTrees :: [Tree] -> a instance FromTree a => FromTree [a] where fromTree (Tree _ c _) = map fromTree c instance FromTree Doc where fromTree (Tree "Doc" [a,b] _) = Doc Header $ fromTree b fromTree (Tree "Doc" [b] _) = Doc Header $ fromTree b fromTree _ = error "top level must be Doc" instance FromTree Section where fromTree (Tree "Section" [(Tree _ c _),(Tree _ paragraphs _)] _) = Section (map fromTree c) $ map fromTree paragraphs instance FromTree Paragraph where fromTree (Tree "P" [Tree _ text _] _) = P $ map fromTree text fromTree (Tree "HR" _ _) = HR instance FromTree Text where fromTree (Tree "Chars" chars _) = Chars $ fromTrees chars fromTree (Tree "WS" _ _) = WS fromTree (Tree "Symbol" sym _) = Symbol $ fromTrees sym fromTree (Tree "Quotes" x _) = Quotes $ map fromTree x fromTree (Tree "Block" x _) = Block $ map fromTree x fromTree (Tree "Command" [x,y] _) = Command (fromTree x) (fromTree y) fromTree (Tree "Verbatim" x _) = Verbatim $ fromTrees x fromTree (Tree "Link" [word,link] _) = Link (fromTree word) (fromTree link) fromTree (Tree "Underline" x _) = Underline $ map fromTree x fromTree (Tree "Footnote" x _) = Footnote $ map fromTree x fromTree (Tree "TT" x _) = TT $ map fromTree x fromTree (Tree "Citation" x _) = Citation $ map fromTree x fromTree (Tree "Strikethrough" x _) = Strikethrough $ map fromTree x fromTree (Tree "Superscript" x _) = Superscript $ map fromTree x fromTree (Tree "Subscript" x _) = Subscript $ map fromTree x fromTree (Tree "Smallcap" x _) = Smallcap $ map fromTree x fromTree (Tree "Bold" x _) = Bold $ map fromTree x fromTree (Tree "Keyword" x _) = Keyword $ map fromTree x fromTree (Tree "Italic" x _) = Italic $ map fromTree x fromTree (Tree x _ _) = Chars $ x instance FromTree URL where fromTree x = URL instance FromTree String where fromTree (Tree h c _) = h++(concatMap fromTree c) instance FromTrees String where fromTrees ts = concatMap (fromTree :: Tree -> String) ts ------------------------------------------------------------------------------ class ToHtml a where toHtml :: a -> String instance ToHtml a => ToHtml [a] where toHtml x = concatMap toHtml x instance ToHtml Doc where toHtml (Doc h secs) = "
" ++ (toHtml secs) ++ "" instance ToHtml Section where toHtml (Section header paragraphs) = ""++(toHtml t)++"" toHtml HR = "
"++(toHtml t)++"
" instance ToHtml Text where toHtml WS = " " toHtml (Chars s) = toHtml s toHtml (Symbol s) = toHtml s toHtml (Quotes x) = "\""++(toHtml x)++"\"" toHtml (Block x) = toHtml x toHtml (Verbatim x) = "\n"++x++"\n" toHtml (Link t ref) = ""++(toHtml t)++"" toHtml (Underline x) = ""++(toHtml x)++"" toHtml (TT x) = ""++(toHtml x)++"" toHtml (Citation x) = ""++(toHtml x)++"" toHtml (Strikethrough x) = "