5 main = do t <- parseFile "../wix/wix.g" "../wix/lasik.wix"
6 putStrLn $ toHtml $ ((fromTree $ coalesceFlatHeadlessNodes t) :: Doc)
12 ------------------------------------------------------------------------------
13 data Doc = Doc Header [Section]
14 data Section = Section [Text] [Paragraph]
15 data Paragraph = Blockquote [Text]
24 | Command String [Text]
31 | Strikethrough [Text]
52 ------------------------------------------------------------------------------
53 class FromTree a where
55 class FromTrees a where
56 fromTrees :: [Tree] -> a
57 instance FromTree a => FromTree [a] where
58 fromTree (Tree _ c _) = map fromTree c
60 instance FromTree Doc where
61 fromTree (Tree "Doc" [a,b] _) = Doc Header $ fromTree b
62 fromTree (Tree "Doc" [b] _) = Doc Header $ fromTree b
63 fromTree _ = error "top level must be Doc"
65 instance FromTree Section where
66 fromTree (Tree "Section" [(Tree _ c _),(Tree _ paragraphs _)] _) =
67 Section (map fromTree c) $ map fromTree paragraphs
69 instance FromTree Paragraph where
70 fromTree (Tree "P" [Tree _ text _] _) = P $ map fromTree text
71 fromTree (Tree "HR" _ _) = HR
73 instance FromTree Text where
74 fromTree (Tree "Chars" chars _) = Chars $ fromTrees chars
75 fromTree (Tree "WS" _ _) = WS
76 fromTree (Tree "Symbol" sym _) = Symbol $ fromTrees sym
77 fromTree (Tree "Quotes" x _) = Quotes $ map fromTree x
78 fromTree (Tree "Block" x _) = Block $ map fromTree x
79 fromTree (Tree "Command" [x,y] _) = Command (fromTree x) (fromTree y)
80 fromTree (Tree "Verbatim" x _) = Verbatim $ fromTrees x
81 fromTree (Tree "Link" [word,link] _) = Link (fromTree word) (fromTree link)
82 fromTree (Tree "Underline" x _) = Underline $ map fromTree x
83 fromTree (Tree "Footnote" x _) = Footnote $ map fromTree x
84 fromTree (Tree "TT" x _) = TT $ map fromTree x
85 fromTree (Tree "Citation" x _) = Citation $ map fromTree x
86 fromTree (Tree "Strikethrough" x _) = Strikethrough $ map fromTree x
87 fromTree (Tree "Superscript" x _) = Superscript $ map fromTree x
88 fromTree (Tree "Subscript" x _) = Subscript $ map fromTree x
89 fromTree (Tree "Smallcap" x _) = Smallcap $ map fromTree x
90 fromTree (Tree "Bold" x _) = Bold $ map fromTree x
91 fromTree (Tree "Keyword" x _) = Keyword $ map fromTree x
92 fromTree (Tree "Italic" x _) = Italic $ map fromTree x
93 fromTree (Tree x _ _) = Chars $ x
95 instance FromTree URL where
98 instance FromTree String where
99 fromTree (Tree h c _) = h++(concatMap fromTree c)
100 instance FromTrees String where
101 fromTrees ts = concatMap (fromTree :: Tree -> String) ts
103 ------------------------------------------------------------------------------
105 toHtml :: a -> String
106 instance ToHtml a => ToHtml [a] where
107 toHtml x = concatMap toHtml x
109 instance ToHtml Doc where
110 toHtml (Doc h secs) = "<html><body>" ++ (toHtml secs) ++ "</body></html>"
111 instance ToHtml Section where
112 toHtml (Section header paragraphs) = "<h1>"++(toHtml header)++"</h1>"++(toHtml paragraphs)
113 instance ToHtml Paragraph where
114 toHtml (Blockquote t) = "<blockquote>"++(toHtml t)++"</blockquote>"
117 toHtml (P t) = "<p>"++(toHtml t)++"</p>"
118 instance ToHtml Text where
120 toHtml (Chars s) = toHtml s
121 toHtml (Symbol s) = toHtml s
122 toHtml (Quotes x) = "\""++(toHtml x)++"\""
123 toHtml (Block x) = toHtml x
124 toHtml (Verbatim x) = "<pre>\n"++x++"\n</pre>"
125 toHtml (Link t ref) = "<a href='"++(show ref)++"'>"++(toHtml t)++"</a>"
126 toHtml (Underline x) = "<u>"++(toHtml x)++"</u>"
127 toHtml (TT x) = "<tt>"++(toHtml x)++"</tt>"
128 toHtml (Citation x) = "<i>"++(toHtml x)++"</i>"
129 toHtml (Strikethrough x) = "<strike>"++(toHtml x)++"</strike>"
130 toHtml (Superscript x) = "<sup>"++(toHtml x)++"</sup>"
131 toHtml (Subscript x) = "<sub>"++(toHtml x)++"</sub>"
132 toHtml (Smallcap x) = "<sc>"++(toHtml x)++"</sc>"
133 toHtml (Bold x) = "<b>"++(toHtml x)++"</b>"
134 toHtml (Keyword x) = "<tt>"++(toHtml x)++"</tt>"
135 toHtml (Italic x) = "<i>"++(toHtml x)++"</i>"
136 toHtml (Command x y) = error $ "unsupported command "++(show x)
137 toHtml (Footnote x) = error $ "footnotes not supported"
139 instance ToHtml String where
140 toHtml s = concatMap htmlEscapeChar s
142 htmlEscapeChar '<' = "<"
143 htmlEscapeChar '>' = ">"
144 htmlEscapeChar '&' = "&"
145 htmlEscapeChar '\'' = "'"
146 htmlEscapeChar '\"' = """
147 htmlEscapeChar c = [c]
156 Doc: { { Section: { { Chars: { 19 } Symbol: { - } Chars: { Nov } }
157 { P: { { Chars: { Two } WS Chars: { weeks } WS Chars: { ago } WS
158 Chars: { I } WS Chars: { had } WS Chars: { Lasik } WS
159 Chars: { performed } WS Chars: { at } WS
160 Link: { { Chars: { the } WS Chars: { Pacific } WS Chars: { Vision }
161 WS Chars: { Institute } }
162 URL: { http DNS: { { pacificvision org } } { . } } }
163 WS Chars: { The } WS Chars: { short } WS Chars: { story } WS
164 Chars: { is } WS Chars: { that } WS Chars: { it } WS
165 Chars: { rocks } Symbol: { , } WS Chars: { and } WS Chars: { I } WS
166 Chars: { very } WS Chars: { highly } WS
167 Chars: { recommend } WS Chars: { Dr } Symbol: { . } WS
168 Chars: { Faktorovich }