git.iko.soy/elk
on d700acf help sign in
elk/compiler/Generate/Noscript.hs
66 lines 2.1 kB history raw
1module Generate.Noscript (noscript) where
3import Data.List (isInfixOf)
4import SourceSyntax.Everything
5import qualified Text.Pandoc as Pan
7noscript :: Module t v -> String
8noscript modul = concat (extract modul)
10class Extract a where
11 extract :: a -> [String]
13instance Extract (Module t v) where
14 extract (Module _ _ _ stmts) =
15 map (\s -> "<p>" ++ s ++ "</p>") (concatMap extract stmts)
17instance Extract (Declaration t v) where
18 extract (Definition d) = extract d
19 extract _ = []
21instance Extract (Def t v) where
22 extract (FnDef _ _ e) = extract e
23 extract (OpDef _ _ _ e) = extract e
24 extract _ = []
26instance Extract e => Extract (Located e) where
27 extract (L _ _ e) = extract e
29instance Extract (Expr t v) where
30 extract expr =
31 let f = extract in
32 case expr of
33 Literal (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 (L _ _ (App (L _ _ (App (L _ _ (Var func)) w)) h)) src
39 | "image" `isInfixOf` func -> extractImage src
40 App (L _ _ (App (L _ _ (Var func)) src)) txt
41 | "link" `isInfixOf` func -> extractLink src txt
42 App (L _ _ (Var func)) e
43 | "header" `isInfixOf` func -> tag "h1" e
44 | "bold" `isInfixOf` func -> tag "b" e
45 | "italic" `isInfixOf` func -> tag "i" e
46 | "monospace" `isInfixOf` func -> tag "code" e
47 App e1 e2 -> f e1 ++ f e2
48 Let defs e -> concatMap extract defs ++ f e
49 Var _ -> []
50 Case e cases -> concatMap (f . snd) cases
51 Data _ es -> concatMap f es
52 MultiIf es -> concatMap (f . snd) es
53 Markdown doc -> [ Pan.writeHtmlString Pan.def doc ]
54 _ -> []
56extractLink src txt =
57 case (extract src, extract txt) of
58 ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]
59 ( ss1, ss2) -> ss1 ++ ss2
61extractImage src =
62 case extract src of
63 [s] -> ["<img src=\"" ++ s ++ "\">"]
64 ss -> ss
66tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract e)