git.iko.soy/elk
on master help sign in
Properly resolve cyclic dependencies.
commit43fd6c432681bce37acc782818d2260cf2d47257 authorevancz <info@elm-lang.org> dateFri 8 Feb 2013, 01:33 (14 years ago) parenta8850d6
4 files changed+98−60
compare with master
unifiedsplit
elm/src/Compiler.hs+17−47 elm/src/Gen/GenerateHtml.hs+1−1 elm/src/Initialize.hs+79−11 elm/src/Language/Elm.hs+1−1
elm/src/Compiler.hs+17−47
@@ -53,17 +53,18 @@ main = do
5353compileArgs mini (ELM _ [] _ _ _ _ _ _ _) =
5454 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
5555compileArgs mini (ELM make files rtLoc split only js nscrpt isMini outputDir) =
56− mapM_ (fileTo isMini get what js nscrpt outputDir $ fromMaybe mini rtLoc) files
57− where get = if make then getModules [] else getModule
58− what = if only then JS else
59− if split then Split else HTML
56+ mapM_ (fileTo isMini make what js nscrpt outputDir loc) files
57+ where loc = fromMaybe mini rtLoc
58+ what | only = JS
59+ | split = Split
60+ | otherwise = HTML
6061
6162data What = JS | HTML | Split
6263
63−fileTo isMini get what jsFiles noscript outputDir rtLoc file = do
64− let jsStyle = if isMini then Minified else Readable
65− let formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
66− ems <- get file
64+fileTo isMini make what jsFiles noscript outputDir rtLoc file = do
65+ let jsStyle = if isMini then Minified else Readable
66+ formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
67+ ems <- build make file
6768 jss <- concat `fmap` mapM readFile jsFiles
6869 case ems of
6970 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
@@ -71,43 +72,12 @@ fileTo isMini get what jsFiles noscript outputDir rtLoc file = do
7172 let path = fromMaybe "" outputDir </> file
7273 js = replaceExtension path ".js"
7374 html = replaceExtension path ".html"
75+ pairs = map ((,) (fst ms)) (snd ms)
76+ txt = jss ++ concatMap jsModule pairs
7477 in case what of
75− JS -> writeFile js . formatJS $ jss ++ concatMap jsModule ms
76− HTML -> writeFile html . renderHtml $ modulesToHtml jsStyle "" rtLoc jss noscript ms
77− Split -> do
78− writeFile html . renderHtml $ linkedHtml rtLoc js ms
79− writeFile js . formatJS $ jss ++ concatMap jsModule ms
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− ]
78+ JS -> writeFile js (formatJS txt)
79+ HTML -> writeFile html . renderHtml $
80+ modulesToHtml jsStyle "" rtLoc jss noscript pairs
81+ Split ->
82+ do writeFile html . renderHtml $ linkedHtml rtLoc js pairs
83+ writeFile js (formatJS txt)
elm/src/Gen/GenerateHtml.hs+1−1
@@ -45,7 +45,7 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
4545 -> String -- ^ The elm source code.
4646 -> Html
4747generateHtml libLoc title source =
48− case initialize source of
48+ case buildFromSource source of
4949 Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")
5050 Right (escs, modul) -> modulesToHtml Readable title libLoc [] True [(escs,modul)]
5151
elm/src/Initialize.hs+79−11
@@ -1,10 +1,12 @@
1−module Initialize (initialize) where
1+module Initialize (build,buildFromSource) where
22
33import Control.Applicative ((<$>))
44import Control.Monad.Error
55import Data.List (lookup)
66
77import Ast
8+import Data.Either (lefts,rights)
9+import Data.List (intercalate,partition)
810import Parse.Parser (parseProgram)
911import Rename
1012import Types.Types ((-:))
@@ -13,15 +15,81 @@ import Types.Unify
1315import Types.Alias
1416import Optimize
1517
16−initialize :: String -> Either String ([String], Module)
17−initialize str = do
18− Module name ex im stmts <- parseProgram str
18+checkMistakes :: Module -> Either String Module
19+checkMistakes modul@(Module name ex im stmts) =
1920 case mistakes stmts of
2021 m:ms -> Left (unlines (m:ms))
21− [] -> let stmts' = dealias stmts
22− modul = Module name ex im stmts'
23− in do (escapees, subs) <- unify hints modul
24− let im' | any ((=="Prelude") . fst) im = im
25− | otherwise = ("Prelude", Hiding []) : im
26− modul' = optimize . renameModule $ Module name ex im' stmts'
27− subs `seq` return (escapees, modul')
22+ [] -> return modul
23+
24+checkTypes :: Module -> Either String ([String], Module)
25+checkTypes (Module name ex im stmts) =
26+ let stmts' = dealias stmts
27+ modul = Module name ex im stmts'
28+ in do (escapees, subs) <- unify hints modul
29+ let im' | any ((=="Prelude") . fst) im = im
30+ | otherwise = ("Prelude", Hiding []) : im
31+ modul' = optimize . renameModule $ Module name ex im' stmts'
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
7777-- build helper to avoid boilerplate repetition
7878toPartsHelper :: String -> (Html, Html, String)
7979toPartsHelper source = (html, css, js)
80− where modul = initialize source
80+ where modul = buildFromSource source
8181 js = either showErr jsModule modul
8282 html = widgetBody $ either id (extractNoscript . snd) modul