git.iko.soy/elk
on master help sign in
Properly resolve cyclic dependencies.
43fd6c4evancz
elm/src/Compiler.hs+17−47
compare with master
unifiedsplit
@@ -53,17 +53,18 @@ main = do
53compileArgs mini (ELM _ [] _ _ _ _ _ _ _) =
53compileArgs mini (ELM _ [] _ _ _ _ _ _ _) =
54 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
54 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
55compileArgs mini (ELM make files rtLoc split only js nscrpt isMini outputDir) =
55compileArgs mini (ELM make files rtLoc split only js nscrpt isMini outputDir) =
56− mapM_ (fileTo isMini get what js nscrpt outputDir $ fromMaybe mini rtLoc) files
56+ mapM_ (fileTo isMini make what js nscrpt outputDir loc) files
57− where get = if make then getModules [] else getModule
57+ where loc = fromMaybe mini rtLoc
58− what = if only then JS else
58+ what | only = JS
59− if split then Split else HTML
59+ | split = Split
60+ | otherwise = HTML
60
61
61data What = JS | HTML | Split
62data What = JS | HTML | Split
62
63
63−fileTo isMini get what jsFiles noscript outputDir rtLoc file = do
64+fileTo isMini make what jsFiles noscript outputDir rtLoc file = do
64− let jsStyle = if isMini then Minified else Readable
65+ let jsStyle = if isMini then Minified else Readable
65− let formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
66+ formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
66− ems <- get file
67+ ems <- build make file
67 jss <- concat `fmap` mapM readFile jsFiles
68 jss <- concat `fmap` mapM readFile jsFiles
68 case ems of
69 case ems of
69 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
70 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
@@ -71,43 +72,12 @@ fileTo isMini get what jsFiles noscript outputDir rtLoc file = do
71 let path = fromMaybe "" outputDir </> file
72 let path = fromMaybe "" outputDir </> file
72 js = replaceExtension path ".js"
73 js = replaceExtension path ".js"
73 html = replaceExtension path ".html"
74 html = replaceExtension path ".html"
75+ pairs = map ((,) (fst ms)) (snd ms)
76+ txt = jss ++ concatMap jsModule pairs
74 in case what of
77 in case what of
75− JS -> writeFile js . formatJS $ jss ++ concatMap jsModule ms
78+ JS -> writeFile js (formatJS txt)
79+ HTML -> writeFile html . renderHtml $
76− HTML -> writeFile html . renderHtml $ modulesToHtml jsStyle "" rtLoc jss noscript ms
80+ modulesToHtml jsStyle "" rtLoc jss noscript pairs
77− Split -> do
81+ Split ->
78− writeFile html . renderHtml $ linkedHtml rtLoc js ms
82+ do writeFile html . renderHtml $ linkedHtml rtLoc js pairs
79− writeFile js . formatJS $ jss ++ concatMap jsModule ms
83+ writeFile js (formatJS txt)
80−
81−getModules :: [String] -> FilePath -> IO (Either String [([String],Module)])
82−getModules uses file = do
83− code <- readFile file
84− case initialize code of
85− Left err -> return . Left $ "Error in " ++ file ++ ":\n" ++ err
86− Right (escs, modul@(Module _ _ imports _)) ->
87− let imps = filter (`notElem` builtInModules) $ map fst imports in
88− case intersect uses imps of
89− x:_ -> return . Left $ "Error: Cyclic dependency. Module " ++
90− x ++ " depends on itself."
91− [] -> do
92− ems <- mapM (getModules (uses ++ imps) . toFilePath) imps
93− return $ case lefts ems of
94− [] -> Right $ concat (rights ems) ++ [(escs,modul)]
95− errs -> Left $ intercalate "\n" errs
96−
97−getModule :: FilePath -> IO (Either String [([String],Module)])
98−getModule file = do
99− code <- readFile file
100− return . fmap (:[]) $ initialize code
101−
102−toFilePath :: String -> FilePath
103−toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
104−
105−builtInModules =
106− concat [ [ "List", "Char", "Either", "Maybe"
107− , "Dict", "Set", "Automaton", "Date" ]
108− , [ "Signal", "Mouse", "Keyboard.Raw", "Keyboard",
109− , "Touch", "WebSocket", "Window", "Time", "HTTP", "Input", "Random" ]
110− , [ "Graphics", "Text", "Color" ]
111− , map ("JavaScript"++) [ "", ".Experimental" ]
112− , [ "Prelude", "JSON" ]
113− ]
elm/src/Gen/GenerateHtml.hs+1−1
@@ -45,7 +45,7 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
45 -> String -- ^ The elm source code.
45 -> String -- ^ The elm source code.
46 -> Html
46 -> Html
47generateHtml libLoc title source =
47generateHtml libLoc title source =
48− case initialize source of
48+ case buildFromSource source of
49 Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")
49 Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")
50 Right (escs, modul) -> modulesToHtml Readable title libLoc [] True [(escs,modul)]
50 Right (escs, modul) -> modulesToHtml Readable title libLoc [] True [(escs,modul)]
51
51
elm/src/Initialize.hs+79−11
@@ -1,10 +1,12 @@
1−module Initialize (initialize) where
1+module Initialize (build,buildFromSource) where
2
2
3import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
4import Control.Monad.Error
4import Control.Monad.Error
5import Data.List (lookup)
5import Data.List (lookup)
6
6
7import Ast
7import Ast
8+import Data.Either (lefts,rights)
9+import Data.List (intercalate,partition)
8import Parse.Parser (parseProgram)
10import Parse.Parser (parseProgram)
9import Rename
11import Rename
10import Types.Types ((-:))
12import Types.Types ((-:))
@@ -13,15 +15,81 @@ import Types.Unify
13import Types.Alias
15import Types.Alias
14import Optimize
16import Optimize
15
17
16−initialize :: String -> Either String ([String], Module)
18+checkMistakes :: Module -> Either String Module
17−initialize str = do
18− Module name ex im stmts <- parseProgram str
19+checkMistakes modul@(Module name ex im stmts) =
19 case mistakes stmts of
20 case mistakes stmts of
20 m:ms -> Left (unlines (m:ms))
21 m:ms -> Left (unlines (m:ms))
22+ [] -> return modul
23+
24+checkTypes :: Module -> Either String ([String], Module)
25+checkTypes (Module name ex im stmts) =
21− [] -> let stmts' = dealias stmts
26+ let stmts' = dealias stmts
22− modul = Module name ex im stmts'
27+ modul = Module name ex im stmts'
23− in do (escapees, subs) <- unify hints modul
28+ in do (escapees, subs) <- unify hints modul
24− let im' | any ((=="Prelude") . fst) im = im
29+ let im' | any ((=="Prelude") . fst) im = im
25− | otherwise = ("Prelude", Hiding []) : im
30+ | otherwise = ("Prelude", Hiding []) : im
26− modul' = optimize . renameModule $ Module name ex im' stmts'
31+ modul' = optimize . renameModule $ Module name ex im' stmts'
27− subs `seq` return (escapees, modul')
32+ subs `seq` return (escapees, modul')
33+
34+check :: Module -> Either String ([String], Module)
35+check = checkMistakes >=> checkTypes
36+
37+buildFromSource :: String -> Either String ([String],Module)
38+buildFromSource = parseProgram >=> check
39+
40+build :: Bool -> FilePath -> IO (Either String ([String],[Module]))
41+build make root = do
42+ proj <- parse make root
43+ return $ do
44+ ms <- proj
45+ (escapeess, modules) <- unzip `liftM` mapM check ms
46+ sortedModules <- (if make then sort else return) modules
47+ return (concat escapeess, sortedModules)
48+
49+parse :: Bool -> FilePath -> IO (Either String [Module])
50+parse make root = parseProject [] make root
51+
52+parseProject :: [FilePath] -> Bool -> FilePath -> IO (Either String [Module])
53+parseProject seen make root = do
54+ txt <- readFile root
55+ case parseProgram txt of
56+ Left err -> return (Left err)
57+ Right modul@(Module names exs ims stmts) ->
58+ let allDeps = map toFilePath (getDeps modul)
59+ newDeps = if make then filter (`notElem` seen) allDeps else []
60+ name = intercalate "." names
61+ in do ps <- mapM (parseProject (name : seen ++ newDeps) make) newDeps
62+ return $ case unlines (lefts ps) of
63+ c:cs -> Left (c:cs)
64+ _ -> Right (modul : concat (rights ps))
65+
66+toFilePath :: String -> FilePath
67+toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
68+
69+getDeps :: Module -> [String]
70+getDeps (Module _ _ is _) = filter (`notElem` builtInModules) (map fst is)
71+ where
72+ builtInModules =
73+ ["List","Char","Either","Maybe","Dict","Set","Automaton","Date",
74+ "Signal","Mouse","Keyboard.Raw","Keyboard","Touch",
75+ "WebSocket","Window","Time","HTTP","Input","Random",
76+ "Graphics","Text","Color","JavaScript",
77+ "JavaScript.Experimental","Prelude","JSON"]
78+
79+
80+sort :: [Module] -> Either String [Module]
81+sort = go []
82+ where
83+ msg = "A cyclical or missing module dependency or was detected in: "
84+ getName (Module names _ _ _) = intercalate "." names
85+
86+ has name modul = name == getName modul
87+ within ms name = any (has name) ms
88+
89+ go :: [Module] -> [Module] -> Either String [Module]
90+ go sorted [] = Right sorted
91+ go sorted unsorted =
92+ case partition (all (within sorted) . getDeps) unsorted of
93+ ([],m:ms) -> Left (msg ++ intercalate ", " (map getName (m:ms)))
94+ (srtd,unsrtd) -> go (sorted ++ srtd) unsrtd
95+
elm/src/Language/Elm.hs+1−1
@@ -77,6 +77,6 @@ instance ElmSource (t -> Elm) where
77-- build helper to avoid boilerplate repetition
77-- build helper to avoid boilerplate repetition
78toPartsHelper :: String -> (Html, Html, String)
78toPartsHelper :: String -> (Html, Html, String)
79toPartsHelper source = (html, css, js)
79toPartsHelper source = (html, css, js)
80− where modul = initialize source
80+ where modul = buildFromSource source
81 js = either showErr jsModule modul
81 js = either showErr jsModule modul
82 html = widgetBody $ either id (extractNoscript . snd) modul
82 html = widgetBody $ either id (extractNoscript . snd) modul