git.iko.soy/elk
on master help sign in
Enable generation of noscript tags.

For better indexing (for Google! Bing is actually fine...)

commit89605b15aa75e6837adf5e98491f88ae16e3c444 authorevancz <info@elm-lang.org> dateSun 27 May 2012, 16:10 (14 years ago) parent4546c0b
4 files changed+71−74
compare with master
unifiedsplit
src/CompileToJS.hs+1−1 src/ExtractNoscript.hs+21−38 src/GenerateHtml.hs+42−33 src/Language/Elm.hs+7−2
src/CompileToJS.hs+1−1
@@ -11,7 +11,7 @@ import Initialize
1111
1212
1313compile = (return . addMain . toJS) <=< initialize
14−compileToJS = addMain . either (\err -> "text('"++err++"')") toJS . initialize
14+compileToJS = addMain . either (\err -> "text('"++err++"')") toJS
1515addMain body = "function main(){return " ++ body ++ ";}"
1616
1717parens = ("("++) . (++")")
src/ExtractNoscript.hs+21−38
@@ -2,42 +2,25 @@
22module ExtractNoscript (extract) where
33
44import Ast
5−import Data.List (isPrefixOf)
65
7−extract = extract'
8−
9−extract' expr = makeLinks terms where
10− terms =
11− case expr of
12− Number _ -> []
13− Chr _ -> []
14− Boolean _ -> []
15− Range _ _ -> []
16− Access _ _ -> []
17− Binop op e1 e2 -> case (op, extract' e1, extract' e2) of
18− ("++", [s1], [s2]) -> [ s1 ++ s2 ]
19− (_ , ss1 , ss2 ) -> ss1 ++ ss2
20− Lambda v e -> extract' e
21− App e1 e2 -> extract' e1 ++ extract' e2
22− If eb et ef -> extract' et ++ extract' 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
28− Var _ -> []
29− Case e cases -> concatMap (extract' . snd) cases
30− Data _ _ -> [toString expr]
31−
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]
6+extract = concatMap (\s -> "<p>" ++ s ++ "</p>") . extract'
7+
8+extract' expr =
9+ let f = extract' in
10+ case expr of
11+ Str s -> [s]
12+ Binop op e1 e2 -> case (op, f e1, f e2) of
13+ ("++", [s1], [s2]) -> [s1 ++ s2]
14+ (_ , ss1 , ss2 ) -> ss1 ++ ss2
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
20+ App e1 e2 -> f e1 ++ f e2
21+ If eb et ef -> f et ++ f ef
22+ Let defs e -> concatMap (f . snd) defs ++ f e
23+ Var _ -> []
24+ Case e cases -> concatMap (f . snd) cases
25+ Data _ es -> concatMap f es
26+ _ -> []
src/GenerateHtml.hs+42−33
@@ -1,33 +1,42 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module GenerateHtml (generateHtml) where
3−
4−import Text.Blaze (preEscapedToMarkup)
5−import qualified Text.Blaze.Html5 as H
6−import Text.Blaze.Html5 ((!))
7−import qualified Text.Blaze.Html5.Attributes as A
8−
9−css = preEscapedToMarkup $
10− ("* { padding:0; margin:0; \
11− \hyphens: auto; -moz-hyphens: auto;\
12− \ -webkit-hyphens: auto; -ms-hyphens: auto; }\
13− \body { font-family: Arial; }\
14− \a:link {text-decoration: none}\
15− \a:visited {text-decoration: none}\
16− \a:active {text-decoration: none}\
17− \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
18−
19−makeScript :: String -> H.Html
20−makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
21−
22−generateHtml libLoc title source =
23− H.docTypeHtml $ do
24− H.head $ do
25− H.meta ! A.charset "UTF-8"
26− H.title . H.toHtml $ title
27− makeScript libLoc
28− (H.script ! A.type_ "text/javascript") . preEscapedToMarkup $ source
29− H.style ! A.type_ "text/css" $ css
30− H.body $ do
31− H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
32− H.span ! A.id "content" $ ""
33− H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
1+{-# LANGUAGE OverloadedStrings #-}
2+module GenerateHtml (generateHtml) where
3+
4+import Text.Blaze (preEscapedToMarkup)
5+import qualified Text.Blaze.Html5 as H
6+import Text.Blaze.Html5 ((!))
7+import qualified Text.Blaze.Html5.Attributes as A
8+
9+import Initialize
10+import CompileToJS
11+import ExtractNoscript
12+
13+css = preEscapedToMarkup $
14+ ("* { padding:0; margin:0; \
15+ \hyphens: auto; -moz-hyphens: auto;\
16+ \ -webkit-hyphens: auto; -ms-hyphens: auto; }\
17+ \body { font-family: Arial; }\
18+ \a:link {text-decoration: none}\
19+ \a:visited {text-decoration: none}\
20+ \a:active {text-decoration: none}\
21+ \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
22+
23+makeScript :: String -> H.Html
24+makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
25+
26+generateHtml libLoc title source =
27+ let expr = initialize source
28+ js = compileToJS expr
29+ noscript = either id extract expr
30+ in
31+ H.docTypeHtml $ do
32+ H.head $ do
33+ H.meta ! A.charset "UTF-8"
34+ H.title . H.toHtml $ title
35+ makeScript libLoc
36+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup js
37+ H.style ! A.type_ "text/css" $ css
38+ H.body $ do
39+ H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
40+ H.span ! A.id "content" $ ""
41+ H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
42+ H.noscript $ preEscapedToMarkup noscript
src/Language/Elm.hs+7−2
@@ -1,10 +1,15 @@
11
22module Language.Elm where
33
4−import CompileToJS
54import GenerateHtml
65import Text.Blaze.Html (Html)
76
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+
813compileToHtml :: String -> String -> String -> Html
914compileToHtml libLoc fileName source =
10− generateHtml libLoc fileName (compileToJS source)
15+ generateHtml libLoc fileName source