git.iko.soy/elk
on master help sign in
Finish refactoring code into Build/ directory, make some names more consistent and remove unneeded dependencies
dac51abEvan Czaplicki
Elm.cabal+14−2
compare with master
unifiedsplit
@@ -53,7 +53,6 @@ Library
53 Transform.Substitute,
53 Transform.Substitute,
54 Transform.Optimize,
54 Transform.Optimize,
55 Metadata.Prelude,
55 Metadata.Prelude,
56− Initialize,
57 InterfaceSerialization,
56 InterfaceSerialization,
58 Parse.Binop,
57 Parse.Binop,
59 Parse.Declaration,
58 Parse.Declaration,
@@ -78,6 +77,13 @@ Library
78 Type.State,
77 Type.State,
79 Type.Type,
78 Type.Type,
80 Type.Unify,
79 Type.Unify,
80+ Build.Dependencies,
81+ Build.File,
82+ Build.Flags,
83+ Build.Info,
84+ Build.Print,
85+ Build.Source,
86+ Build.Utils,
81 Paths_Elm
87 Paths_Elm
82
88
83 Build-depends: base >=4.2 && <5,
89 Build-depends: base >=4.2 && <5,
@@ -124,7 +130,6 @@ Executable elm
124 Transform.Substitute,
130 Transform.Substitute,
125 Transform.Optimize,
131 Transform.Optimize,
126 Metadata.Prelude,
132 Metadata.Prelude,
127− Initialize,
128 InterfaceSerialization,
133 InterfaceSerialization,
129 Parse.Binop,
134 Parse.Binop,
130 Parse.Declaration,
135 Parse.Declaration,
@@ -149,6 +154,13 @@ Executable elm
149 Type.State,
154 Type.State,
150 Type.Type,
155 Type.Type,
151 Type.Unify,
156 Type.Unify,
157+ Build.Dependencies,
158+ Build.File,
159+ Build.Flags,
160+ Build.Info,
161+ Build.Print,
162+ Build.Source,
163+ Build.Utils,
152 Paths_Elm
164 Paths_Elm
153
165
154 Build-depends: base >=4.2 && <5,
166 Build-depends: base >=4.2 && <5,
compiler/Build/Build.hsdeleted−158
@@ -1,158 +0,0 @@
1−module Build.Build (build) where
2−
3−import Control.Monad (when, forM_, foldM)
4−import qualified Data.Map as Map
5−import qualified Data.List as List
6−import qualified Data.Binary as Binary
7−import System.Directory
8−import System.Exit
9−import System.FilePath
10−import System.IO
11−
12−import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
13−import qualified Data.ByteString.Lazy.Char8 as BS
14−import qualified Data.ByteString.Lazy as L
15−
16−import qualified Metadata.Prelude as Prelude
17−import qualified Transform.Canonicalize as Canonical
18−import SourceSyntax.Module
19−import Parse.Module (getModuleName)
20−import qualified Build.FromSource as FromSource
21−import Build.Dependencies (getSortedDependencies)
22−import Generate.JavaScript (jsModule)
23−import Generate.Html (createHtml, JSSource(..))
24−import qualified InterfaceSerialization as IS
25−
26−import SourceSyntax.PrettyPrint (pretty, variable)
27−import Text.PrettyPrint as P
28−import qualified Type.Alias as Alias
29−
30−import qualified Build.Utils as Utils
31−import qualified Build.Info as Info
32−import qualified Build.Flags as Flag
33−
34−buildFile :: Flag.Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String, ModuleInterface)
35−buildFile flags moduleNum numModules interfaces filePath = do
36− compiled <- alreadyCompiled
37− if not compiled then compile else do
38− bytes <- IS.loadInterface (Utils.elmi flags filePath)
39− let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes
40− case IS.validVersion filePath =<< binary of
41− Left err -> do
42− hPutStrLn stderr err
43− exitFailure
44−
45− Right (name, interface) -> do
46− when (Flag.print_types flags) $
47− printTypes interfaces
48− (iTypes interface)
49− (iAliases interface)
50− (iImports interface)
51−
52− return (name, interface)
53−
54− where
55− alreadyCompiled :: IO Bool
56− alreadyCompiled = do
57− existsi <- doesFileExist (Utils.elmi flags filePath)
58− existso <- doesFileExist (Utils.elmo flags filePath)
59− if not existsi || not existso
60− then return False
61− else do tsrc <- getModificationTime filePath
62− tint <- getModificationTime (Utils.elmo flags filePath)
63− return (tsrc <= tint)
64−
65− number :: String
66− number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
67−
68− compile :: IO (String,ModuleInterface)
69− compile = do
70− source <- readFile filePath
71− let name = case getModuleName source of
72− Just n -> n
73− Nothing -> "Main"
74− putStrLn $ concat [ number, " Compiling ", name
75− , replicate (max 1 (20 - length name)) ' '
76− , "( " ++ filePath ++ " )" ]
77−
78− createDirectoryIfMissing True (Flag.cache_dir flags)
79− createDirectoryIfMissing True (Flag.build_dir flags)
80−
81− metaModule <-
82− case FromSource.build (Flag.no_prelude flags) interfaces source of
83− Left errors -> do
84− mapM print (List.intersperse (P.text " ") errors)
85− exitFailure
86− Right modul -> return modul
87−
88− when (Flag.print_types flags)
89− (printTypes interfaces
90− (types metaModule) (aliases metaModule) (imports metaModule))
91−
92− let interface = Canonical.interface name $ ModuleInterface {
93− iVersion = Info.version,
94− iTypes = types metaModule,
95− iImports = imports metaModule,
96− iAdts = datatypes metaModule,
97− iAliases = aliases metaModule,
98− iFixities = fixities metaModule
99− }
100−
101− createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
102− handle <- openBinaryFile (Utils.elmi flags filePath) WriteMode
103− L.hPut handle (Binary.encode (name,interface))
104− hClose handle
105− writeFile (Utils.elmo flags filePath) (jsModule metaModule)
106− return (name,interface)
107−
108−printTypes interfaces moduleTypes moduleAliases moduleImports = do
109− putStrLn ""
110− let rules = Alias.rules interfaces moduleAliases moduleImports
111− forM_ (Map.toList moduleTypes) $ \(n,t) -> do
112− print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
113− putStrLn ""
114−
115−build :: Flag.Flags -> FilePath -> IO ()
116−build flags rootFile = do
117− let noPrelude = Flag.no_prelude flags
118− builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
119−
120− files <- if Flag.make flags
121− then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
122− else return [rootFile]
123−
124− (moduleName, interfaces) <- buildFiles flags (length files) builtIns "" files
125−
126− js <- foldM appendToOutput BS.empty files
127−
128− (extension, code) <- case Flag.only_js flags of
129− True -> do
130− putStr "Generating JavaScript ... "
131− return ("js", js)
132− False -> do
133− putStr "Generating HTML ... "
134− rtsPath <- case Flag.runtime flags of
135− Just fp -> return fp
136− Nothing -> Info.runtime
137− return ("html", renderHtml $
138− createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
139−
140− let targetFile = Utils.buildPath flags rootFile extension
141− createDirectoryIfMissing True (takeDirectory targetFile)
142− BS.writeFile targetFile code
143− putStrLn "Done"
144−
145− where
146− appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
147− appendToOutput js filePath =
148− do src <- BS.readFile (Utils.elmo flags filePath)
149− return (BS.append src js)
150−
151− sources js = map Link (Flag.scripts flags) ++ [ Source js ]
152−
153−buildFiles :: Flag.Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
154−buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
155−buildFiles flags numModules interfaces _ (filePath:rest) = do
156− (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
157− let interfaces' = Map.insert name interface interfaces
158− buildFiles flags numModules interfaces' name rest
compiler/Build/File.hsnew file+106
@@ -0,0 +1,106 @@
1+module Build.File (build) where
2+
3+import Control.Monad (when)
4+import qualified Data.Binary as Binary
5+import qualified Data.List as List
6+import qualified Data.Map as Map
7+import System.Directory
8+import System.Exit
9+import System.FilePath
10+import System.IO
11+
12+import qualified Transform.Canonicalize as Canonical
13+
14+import qualified Data.ByteString.Lazy as L
15+
16+import qualified Build.Utils as Utils
17+import qualified Build.Flags as Flag
18+import qualified Build.Source as Source
19+import qualified Build.Print as Print
20+import qualified Generate.JavaScript as JS
21+import qualified InterfaceSerialization as IS
22+import qualified Parse.Module as Parser
23+import qualified SourceSyntax.Module as M
24+
25+build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath]
26+ -> IO (String, M.Interfaces)
27+build _ _ interfaces moduleName [] =
28+ return (moduleName, interfaces)
29+build flags numModules interfaces _ (filePath:rest) =
30+ do (name,interface) <-
31+ build1 flags (numModules - length rest) numModules interfaces filePath
32+ let interfaces' = Map.insert name interface interfaces
33+ build flags numModules interfaces' name rest
34+
35+
36+build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath
37+ -> IO (String, M.ModuleInterface)
38+build1 flags moduleNum numModules interfaces filePath =
39+ do compiled <- alreadyCompiled flags filePath
40+ case compiled of
41+ False -> compile flags number interfaces filePath
42+ True -> retrieve flags interfaces filePath
43+ where
44+ number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
45+
46+
47+alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool
48+alreadyCompiled flags filePath = do
49+ existsi <- doesFileExist (Utils.elmi flags filePath)
50+ existso <- doesFileExist (Utils.elmo flags filePath)
51+ if not existsi || not existso
52+ then return False
53+ else do tsrc <- getModificationTime filePath
54+ tint <- getModificationTime (Utils.elmo flags filePath)
55+ return (tsrc <= tint)
56+
57+retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath
58+ -> IO (String, M.ModuleInterface)
59+retrieve flags interfaces filePath = do
60+ bytes <- IS.loadInterface (Utils.elmi flags filePath)
61+ let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes
62+ case IS.validVersion filePath =<< binary of
63+ Right (name, interface) ->
64+ do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface)
65+ return (name, interface)
66+ Left err ->
67+ do hPutStrLn stderr err
68+ exitFailure
69+
70+compile :: Flag.Flags -> String -> M.Interfaces -> FilePath
71+ -> IO (String, M.ModuleInterface)
72+compile flags number interfaces filePath =
73+ do source <- readFile filePath
74+ let name = getName source
75+ printStatus name
76+
77+ createDirectoryIfMissing True (Flag.cache_dir flags)
78+ createDirectoryIfMissing True (Flag.build_dir flags)
79+
80+ metaModule <-
81+ case Source.build (Flag.no_prelude flags) interfaces source of
82+ Right modul -> return modul
83+ Left errors -> do Print.errors errors
84+ exitFailure
85+
86+ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule
87+
88+ let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule)
89+ generateCache intermediate metaModule
90+ return intermediate
91+
92+ where
93+ getName source = case Parser.getModuleName source of
94+ Just n -> n
95+ Nothing -> "Main"
96+
97+ printStatus name =
98+ hPutStrLn stdout $ concat [ number, " Compiling ", name
99+ , replicate (max 1 (20 - length name)) ' '
100+ , "( " ++ filePath ++ " )" ]
101+
102+ generateCache intermediate metaModule = do
103+ createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
104+ writeFile (Utils.elmo flags filePath) (JS.generate metaModule)
105+ withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
106+ L.hPut handle (Binary.encode intermediate)
compiler/Build/Print.hsnew file+32
@@ -0,0 +1,32 @@
1+module Build.Print where
2+
3+import qualified Data.Map as Map
4+import qualified Data.List as List
5+import qualified SourceSyntax.Module as M
6+import qualified SourceSyntax.PrettyPrint as Pretty
7+import qualified Type.Alias as Alias
8+import qualified Text.PrettyPrint as P
9+
10+metaTypes :: Map.Map String M.ModuleInterface -> M.MetadataModule () () -> IO ()
11+metaTypes interfaces meta =
12+ types interfaces (M.types meta) (M.aliases meta) (M.imports meta)
13+
14+interfaceTypes :: Map.Map String M.ModuleInterface -> M.ModuleInterface -> IO ()
15+interfaceTypes interfaces iface =
16+ types interfaces (M.iTypes iface) (M.iAliases iface) (M.iImports iface)
17+
18+types interfaces types' aliases imports =
19+ do putStrLn ""
20+ mapM_ printType (Map.toList types')
21+ putStrLn ""
22+ where
23+ rules = Alias.rules interfaces aliases imports
24+
25+ printType (n,t) = do
26+ print $ P.hsep [ Pretty.variable n
27+ , P.text ":"
28+ , Pretty.pretty (Alias.realias rules t) ]
29+
30+errors :: [P.Doc] -> IO ()
31+errors errs =
32+ mapM_ print (List.intersperse (P.text " ") errs)
compiler/Build/FromSource.hs → compiler/Build/Source.hsrenamed+1−1
@@ -1,4 +1,4 @@
1−module Build.FromSource (build) where
1+module Build.Source (build) where
2
2
3import Data.Data
3import Data.Data
4import Control.Monad.State
4import Control.Monad.State
compiler/Compiler.hs+61−6
@@ -1,16 +1,71 @@
1module Main where
1module Main where
2
2
3+import Control.Monad (foldM)
4+import qualified Data.Map as Map
5+import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
6+import qualified Data.ByteString.Lazy.Char8 as BS
3−import System.Console.CmdArgs
7+import qualified System.Console.CmdArgs as CmdArgs
8+import System.Directory
9+import System.FilePath
4import GHC.Conc
10import GHC.Conc
11+
12+import Build.Dependencies (getSortedDependencies)
13+import qualified Generate.Html as Html
14+import qualified Metadata.Prelude as Prelude
15+import qualified Build.Utils as Utils
16+import qualified Build.Info as Info
5−import Build.Flags
17+import qualified Build.Flags as Flag
6−import Build.Build
18+import qualified Build.File as File
7
19
8main :: IO ()
20main :: IO ()
9main = do setNumCapabilities =<< getNumProcessors
21main = do setNumCapabilities =<< getNumProcessors
10− compileArgs =<< cmdArgs flags
22+ compileArgs =<< CmdArgs.cmdArgs Flag.flags
11
23
12−compileArgs :: Flags -> IO ()
24+compileArgs :: Flag.Flags -> IO ()
13compileArgs flags =
25compileArgs flags =
14− case files flags of
26+ case Flag.files flags of
15 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
27 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
16 fs -> mapM_ (build flags) fs
28 fs -> mapM_ (build flags) fs
29+
30+build :: Flag.Flags -> FilePath -> IO ()
31+build flags rootFile =
32+ do let noPrelude = Flag.no_prelude flags
33+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
34+
35+ files <- if Flag.make flags
36+ then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
37+ else return [rootFile]
38+
39+ (moduleName, interfaces) <-
40+ File.build flags (length files) builtIns "" files
41+
42+ js <- foldM appendToOutput BS.empty files
43+
44+ (extension, code) <-
45+ if Flag.only_js flags
46+ then do putStr "Generating JavaScript ... "
47+ return ("js", js)
48+ else do putStr "Generating HTML ... "
49+ makeHtml js moduleName
50+
51+ let targetFile = Utils.buildPath flags rootFile extension
52+ createDirectoryIfMissing True (takeDirectory targetFile)
53+ BS.writeFile targetFile code
54+ putStrLn "Done"
55+
56+ where
57+ appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
58+ appendToOutput js filePath = do
59+ src <- BS.readFile (Utils.elmo flags filePath)
60+ return (BS.append src js)
61+
62+ sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
63+
64+ makeHtml js moduleName = do
65+ rtsPath <- case Flag.runtime flags of
66+ Just fp -> return fp
67+ Nothing -> Info.runtime
68+
69+ let html = Html.generate
70+ rtsPath (takeBaseName rootFile) (sources js) moduleName ""
71+ return ("html", Blaze.renderHtml html)
compiler/Generate/Html.hs+3−6
@@ -1,8 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module Generate.Html
2+module Generate.Html (generate, JSSource(..)) where
3− (createHtml,
4− JSSource (..)
5− ) where
6
3
7import Text.Blaze (preEscapedToMarkup)
4import Text.Blaze (preEscapedToMarkup)
8import qualified Text.Blaze.Html5 as H
5import qualified Text.Blaze.Html5 as H
@@ -20,8 +17,8 @@ makeScript source =
20 H.script ! A.type_ "text/javascript" $
17 H.script ! A.type_ "text/javascript" $
21 preEscapedToMarkup $ BS.unpack src
18 preEscapedToMarkup $ BS.unpack src
22
19
23−createHtml :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
20+generate :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
24−createHtml libLoc title scripts moduleName noscript =
21+generate libLoc title scripts moduleName noscript =
25 H.docTypeHtml $ do
22 H.docTypeHtml $ do
26 H.head $ do
23 H.head $ do
27 H.meta ! A.charset "UTF-8"
24 H.meta ! A.charset "UTF-8"
compiler/Generate/JavaScript.hs+2−2
@@ -290,8 +290,8 @@ clause span variable (Case.Clause value vars mtch) =
290 is -> drop (last is + 1) name
290 is -> drop (last is + 1) name
291
291
292
292
293−jsModule :: MetadataModule () () -> String
293+generate :: MetadataModule () () -> String
294−jsModule modul =
294+generate modul =
295 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
295 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
296 [ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]
296 [ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]
297 where
297 where
compiler/Language/Elm.hs+11−14
@@ -8,38 +8,35 @@
8module Language.Elm (compile, moduleName, runtime, docs) where
8module Language.Elm (compile, moduleName, runtime, docs) where
9
9
10import qualified Data.List as List
10import qualified Data.List as List
11−import qualified Data.Map as Map
12−import Data.Version (showVersion)
13−import Generate.JavaScript (jsModule)
11+import qualified Generate.JavaScript as JS
14−import Initialize (buildFromSource)
12+import qualified Build.Source as Source
15−import Parse.Module (getModuleName)
13+import qualified Parse.Module as Parser
16−import SourceSyntax.Module
14+import qualified SourceSyntax.Module as M
17−import Text.Blaze.Html (Html)
18import qualified Text.PrettyPrint as P
15import qualified Text.PrettyPrint as P
19import qualified Metadata.Prelude as Prelude
16import qualified Metadata.Prelude as Prelude
20−import Paths_Elm
17+import qualified Paths_Elm as This
21import System.IO.Unsafe
18import System.IO.Unsafe
22
19
23-- |This function compiles Elm code to JavaScript. It will return either
20-- |This function compiles Elm code to JavaScript. It will return either
24-- an error message or the compiled JS code.
21-- an error message or the compiled JS code.
25compile :: String -> Either String String
22compile :: String -> Either String String
26compile source =
23compile source =
27− case buildFromSource False interfaces source of
24+ case Source.build False interfaces source of
28 Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
25 Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
29− Right modul -> Right $ jsModule (modul :: MetadataModule () ())
26+ Right modul -> Right $ JS.generate modul
30
27
31{-# NOINLINE interfaces #-}
28{-# NOINLINE interfaces #-}
32−interfaces :: Interfaces
29+interfaces :: M.Interfaces
33interfaces = unsafePerformIO $ Prelude.interfaces
30interfaces = unsafePerformIO $ Prelude.interfaces
34
31
35-- |This function extracts the module name of a given source program.
32-- |This function extracts the module name of a given source program.
36moduleName :: String -> Maybe String
33moduleName :: String -> Maybe String
37−moduleName = getModuleName
34+moduleName = Parser.getModuleName
38
35
39-- |The absolute path to Elm's runtime system.
36-- |The absolute path to Elm's runtime system.
40runtime :: IO FilePath
37runtime :: IO FilePath
41−runtime = getDataFileName "elm-runtime.js"
38+runtime = This.getDataFileName "elm-runtime.js"
42
39
43-- |The absolute path to Elm's core library documentation.
40-- |The absolute path to Elm's core library documentation.
44docs :: IO FilePath
41docs :: IO FilePath
45−docs = getDataFileName "docs.json"
42+docs = This.getDataFileName "docs.json"
compiler/SourceSyntax/Module.hs+10−2
@@ -14,8 +14,7 @@ import SourceSyntax.Type
14import System.FilePath (joinPath)
14import System.FilePath (joinPath)
15import Control.Monad (liftM)
15import Control.Monad (liftM)
16
16
17−import Paths_Elm (version)
17+import qualified Build.Info as Info
18−import Data.Version (showVersion)
19
18
20data Module tipe var =
19data Module tipe var =
21 Module [String] Exports Imports [Declaration tipe var]
20 Module [String] Exports Imports [Declaration tipe var]
@@ -70,6 +69,15 @@ data ModuleInterface = ModuleInterface {
70 iFixities :: [(Assoc, Int, String)]
69 iFixities :: [(Assoc, Int, String)]
71} deriving Show
70} deriving Show
72
71
72+metaToInterface metaModule =
73+ ModuleInterface
74+ { iVersion = Info.version
75+ , iTypes = types metaModule
76+ , iImports = imports metaModule
77+ , iAdts = datatypes metaModule
78+ , iAliases = aliases metaModule
79+ , iFixities = fixities metaModule
80+ }
73
81
74instance Binary ModuleInterface where
82instance Binary ModuleInterface where
75 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
83 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get