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