on master help sign in
Add --separate-js and --only-js flags. Improve error messages for missing and conflicting modules.
0bef882evancz
elm/src/Compiler.hs+28−13
@@ -18,8 +18,8 @@ data ELM =
18 ELM { make :: Bool
18 ELM { make :: Bool
19 , files :: [FilePath]
19 , files :: [FilePath]
20 , runtime :: Maybe FilePath
20 , runtime :: Maybe FilePath
21−-- , separate_js :: Bool
21+ , separate_js :: Bool
22−-- , only_js :: Bool
22+ , only_js :: Bool
23-- , verbose_js :: Bool
23-- , verbose_js :: Bool
24 }
24 }
25 deriving (Data,Typeable,Show,Eq)
25 deriving (Data,Typeable,Show,Eq)
@@ -28,8 +28,8 @@ elm = ELM { make = False &= help "automatically compile dependencies."
28 , files = def &= args &= typ "FILES"
28 , files = def &= args &= typ "FILES"
29 , runtime = Nothing &= typ "FILE" &=
29 , runtime = Nothing &= typ "FILE" &=
30 help "Specify a custom location for Elm's runtime system."
30 help "Specify a custom location for Elm's runtime system."
31−-- , separate_js = False &= help "Compile to separate HTML and JS files."
31+ , separate_js = False &= help "Compile to separate HTML and JS files."
32−-- , only_js = False &= help "Compile only to JavaScript."
32+ , only_js = False &= help "Compile only to JavaScript."
33-- , verbose_js = False &= help "Produce JavaScript that may be easier to debug."
33-- , verbose_js = False &= help "Produce JavaScript that may be easier to debug."
34 } &=
34 } &=
35 help "Compile Elm programs to HTML, CSS, and JavaScript." &=
35 help "Compile Elm programs to HTML, CSS, and JavaScript." &=
@@ -40,20 +40,30 @@ main = do
40 mini <- getDataFileName "elm-runtime-0.3.0.js"
40 mini <- getDataFileName "elm-runtime-0.3.0.js"
41 compileArgs mini args
41 compileArgs mini args
42
42
43−compileArgs mini (ELM _ [] _) =
43+compileArgs mini (ELM _ [] _ _ _) =
44 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
44 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
45−compileArgs mini (ELM make files rtLoc) =
45+compileArgs mini (ELM make files rtLoc split only) =
46− mapM_ (fileToHtml $ fromMaybe mini rtLoc) files
46+ mapM_ (fileTo get what $ fromMaybe mini rtLoc) files
47+ where get = if make then getModules [] else getModule
48+ what = if only then JS else
49+ if split then Split else HTML
47
50
51+data What = JS | HTML | Split
52+
48−fileToHtml rtLoc file = do
53+fileTo get what rtLoc file = do
49− ems <- getModules [] file
54+ ems <- get file
50 case ems of
55 case ems of
51 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
56 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
52 Right ms ->
57 Right ms ->
53− let name = reverse . tail . dropWhile (/='.') $ reverse file in
58+ let name = reverse . tail . dropWhile (/='.') $ reverse file
54− writeFile (name ++ ".html") . renderHtml $
59+ js = name ++ ".js"
60+ html = name ++ ".html"
61+ in case what of
62+ JS -> writeFile js $ concatMap jsModule ms
55− modulesToHtml rtLoc ms
63+ HTML -> writeFile html . renderHtml $ modulesToHtml rtLoc ms
56−
64+ Split -> do
65+ writeFile html . renderHtml $ linkedHtml rtLoc js ms
66+ writeFile js $ concatMap jsModule ms
57
67
58getModules :: [String] -> FilePath -> IO (Either String [Module])
68getModules :: [String] -> FilePath -> IO (Either String [Module])
59getModules uses file = do
69getModules uses file = do
@@ -71,6 +81,11 @@ getModules uses file = do
71 [] -> Right $ concat (rights ems) ++ [modul]
81 [] -> Right $ concat (rights ems) ++ [modul]
72 errs -> Left $ intercalate "\n" errs
82 errs -> Left $ intercalate "\n" errs
73
83
84+getModule :: FilePath -> IO (Either String [Module])
85+getModule file = do
86+ code <- readFile file
87+ return . fmap (:[]) $ initialize code
88+
74toFilePath :: String -> FilePath
89toFilePath :: String -> FilePath
75toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
90toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
76
91
elm/src/Gen/CompileToJS.hs+11−5
@@ -41,7 +41,7 @@ tryBlock names e =
41jsModule (Module names exports imports defs) =
41jsModule (Module names exports imports defs) =
42 tryBlock (tail modNames) $ unwords
42 tryBlock (tail modNames) $ unwords
43 [ concatMap (\n -> globalAssign n $ n ++ " || {}") . map (intercalate ".") . drop 2 . inits $ take (length modNames - 1) modNames
43 [ concatMap (\n -> globalAssign n $ n ++ " || {}") . map (intercalate ".") . drop 2 . inits $ take (length modNames - 1) modNames
44− , "\nif (" ++ modName ++ ") throw 'Module name collision, " ++ intercalate "." names ++ " is already defined.'; "
44+ , "\nif (" ++ modName ++ ") throw 'Module name collision, " ++ intercalate "." (tail modNames) ++ " is already defined.'; "
45 , globalAssign modName $ jsFunc "" (includes ++ body ++ export) ++ "()"
45 , globalAssign modName $ jsFunc "" (includes ++ body ++ export) ++ "()"
46 , mainEquals $ modName ++ ".main" ]
46 , mainEquals $ modName ++ ".main" ]
47 where modNames = if null names then ["ElmCode", "Main"] else "ElmCode" : names
47 where modNames = if null names then ["ElmCode", "Main"] else "ElmCode" : names
@@ -55,11 +55,17 @@ jsModule (Module names exports imports defs) =
55 let y = reverse . tail . dropWhile isDigit $ reverse x in
55 let y = reverse . tail . dropWhile isDigit $ reverse x in
56 if y `elem` exps then Just $ y ++ ":" ++ x else Nothing
56 if y `elem` exps then Just $ y ++ ":" ++ x else Nothing
57
57
58+jsImport (modul, how) =
59+ unwords [ "\ntry{" ++ modul ++ "} catch(e) {throw 'Module "
60+ , drop 1 (dropWhile (/='.') modul)
61+ , " is missing. Compile with --make flag or load missing "
62+ , "module in a separate JS file.';}" ] ++ jsImport' (modul, how)
63+
58−jsImport (modul, As name) = assign name modul
64+jsImport' (modul, As name) = assign name modul
59−jsImport (modul, Importing []) = jsImport (modul, Hiding [])
65+jsImport' (modul, Importing []) = jsImport' (modul, Hiding [])
60−jsImport (modul, Importing vs) =
66+jsImport' (modul, Importing vs) =
61 concatMap (\v -> assign v $ modul ++ "." ++ v) vs
67 concatMap (\v -> assign v $ modul ++ "." ++ v) vs
62−jsImport (modul, Hiding vs) =
68+jsImport' (modul, Hiding vs) =
63 unwords [ "\nfor(var i in " ++ modul ++ "){"
69 unwords [ "\nfor(var i in " ++ modul ++ "){"
64 , assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs
70 , assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs
65 , "\nif (hiddenVars.indexOf(i) >= 0) continue;"
71 , "\nif (hiddenVars.indexOf(i) >= 0) continue;"
elm/src/Gen/GenerateHtml.hs+18−8
@@ -1,5 +1,8 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module GenerateHtml (generateHtml, body, css, widgetBody, modulesToHtml) where
2+module GenerateHtml (generateHtml,
3+ body, css, widgetBody,
4+ modulesToHtml, linkedHtml
5+ ) where
3
6
4import Data.List (intercalate)
7import Data.List (intercalate)
5import Text.Blaze (preEscapedToMarkup)
8import Text.Blaze (preEscapedToMarkup)
@@ -23,9 +26,11 @@ css = H.style ! A.type_ "text/css" $ preEscapedToMarkup
23 \a:active {text-decoration: none}\
26 \a:active {text-decoration: none}\
24 \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
27 \a:hover {text-decoration: underline; color: #ff8f12;}" :: String)
25
28
26−makeScript :: String -> H.Html
29+makeScript :: Either String String -> H.Html
30+makeScript (Left s) =
27−makeScript s = H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
31+ H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
28−
32+makeScript (Right s) =
33+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup s
29
34
30-- |This function compiles Elm code into simple HTML.
35-- |This function compiles Elm code into simple HTML.
31--
36--
@@ -38,22 +43,27 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
38 -> Html
43 -> Html
39generateHtml libLoc title source =
44generateHtml libLoc title source =
40 case initialize source of
45 case initialize source of
41− Left err -> createHtml libLoc title (showErr err) (H.noscript "")
46+ Left err -> createHtml libLoc title (Right $ showErr err) (H.noscript "")
42 Right modul -> modulesToHtml libLoc [modul]
47 Right modul -> modulesToHtml libLoc [modul]
43
48
44
49
45modulesToHtml libLoc modules = createHtml libLoc title js noscript
50modulesToHtml libLoc modules = createHtml libLoc title js noscript
46 where title = (\(Module names _ _ _) -> intercalate "." names) $ last modules
51 where title = (\(Module names _ _ _) -> intercalate "." names) $ last modules
47− js = concatMap jsModule modules
52+ js = Right $ concatMap jsModule modules
48 noscript = extract $ last modules
53 noscript = extract $ last modules
49
54
55+linkedHtml rtLoc jsLoc modules =
56+ createHtml rtLoc title (Left jsLoc) (H.noscript "")
57+ where title = (\(Module names _ _ _) -> intercalate "." names) $ last modules
58+
59+
50createHtml libLoc title js noscript =
60createHtml libLoc title js noscript =
51 H.docTypeHtml $ do
61 H.docTypeHtml $ do
52 H.head $ do
62 H.head $ do
53 H.meta ! A.charset "UTF-8"
63 H.meta ! A.charset "UTF-8"
54 H.title . H.toHtml $ title
64 H.title . H.toHtml $ title
55− makeScript libLoc
65+ makeScript (Left libLoc)
56− H.script ! A.type_ "text/javascript" $ preEscapedToMarkup js
66+ makeScript js
57 css
67 css
58 H.body $ body noscript
68 H.body $ body noscript
59
69