git.iko.soy/elk
on d15e080 help sign in
elk/elm/src/Gen/ExtractNoscript.hs
56 lines 1.7 kB history raw
2module ExtractNoscript (extractNoscript) where
4import Ast
5import qualified Text.Pandoc as Pan
7extractNoscript :: Module -> String
8extractNoscript modul = concat (extract modul)
10class Extract a where
11 extract :: a -> [String]
13instance Extract Module where
14 extract (Module _ _ _ stmts) =
15 map (\s -> "<p>" ++ s ++ "</p>") (concatMap extract stmts)
17instance Extract Statement where
18 extract (Definition d) = extract d
19 extract _ = []
21instance Extract Def where
22 extract (FnDef _ _ e) = extract e
23 extract (OpDef _ _ _ e) = extract e
25instance Extract Expr where
26 extract expr =
27 let f = extract in
28 case expr of
29 Str s -> [s]
30 Binop op e1 e2 -> case (op, f e1, f e2) of
31 ("++", [s1], [s2]) -> [s1 ++ s2]
32 (_ , ss1 , ss2 ) -> ss1 ++ ss2
33 Lambda v e -> f e
34 App (App (Var "link") src) txt -> linkExtract src txt
35 App (App (Var "Graphics.link") src) txt -> linkExtract src txt
36 App (App (Var "Text.link") src) txt -> linkExtract src txt
37 App (Var "header") e -> tag "h1" e
38 App (Var "bold") e -> tag "b" e
39 App (Var "italic") e -> tag "i" e
40 App (Var "monospace") e -> tag "code" e
41 App e1 e2 -> f e1 ++ f e2
42 If eb et ef -> f et ++ f ef
43 Let defs e -> concatMap extract defs ++ f e
44 Var _ -> []
45 Case e cases -> concatMap (f . snd) cases
46 Data _ es -> concatMap f es
47 Markdown doc -> [ Pan.writeHtmlString Pan.defaultWriterOptions doc ]
48 _ -> []
50linkExtract src txt =
51 case (extract src, extract txt) of
52 ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]
53 ( ss1, ss2) -> ss1 ++ ss2
56tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract e)