git.iko.soy/elk
on master help sign in
Enable generation of noscript tags.
89605b1evancz
src/CompileToJS.hs+1−1
compare with master
unifiedsplit
@@ -11,7 +11,7 @@ import Initialize
11
11
12
12
13compile = (return . addMain . toJS) <=< initialize
13compile = (return . addMain . toJS) <=< initialize
14−compileToJS = addMain . either (\err -> "text('"++err++"')") toJS . initialize
14+compileToJS = addMain . either (\err -> "text('"++err++"')") toJS
15addMain body = "function main(){return " ++ body ++ ";}"
15addMain body = "function main(){return " ++ body ++ ";}"
16
16
17parens = ("("++) . (++")")
17parens = ("("++) . (++")")
src/ExtractNoscript.hs+21−38
@@ -2,42 +2,25 @@
2module ExtractNoscript (extract) where
2module ExtractNoscript (extract) where
3
3
4import Ast
4import Ast
5−import Data.List (isPrefixOf)
6
5
7−extract = extract'
6+extract = concatMap (\s -> "<p>" ++ s ++ "</p>") . extract'
8−
7+
9−extract' expr = makeLinks terms where
8+extract' expr =
10− terms =
9+ let f = extract' in
11− case expr of
10+ case expr of
12− Number _ -> []
11+ Str s -> [s]
13− Chr _ -> []
14− Boolean _ -> []
15− Range _ _ -> []
16− Access _ _ -> []
17− Binop op e1 e2 -> case (op, extract' e1, extract' e2) of
12+ Binop op e1 e2 -> case (op, f e1, f e2) of
18− ("++", [s1], [s2]) -> [ s1 ++ s2 ]
13+ ("++", [s1], [s2]) -> [s1 ++ s2]
19− (_ , ss1 , ss2 ) -> ss1 ++ ss2
14+ (_ , ss1 , ss2 ) -> ss1 ++ ss2
20− Lambda v e -> extract' e
15+ Lambda v e -> f e
16+ App (App (Var "link") src) txt ->
17+ case (f src, f txt) of
18+ ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]
19+ ( ss1, ss2) -> ss1 ++ ss2
21− App e1 e2 -> extract' e1 ++ extract' e2
20+ App e1 e2 -> f e1 ++ f e2
22− If eb et ef -> extract' et ++ extract' ef
21+ If eb et ef -> f et ++ f ef
23− Lift f es -> extract' f ++ concatMap extract es
24− Fold e1 e2 e3 -> concatMap extract' [e1,e2,e3]
25− Async e -> extract' e
26− Input _ -> []
27− Let defs e -> concatMap (extract' . snd) defs ++ extract' e
22+ Let defs e -> concatMap (f . snd) defs ++ f e
28− Var _ -> []
23+ Var _ -> []
29− Case e cases -> concatMap (extract' . snd) cases
24+ Case e cases -> concatMap (f . snd) cases
30− Data _ _ -> [toString expr]
25+ Data _ es -> concatMap f es
31−
26+ _ -> []
32−toString (Data "Cons" [Chr c, t]) = c : toString t
33−toString _ = []
34−
35−makeLinks (a:b:[]) = linkify a b
36−makeLinks xs = xs
37−
38−linkish s = not ("<a" `isPrefixOf` s) && notElem ' ' s && elem '/' s
39−
40−linkify a b
41− | linkish a = [ "<a href=\"" ++ a ++ "\">" ++ b ++ "</a>" ]
42− | linkish b = [ "<a href=\"" ++ b ++ "\">" ++ a ++ "</a>" ]
43− | otherwise = [a,b]
src/GenerateHtml.hs+42−33
@@ -1,33 +1,42 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−module GenerateHtml (generateHtml) where
2+module GenerateHtml (generateHtml) where
3−
3+
4−import Text.Blaze (preEscapedToMarkup)
4+import Text.Blaze (preEscapedToMarkup)
5−import qualified Text.Blaze.Html5 as H
5+import qualified Text.Blaze.Html5 as H
6−import Text.Blaze.Html5 ((!))
6+import Text.Blaze.Html5 ((!))
7−import qualified Text.Blaze.Html5.Attributes as A
7+import qualified Text.Blaze.Html5.Attributes as A
8−
8+
9+import Initialize
10+import CompileToJS
11+import ExtractNoscript
12+
9−css = preEscapedToMarkup $
13+css = preEscapedToMarkup $
10− ("* { padding:0; margin:0; \
14+ ("* { padding:0; margin:0; \
11− \hyphens: auto; -moz-hyphens: auto;\
15+ \hyphens: auto; -moz-hyphens: auto;\
12− \ -webkit-hyphens: auto; -ms-hyphens: auto; }\
16+ \ -webkit-hyphens: auto; -ms-hyphens: auto; }\
13− \body { font-family: Arial; }\
17+ \body { font-family: Arial; }\
14− \a:link {text-decoration: none}\
18+ \a:link {text-decoration: none}\
15− \a:visited {text-decoration: none}\
19+ \a:visited {text-decoration: none}\
16− \a:active {text-decoration: none}\
20+ \a:active {text-decoration: none}\
17− \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
21+ \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
18−
22+
19−makeScript :: String -> H.Html
23+makeScript :: String -> H.Html
20−makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
24+makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
21−
25+
22−generateHtml libLoc title source =
26+generateHtml libLoc title source =
27+ let expr = initialize source
28+ js = compileToJS expr
29+ noscript = either id extract expr
30+ in
23− H.docTypeHtml $ do
31+ H.docTypeHtml $ do
24− H.head $ do
32+ H.head $ do
25− H.meta ! A.charset "UTF-8"
33+ H.meta ! A.charset "UTF-8"
26− H.title . H.toHtml $ title
34+ H.title . H.toHtml $ title
27− makeScript libLoc
35+ makeScript libLoc
28− (H.script ! A.type_ "text/javascript") . preEscapedToMarkup $ source
36+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup js
29− H.style ! A.type_ "text/css" $ css
37+ H.style ! A.type_ "text/css" $ css
30− H.body $ do
38+ H.body $ do
31− H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
39+ H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
32− H.span ! A.id "content" $ ""
40+ H.span ! A.id "content" $ ""
33− H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
41+ H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
42+ H.noscript $ preEscapedToMarkup noscript
src/Language/Elm.hs+7−2
@@ -1,10 +1,15 @@
1
1
2module Language.Elm where
2module Language.Elm where
3
3
4−import CompileToJS
5import GenerateHtml
4import GenerateHtml
6import Text.Blaze.Html (Html)
5import Text.Blaze.Html (Html)
7
6
7+-- | The 'compileToHtml' function takes three string arguments: the
8+-- location of the Elm runtime (elm-mini.js), the title to be used in
9+-- the resulting HTML page, and the Elm source code. For example,
10+--
11+-- > compileToHtml "/elm-mini.js" "Hello, World!" "main = plainText \"Hello, World!\""
12+
8compileToHtml :: String -> String -> String -> Html
13compileToHtml :: String -> String -> String -> Html
9compileToHtml libLoc fileName source =
14compileToHtml libLoc fileName source =
10− generateHtml libLoc fileName (compileToJS source)
15+ generateHtml libLoc fileName source