git.iko.soy/elk
on 09bbada help sign in
elk/elm/src/Gen/ExtractNoscript.hs
37 lines 1.3 kB history raw
2module ExtractNoscript (extract) where
4import Ast
5import qualified Text.Pandoc as Pan
7extract (Module _ _ _ stmts) =
8 concatMap (\s -> "<p>" ++ s ++ "</p>") (concatMap stmtExtract stmts)
9 where stmtExtract (Def _ _ e) = extract' e
10 stmtExtract _ = []
12extract' expr =
13 let f = extract' in
14 case expr of
15 Str s -> [s]
16 Binop op e1 e2 -> case (op, f e1, f e2) of
17 ("++", [s1], [s2]) -> [s1 ++ s2]
18 (_ , ss1 , ss2 ) -> ss1 ++ ss2
19 Lambda v e -> f e
20 App (App (Var "link") src) txt ->
21 case (f src, f txt) of
22 ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]
23 ( ss1, ss2) -> ss1 ++ ss2
24 App (Var "header") e -> tag "h1" e
25 App (Var "bold") e -> tag "b" e
26 App (Var "italic") e -> tag "i" e
27 App (Var "monospace") e -> tag "code" e
28 App e1 e2 -> f e1 ++ f e2
29 If eb et ef -> f et ++ f ef
30 Let defs e -> concatMap (\(Definition _ _ d) -> f d) defs ++ f e
31 Var _ -> []
32 Case e cases -> concatMap (f . snd) cases
33 Data _ es -> concatMap f es
34 Markdown doc -> [ Pan.writeHtmlString Pan.defaultWriterOptions doc ]
35 _ -> []
37tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract' e)