on b00a8cb help sign in
elk/compiler/Generate/Noscript.hs
68 lines 2.3 kB history raw
1module Generate.Noscript (noscript) where
3import Data.List (isInfixOf)
4import qualified SourceSyntax.Declaration as D
5import SourceSyntax.Expression
6import SourceSyntax.Literal
7import SourceSyntax.Location
8import SourceSyntax.Module
9import qualified Generate.Markdown as MD
11noscript :: Extract def => Module def -> String
12noscript modul = concat (extract modul)
14class Extract a where
15 extract :: a -> [String]
17instance Extract def => Extract (Module def) where
18 extract (Module _ _ _ stmts) =
19 map (\s -> "<p>" ++ s ++ "</p>") (concatMap extract stmts)
21instance Extract def => Extract (D.Declaration' port def) where
22 extract (D.Definition d) = extract d
23 extract _ = []
25instance Extract Def where
26 extract (Definition _ e _) = extract e
28instance Extract e => Extract (Located e) where
29 extract (L _ e) = extract e
31instance Extract def => Extract (Expr' def) where
32 extract expr =
33 let f = extract in
34 case expr of
35 Literal (Str s) -> [s]
36 Binop op e1 e2 -> case (op, f e1, f e2) of
37 ("++", [s1], [s2]) -> [s1 ++ s2]
38 (_ , ss1 , ss2 ) -> ss1 ++ ss2
39 Lambda v e -> f e
40 App (L _ (App (L _ (App (L _ (Var func)) w)) h)) src
41 | "image" `isInfixOf` func -> extractImage src
42 App (L _ (App (L _ (Var func)) src)) txt
43 | "link" `isInfixOf` func -> extractLink src txt
44 App (L _ (Var func)) e
45 | "header" `isInfixOf` func -> tag "h1" e
46 | "bold" `isInfixOf` func -> tag "b" e
47 | "italic" `isInfixOf` func -> tag "i" e
48 | "monospace" `isInfixOf` func -> tag "code" e
49 App e1 e2 -> f e1 ++ f e2
50 Let defs e -> concatMap extract defs ++ f e
51 Var _ -> []
52 Case e cases -> concatMap (f . snd) cases
53 Data _ es -> concatMap f es
54 MultiIf es -> concatMap (f . snd) es
55 Markdown _ md _ -> [ MD.toHtml md ]
56 _ -> []
58extractLink src txt =
59 case (extract src, extract txt) of
60 ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]
61 ( ss1, ss2) -> ss1 ++ ss2
63extractImage src =
64 case extract src of
65 [s] -> ["<img src=\"" ++ s ++ "\">"]
66 ss -> ss
68tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract e)