git.iko.soy/elk
on d9d1dfd help sign in
elk/elm/src/Initialize.hs
95 lines 3.4 kB history raw
1module Initialize (build,buildFromSource) where
3import Control.Applicative ((<$>))
4import Control.Monad.Error
5import Data.List (lookup)
7import Ast
8import Data.Either (lefts,rights)
9import Data.List (intercalate,partition)
10import Parse.Parser (parseProgram)
11import Rename
12import Types.Types ((-:))
13import Types.Hints (hints)
14import Types.Unify
15import Types.Alias
16import Optimize
18checkMistakes :: Module -> Either String Module
19checkMistakes modul@(Module name ex im stmts) =
20 case mistakes stmts of
21 m:ms -> Left (unlines (m:ms))
22 [] -> return modul
24checkTypes :: Module -> Either String ([String], Module)
25checkTypes (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')
34check :: Module -> Either String ([String], Module)
35check = checkMistakes >=> checkTypes
37buildFromSource :: String -> Either String ([String],Module)
38buildFromSource = parseProgram >=> check
40build :: Bool -> FilePath -> IO (Either String ([String],[Module]))
41build 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)
49parse :: Bool -> FilePath -> IO (Either String [Module])
50parse make root = parseProject [] make root
52parseProject :: [FilePath] -> Bool -> FilePath -> IO (Either String [Module])
53parseProject 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))
66toFilePath :: String -> FilePath
67toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
69getDeps :: Module -> [String]
70getDeps (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"]
80sort :: [Module] -> Either String [Module]
81sort = go []
82 where
83 msg = "A cyclical or missing module dependency or was detected in: "
84 getName (Module names _ _ _) = intercalate "." names
86 has name modul = name == getName modul
87 within ms name = any (has name) ms
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