yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Expose fewer internal functions, making more information available only through toHtml :: String -> Html and toParts :: String -> (Html, String, String). Make the required changes to dependent files. Yesod.hs still needs one fix though.

Browse source
This commit is contained in:
evancz 2012-05-29 13:25:43 -05:00
parent 1600aae698
commit a6cf0d2815
11 changed files with 234 additions and 236 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
elm-server/Server.hs
View file

@ -7,7 +7,7 @@ import Data.List (isPrefixOf, isSuffixOf)
import Happstack.Server
import Happstack.Server.Compression
import System.Environment
import Language.Elm
import qualified Language.Elm as Elm
serve :: String -> IO ()
serve libLoc = do
@ -25,7 +25,7 @@ serveElm libLoc fp = do
let ('/':path) = fp
guard (".elm" `isSuffixOf` path)
content <- liftIO (readFile path)
ok . toResponse $ generateHtml libLoc (pageTitle path) content
ok . toResponse $ Elm.toHtml libLoc (pageTitle path) content
main = getArgs >>= parse

4
elm-server/elm-server.cabal
View file

@ -1,5 +1,5 @@
Name: Elm-server
Version: 0.1.1.8
Version: 0.1.2
Synopsis: The Elm language server.
Description: This package provides a standalone, Happstack-based Elm server.
@ -35,4 +35,4 @@ Executable elm-server
HTTP >= 4000,
happstack-server == 7.0.2,
deepseq,
Elm >= 0.1.1.8
Elm >= 0.1.2

42
elm-yesod/Language/Elm/Yesod.hs
View file

