git.iko.soy/elk
on master help sign in
Merge https://github.com/evancz/Elm
1c918a7Vladimir Bychkovsky
core-elm/Dict.elm+1−1
compare with master
unifiedsplit
@@ -272,7 +272,7 @@ moveRedRight t =
272 let t' = color_flip t in
272 let t' = color_flip t in
273 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
273 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
274
274
275−moveRedLeft : RBTree k v -> RBTree k v
275+moveRedLeftIfNeeded : RBTree k v -> RBTree k v
276moveRedLeftIfNeeded t =
276moveRedLeftIfNeeded t =
277 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t
277 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t
278
278
core-elm/Either.elm+10
@@ -1,12 +1,22 @@
1
1
2data Either a b = Left a | Right b
2data Either a b = Left a | Right b
3
3
4+either : (a -> c) -> (b -> c) -> Either a b -> c
4either f g e = case e of { Left x -> f x ; Right y -> g y }
5either f g e = case e of { Left x -> f x ; Right y -> g y }
5
6
7+
8+isLeft : Either a b -> Bool
6isLeft e = case e of { Left _ -> True ; _ -> False }
9isLeft e = case e of { Left _ -> True ; _ -> False }
10+
11+isRight : Either a b -> Bool
7isRight e = case e of { Right _ -> True ; _ -> False }
12isRight e = case e of { Right _ -> True ; _ -> False }
8
13
14+
15+lefts : [Either a b] -> [a]
9lefts = Elm.List.filter isLeft
16lefts = Elm.List.filter isLeft
17+
18+rights : [Either a b] -> [b]
10rights = Elm.List.filter isRight
19rights = Elm.List.filter isRight
11
20
21+partition : [Either a b] -> ([a],[b])
12partition = Elm.List.partition isLeft
22partition = Elm.List.partition isLeft
core-elm/Set.elm+27−3
@@ -6,19 +6,43 @@ module Set (empty,singleton,insert,remove
6 ,toList,fromList
6 ,toList,fromList
7 ) where
7 ) where
8
8
9+type Set t = Dict t ()
10+
11+empty : Set t
9empty = Dict.empty
12empty = Dict.empty
13+
14+singleton : t -> Set t
10singleton k = Dict.singleton k ()
15singleton k = Dict.singleton k ()
16+
17+insert : t -> Set t -> Set t
11insert k = Dict.insert k ()
18insert k = Dict.insert k ()
19+
20+remove : t -> Set t -> Set t
12remove = Dict.remove
21remove = Dict.remove
22+
23+member : t -> Set t -> Bool
13member = Dict.member
24member = Dict.member
14
25
26+union : Set t -> Set t -> Set t
15union = Dict.union
27union = Dict.union
28+
29+intersect : Set t -> Set t -> Set t
16intersect = Dict.intersect
30intersect = Dict.intersect
31+
32+diff : Set t -> Set t -> Set t
17diff = Dict.diff
33diff = Dict.diff
18
34
35+toList : Set t -> [t]
19toList = Dict.keys
36toList = Dict.keys
37+
38+fromList : [t] -> Set t
20fromList = List.foldl (\k t -> Dict.insert k () t) empty
39fromList = List.foldl (\k t -> Dict.insert k () t) empty
21
40
41+foldl : (a -> b -> b) -> b -> Set a -> b
22−foldl f = Dict.foldl (\k v b -> f k b)
42+foldl f = Dict.foldl (\k _ b -> f k b)
43+
44+foldr : (a -> b -> b) -> b -> Set a -> b
23−foldr f = Dict.foldr (\k v b -> f k b)
45+foldr f = Dict.foldr (\k _ b -> f k b)
46+
47+map : (a -> b) -> Set a -> Set b
24−map f t = fromList . List.map f $ toList t
48+map f = fromList . List.map f . toList
elm/src/Compiler.hs+17−46
@@ -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,42 +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", "Maybe", "Dict", "Set", "Automaton", "Date" ]
107− , [ "Signal", "Mouse", "Keyboard.Raw"
108− , "Window", "Time", "HTTP", "Input", "Random" ]
109− , [ "Graphics", "Text", "Color" ]
110− , map ("JavaScript"++) [ "", ".Experimental" ]
111− , [ "Prelude", "JSON" ]
112− ]
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