@ -15,42 +15,22 @@
A full example implementation is provided in the examples folder of the Elm github repository.
-}
module Language.Elm.Yesod (generateWidget) where
module Language.Elm.Yesod (toWidget) where
import Text.Blaze (preEscapedToMarkup)
import Text.Hamlet
import Text.Julius
import Text.Lucius
import Text.Cassius
import Yesod.Widget
import Language.Elm
import Language.Elm.Initialize
import Language.Elm.CompileToJS
import Language.Elm.ExtractNoscript
css = [lucius|
* { padding:0; margin:0;
hyphens: auto; -moz-hyphens: auto;
-webkit-hyphens: auto; -ms-hyphens: auto;}
body { font-family: Arial; }
a:link, a:visited, a:active { text-decoration: none}
a:hover {text-decoration: underline; color: #ff8f12;}
|]
-- |generateWidget takes some Elm code in String format and produces a widget. Usage example:
-- |toWidget takes some Elm code in String format and produces a widget. Usage example:
--
-- > generateWidget [elmFile|elm-source/somePage.elm|]
generateWidget :: String -- ^ The Elm source code
-> GWidget sub master ()
generateWidget source =
let expr = initialize source
js = compileToJS expr
noscript = either id extract expr
in do toWidgetHead css
-- > toWidget [elmFile|elm-source/somePage.elm|]
toWidget :: String -- ^ The Elm source code
-> GWidget sub master ()
toWidget source =
let (html, css, js) = toParts source
in do toWidgetHead [cassius| css |]
toWidgetHead [julius| #{js} |]
[whamlet|
<div #widthChecker style="width:100%; height:1px; position:absolute; top:-1px;">
<span #content>
<script type="text/javascript">
Dispatcher.initialize()
<noscript>^{preEscapedToMarkup noscript}
|]
[whamlet| ^{html} |]

4
elm-yesod/elm-yesod.cabal
View file

@ -1,5 +1,5 @@
Name: Elm-yesod
Version: 0.1.1.8
Version: 0.1.2
Synopsis: The Elm language Yesod compatibility module.
Description: This module provides a simple function to embed Elm code
as a Yesod widget.
@ -28,7 +28,7 @@ Library
exposed-modules: Language.Elm.Yesod
Build-depends: base >=4.2 && <5,
blaze-markup == 0.5.*,
Elm >= 0.1.1.8,
Elm >= 0.1.2,
yesod-core >= 1,
hamlet,
shakespeare-css,

45
elm/Elm.cabal
View file

@ -22,34 +22,37 @@ Category: Compiler, Language
Build-type: Simple
Extra-source-files: README.md
Cabal-version: >=1.6
Cabal-version: >=1.8
source-repository head
type: git
location: git://github.com/evancz/Elm.git
Executable elm
-- .hs or .lhs file containing the Main module.
Main-is: Compiler.hs
Hs-Source-Dirs: src, src/Parse, src/Types, src/Language
Library
exposed-modules: Language.Elm
ghc-options: -O2
Hs-Source-Dirs: src, src/Parse, src/Types
other-modules: Ast,
CompileToJS,
ExtractNoscript,
GenerateHtml,
Guid,
Initialize,
Rename,
Binop,
Combinators,
Constrain,
Guid,
Hints,
Lexer,
ParsePatterns,
Parser,
ParserLib,
ParseTypes,
Rename,
Tokens,
Types,
Constrain,
Hints,
Types,
Unify
ghc-options: -O2
Build-depends: base >=4.2 && <5,
containers >= 0.3,
transformers >= 0.2,
@ -59,16 +62,16 @@ Executable elm
blaze-markup == 0.5.1.*,
deepseq
Library
exposed-modules: Language.Elm,
Language.Elm.CompileToJS,
Language.Elm.ExtractNoscript,
Language.Elm.Initialize,
Language.Elm.GenerateHtml,
Language.Elm.Quasi
Executable elm
Main-is: Compiler.hs
ghc-options: -O2
Hs-Source-Dirs: src, src/Parse, src/Types
other-modules: Ast,
CompileToJS,
ExtractNoscript,
GenerateHtml,
Guid,
Initialize,
Rename,
Binop,
Combinators,
@ -91,8 +94,4 @@ Library
parsec >= 3.1.1,
blaze-html == 0.5.0.*,
blaze-markup == 0.5.1.*,
deepseq,
template-haskell,
haskell-src-meta == 0.5.*,
text,
attoparsec == 0.10.*
deepseq

4
elm/src/Language/Elm/CompileToJS.hs → elm/src/CompileToJS.hs
View file

@ -1,5 +1,5 @@
module Language.Elm.CompileToJS (compile, compileToJS) where
module CompileToJS (compile, compileToJS) where
import Ast
import Control.Monad (liftM,(<=<),join)
@ -7,7 +7,7 @@ import Data.Char (isAlpha)
import Data.List (intercalate,sortBy)
import Data.Map (toList)
import Language.Elm.Initialize
import Initialize
compile = (return . addMain . toJS) <=< initialize

4
elm/src/Compiler.hs
View file

@ -1,8 +1,8 @@
module Main where
import Data.List (isPrefixOf)
import Language.Elm.CompileToJS
import Language.Elm.GenerateHtml
import CompileToJS
import GenerateHtml
import System.Environment
import Text.Blaze.Html.Renderer.String (renderHtml)

2
elm/src/Language/Elm/ExtractNoscript.hs → elm/src/ExtractNoscript.hs
View file

@ -1,5 +1,5 @@
module Language.Elm.ExtractNoscript (extract) where
module ExtractNoscript (extract) where
import Ast

105
elm/src/Language/Elm/GenerateHtml.hs → elm/src/GenerateHtml.hs
View file

@ -1,52 +1,53 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.Elm.GenerateHtml (generateHtml) where
import Text.Blaze (preEscapedToMarkup)
import Text.Blaze.Html (Html)
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5.Attributes as A
import Language.Elm.Initialize
import Language.Elm.CompileToJS
import Language.Elm.ExtractNoscript
css = preEscapedToMarkup $
("* { padding:0; margin:0; \
\hyphens: auto; -moz-hyphens: auto;\
\ -webkit-hyphens: auto; -ms-hyphens: auto; }\
\body { font-family: Arial; }\
\a:link {text-decoration: none}\
\a:visited {text-decoration: none}\
\a:active {text-decoration: none}\
\a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
makeScript :: String -> H.Html
makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
-- |This function compiles Elm code into simple HTML.
--
-- Usage example:
--
-- > generateHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]
generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
-> String -- ^ The page title
-> String -- ^ The elm source code.
-> Html
generateHtml libLoc title source =
let expr = initialize source
js = compileToJS expr
noscript = either id extract expr
in
H.docTypeHtml $ do
H.head $ do
H.meta ! A.charset "UTF-8"
H.title . H.toHtml $ title
makeScript libLoc
H.script ! A.type_ "text/javascript" $ preEscapedToMarkup js
H.style ! A.type_ "text/css" $ css
H.body $ do
H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
H.span ! A.id "content" $ ""
H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
H.noscript $ preEscapedToMarkup noscript
{-# LANGUAGE OverloadedStrings #-}
module GenerateHtml (generateHtml, body, css) where
import Text.Blaze (preEscapedToMarkup)
import Text.Blaze.Html (Html)
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5.Attributes as A
import Initialize
import CompileToJS
import ExtractNoscript
css = "* { padding:0; margin:0; \
\hyphens: auto; -moz-hyphens: auto;\
\ -webkit-hyphens: auto; -ms-hyphens: auto; }\
\body { font-family: Arial; }\
\a:link {text-decoration: none}\
\a:visited {text-decoration: none}\
\a:active {text-decoration: none}\
\a:hover {text-decoration: underline; color: #ff8f12;}"
makeScript :: String -> H.Html
makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
-- |This function compiles Elm code into simple HTML.
--
-- Usage example:
--
-- > generateHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]
generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
-> String -- ^ The page title
-> String -- ^ The elm source code.
-> Html
generateHtml libLoc title source =
let expr = initialize source
js = compileToJS expr
noscript = either id extract expr
in
H.docTypeHtml $ do
H.head $ do
H.meta ! A.charset "UTF-8"
H.title . H.toHtml $ title
makeScript libLoc
H.script ! A.type_ "text/javascript" $ preEscapedToMarkup js
H.style ! A.type_ "text/css" $ preEscapedToMarkup (css :: String)
H.body $ body noscript
body noscript = do
H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
H.span ! A.id "content" $ ""
H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"
H.noscript $ preEscapedToMarkup noscript

212
elm/src/Language/Elm/Initialize.hs → elm/src/Initialize.hs
View file

@ -1,107 +1,107 @@
module Language.Elm.Initialize (initialize) where
import Ast
import Control.Arrow (first, second)
import Control.Monad
import Data.Char (isAlpha)
import Data.Maybe (mapMaybe)
import Data.Either (rights)
import Lexer
import Parser (toExpr,toDefs)
import Rename (rename)
import Unify
import Hints
{--
initialize str = do
(expr, hints') <- toDefs =<< tokenize str
let expr' = rename expr
subs <- unify (liftM2 (++) hints hints') expr'
return (seq subs expr')
--}
initialize str = do
(expr, hints') <- toDefs =<< tokenize str
let expr' = rename expr
subs <- unify (liftM2 (++) hints hints') expr'
let init = simp_loop expr'
return (seq subs init)
simp_loop exp = if exp == exp' then exp' else simp_loop exp'
where exp' = simp exp
simp expr =
let f = simp in
case expr of
Range e1 e2 -> Range (f e1) (f e2)
Binop op e1 e2 -> simp_binop op (f e1) (f e2)
Lambda x e -> Lambda x (f e)
App e1 e2 -> App (f e1) (f e2)
If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
Let defs e -> Let (map (second f) defs) (f e)
Data name es -> Data name (map f es)
Case e cases -> Case (f e) (map (second f) cases)
_ -> expr
simp_if (Boolean b) e2 e3 = if b then e2 else e3
simp_if a b c = If a b c
simp_binop "mod" (Number n) (Number m) = Number (mod n m)
simp_binop "mod" e1 e2 = Binop "mod" e1 e2
simp_binop str e1 e2
| isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2
| otherwise = binop str e1 e2
binop op (Number n) (Number m) = f n m
where f a b = case op of
{ "+" -> Number $ (+) a b
; "-" -> Number $ (-) a b
; "*" -> Number $ (*) a b
--; "/" -> Number $ div a b
; "<" -> Boolean $ a < b
; ">" -> Boolean $ a < b
; "<=" -> Boolean $ a <= b
; ">=" -> Boolean $ a >= b
; "==" -> Boolean $ a == b
; "/=" -> Boolean $ a /= b
; _ -> Binop op (Number n) (Number m) }
binop "-" e (Number 0) = e
binop "+" (Number 0) e = e
binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e
binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e
binop "/" e (Number 1) = e
binop "*" (Number 0) e = Number 0
binop "*" (Number 1) e = e
binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e
binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e
binop "+" e (Number n) = binop "+" (Number n) e
binop "*" e (Number n) = binop "*" (Number n) e
binop op (Boolean n) (Boolean m) = f n m
where f a b = case op of { "&&" -> Boolean $ (&&) n m
; "||" -> Boolean $ (||) n m
; _ -> Binop op (Boolean n) (Boolean m) }
binop "&&" (Boolean True) e = e
binop "&&" (Boolean False) e = Boolean False
binop "||" (Boolean True) e = Boolean True
binop "||" (Boolean False) e = e
binop op e (Boolean n) = binop op (Boolean n) e
binop ":" h t = cons h t
binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
binop "++" (Data "Nil" []) e = e
binop "++" e (Data "Nil" []) = e
binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
binop "$" e1 e2 = App e1 e2
binop op e1 e2 = Binop op e1 e2
module Initialize (initialize) where
import Ast
import Control.Arrow (first, second)
import Control.Monad
import Data.Char (isAlpha)
import Data.Maybe (mapMaybe)
import Data.Either (rights)
import Lexer
import Parser (toExpr,toDefs)
import Rename (rename)
import Unify
import Hints
{--
initialize str = do
(expr, hints') <- toDefs =<< tokenize str
let expr' = rename expr
subs <- unify (liftM2 (++) hints hints') expr'
return (seq subs expr')
--}
initialize str = do
(expr, hints') <- toDefs =<< tokenize str
let expr' = rename expr
subs <- unify (liftM2 (++) hints hints') expr'
let init = simp_loop expr'
return (seq subs init)
simp_loop exp = if exp == exp' then exp' else simp_loop exp'
where exp' = simp exp
simp expr =
let f = simp in
case expr of
Range e1 e2 -> Range (f e1) (f e2)
Binop op e1 e2 -> simp_binop op (f e1) (f e2)
Lambda x e -> Lambda x (f e)
App e1 e2 -> App (f e1) (f e2)
If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
Let defs e -> Let (map (second f) defs) (f e)
Data name es -> Data name (map f es)
Case e cases -> Case (f e) (map (second f) cases)
_ -> expr
simp_if (Boolean b) e2 e3 = if b then e2 else e3
simp_if a b c = If a b c
simp_binop "mod" (Number n) (Number m) = Number (mod n m)
simp_binop "mod" e1 e2 = Binop "mod" e1 e2
simp_binop str e1 e2
| isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2
| otherwise = binop str e1 e2
binop op (Number n) (Number m) = f n m
where f a b = case op of
{ "+" -> Number $ (+) a b
; "-" -> Number $ (-) a b
; "*" -> Number $ (*) a b
--; "/" -> Number $ div a b
; "<" -> Boolean $ a < b
; ">" -> Boolean $ a < b
; "<=" -> Boolean $ a <= b
; ">=" -> Boolean $ a >= b
; "==" -> Boolean $ a == b
; "/=" -> Boolean $ a /= b
; _ -> Binop op (Number n) (Number m) }
binop "-" e (Number 0) = e
binop "+" (Number 0) e = e
binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e
binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e
binop "/" e (Number 1) = e
binop "*" (Number 0) e = Number 0
binop "*" (Number 1) e = e
binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e
binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e
binop "+" e (Number n) = binop "+" (Number n) e
binop "*" e (Number n) = binop "*" (Number n) e
binop op (Boolean n) (Boolean m) = f n m
where f a b = case op of { "&&" -> Boolean $ (&&) n m
; "||" -> Boolean $ (||) n m
; _ -> Binop op (Boolean n) (Boolean m) }
binop "&&" (Boolean True) e = e
binop "&&" (Boolean False) e = Boolean False
binop "||" (Boolean True) e = Boolean True
binop "||" (Boolean False) e = e
binop op e (Boolean n) = binop op (Boolean n) e
binop ":" h t = cons h t
binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
binop "++" (Data "Nil" []) e = e
binop "++" e (Data "Nil" []) = e
binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
binop "$" e1 e2 = App e1 e2
binop op e1 e2 = Binop op e1 e2
--}

44
elm/src/Language/Elm.hs
View file

@ -1,21 +1,39 @@
{- | This module re-exports the modules necessary for compiling Elm code into the
{- | This module exports the functions necessary for compiling Elm code into the
respective HTML, JS and CSS code.
It also provides a predefined generateHtml function for use with the Blaze markup library
It also provides a predefined compileToHtml function for use with the Blaze markup library
as well as a simple QuasiQuoter for embedding literal elm code in a Haskell file.
The documentation for the Elm language is available at <http://elm-lang.org/Documentation.elm>
-}
module Language.Elm (
module Language.Elm.Initialize,
module Language.Elm.CompileToJS,
module Language.Elm.ExtractNoscript,
generateHtml,
elm,
elmFile) where
toHtml,
toParts) where
import Language.Elm.CompileToJS
import Language.Elm.ExtractNoscript
import Language.Elm.Initialize
import Language.Elm.GenerateHtml
import Language.Elm.Quasi
import CompileToJS
import ExtractNoscript
import GenerateHtml
import Initialize
import Text.Blaze.Html (Html)
-- |This function compiles Elm code into a full HTML page.
--
-- Usage example:
--
-- > toHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]
toHtml :: String -- ^ Location of elm-min.js as expected by the browser
-> String -- ^ The page title
-> String -- ^ The elm source code.
-> Html
toHtml = generateHtml
-- |This function compiles Elm code to three separate parts: HTML, CSS,
-- and JavaScript. The HTML is only the contents of the body, so the three
-- parts must be combined in a basic HTML skeleton.
toParts :: String -- ^ The Elm source code.
-> (Html, String, String) -- ^ HTML, CSS, and JavaScript in that order.
toParts source = (html, css, js)
where expr = initialize source
js = compileToJS expr
html = body $ either id extract expr