@@ -1,225 +1,68 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
21module Main where
32
4−import Control.Monad
3+import Control.Monad (foldM)
54import qualified Data.Map as Map
6−import qualified Data.List as List
7−import qualified Data.Binary as Binary
8−import Data.Version (showVersion)
9−import System.Console.CmdArgs hiding (program)
5+import qualified Data.Maybe as Maybe
6+import Text.Blaze.Html.Renderer.String (renderHtml)
7+import qualified Data.ByteString.Lazy.Char8 as BS
8+import qualified System.Console.CmdArgs as CmdArgs
109import System.Directory
11−import System.Exit
1210import System.FilePath
13−import System.IO
1411import GHC.Conc
1512
16−import Text.Blaze.Html.Renderer.Pretty (renderHtml)
17−import qualified Data.ByteString.Lazy.Char8 as BS
18−import qualified Data.ByteString.Lazy as L
19−
13+import Build.Dependencies (getSortedDependencies)
14+import qualified Generate.Html as Html
2015import qualified Metadata.Prelude as Prelude
21−import qualified Transform.Canonicalize as Canonical
22−import SourceSyntax.Module
23−import Parse.Module (getModuleName)
24−import Initialize (buildFromSource, getSortedDependencies)
25−import Generate.JavaScript (jsModule)
26−import Generate.Html (createHtml, JSSource(..))
27−import qualified InterfaceSerialization as IS
28−import Paths_Elm
29−
30−import SourceSyntax.PrettyPrint (pretty, variable)
31−import Text.PrettyPrint as P
32−import qualified Type.Type as Type
33−import qualified Type.Alias as Alias
34−
35−data Flags =
36− Flags { make :: Bool
37− , files :: [FilePath]
38− , runtime :: Maybe FilePath
39− , only_js :: Bool
40− , print_types :: Bool
41− , scripts :: [FilePath]
42− , no_prelude :: Bool
43− , cache_dir :: FilePath
44− , build_dir :: FilePath
45− , src_dir :: [FilePath]
46− }
47− deriving (Data,Typeable,Show,Eq)
48−
49−flags = Flags
50− { files = def &= args &= typ "FILES"
51− , make = False
52− &= help "automatically compile dependencies."
53− , only_js = False
54− &= help "Compile only to JavaScript."
55− , no_prelude = False
56− &= help "Do not import Prelude by default, used only when compiling standard libraries."
57− , scripts = [] &= typFile
58− &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
59− , runtime = Nothing &= typFile
60− &= help "Specify a custom location for Elm's runtime system."
61− , cache_dir = "cache" &= typFile
62− &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."
63− , build_dir = "build" &= typFile
64− &= help "Directory for generated HTML and JS files. Defaults to build/ directory."
65− , src_dir = ["."] &= typFile
66− &= help "Additional source directories besides project root. Searched when using --make"
67− , print_types = False
68− &= help "Print out infered types of top-level definitions."
69− } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
70− &= helpArg [explicit, name "help", name "h"]
71− &= versionArg [explicit, name "version", name "v", summary (showVersion version)]
72− &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki 2011-2013")
16+import qualified Build.Utils as Utils
17+import qualified Build.Flags as Flag
18+import qualified Build.File as File
19+import qualified Elm.Internal.Paths as Path
7320
7421main :: IO ()
7522main = do setNumCapabilities =<< getNumProcessors
76− compileArgs =<< cmdArgs flags
23+ compileArgs =<< CmdArgs.cmdArgs Flag.flags
7724
78−compileArgs :: Flags -> IO ()
25+compileArgs :: Flag.Flags -> IO ()
7926compileArgs flags =
80− case files flags of
27+ case Flag.files flags of
8128 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
8229 fs -> mapM_ (build flags) fs
8330
31+build :: Flag.Flags -> FilePath -> IO ()
32+build flags rootFile =
33+ do let noPrelude = Flag.no_prelude flags
34+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
8435
85−buildPath :: Flags -> FilePath -> String -> FilePath
86−buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
87−
88−cachePath :: Flags -> FilePath -> String -> FilePath
89−cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
90−
91−elmo :: Flags -> FilePath -> FilePath
92−elmo flags filePath = cachePath flags filePath "elmo"
93−
94−elmi :: Flags -> FilePath -> FilePath
95−elmi flags filePath = cachePath flags filePath "elmi"
96−
97−buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String, ModuleInterface)
98−buildFile flags moduleNum numModules interfaces filePath = do
99− compiled <- alreadyCompiled
100− if not compiled then compile else do
101− bytes <- IS.loadInterface (elmi flags filePath)
102− let binary = IS.interfaceDecode (elmi flags filePath) =<< bytes
103− case IS.validVersion filePath =<< binary of
104− Left err -> do
105− hPutStrLn stderr err
106− exitFailure
107−
108− Right (name, interface) -> do
109− when (print_types flags) $
110− printTypes interfaces
111− (iTypes interface)
112− (iAliases interface)
113− (iImports interface)
114−
115− return (name, interface)
116−
117− where
118− alreadyCompiled :: IO Bool
119− alreadyCompiled = do
120− existsi <- doesFileExist (elmi flags filePath)
121− existso <- doesFileExist (elmo flags filePath)
122− if not existsi || not existso
123− then return False
124− else do tsrc <- getModificationTime filePath
125− tint <- getModificationTime (elmo flags filePath)
126− return (tsrc <= tint)
127−
128− number :: String
129− number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
130−
131− compile :: IO (String,ModuleInterface)
132− compile = do
133− source <- readFile filePath
134− let name = case getModuleName source of
135− Just n -> n
136− Nothing -> "Main"
137− putStrLn $ concat [ number, " Compiling ", name
138− , replicate (max 1 (20 - length name)) ' '
139− , "( " ++ filePath ++ " )" ]
140−
141− createDirectoryIfMissing True (cache_dir flags)
142− createDirectoryIfMissing True (build_dir flags)
143−
144− metaModule <-
145− case buildFromSource (no_prelude flags) interfaces source of
146− Left errors -> do
147− mapM print (List.intersperse (P.text " ") errors)
148− exitFailure
149− Right modul -> return modul
150−
151− when (print_types flags)
152− (printTypes interfaces
153− (types metaModule) (aliases metaModule) (imports metaModule))
154−
155− let interface = Canonical.interface name $ ModuleInterface {
156− iVersion = showVersion version,
157− iTypes = types metaModule,
158− iImports = imports metaModule,
159− iAdts = datatypes metaModule,
160− iAliases = aliases metaModule,
161− iFixities = fixities metaModule
162− }
163−
164− createDirectoryIfMissing True . dropFileName $ elmi flags filePath
165− handle <- openBinaryFile (elmi flags filePath) WriteMode
166− L.hPut handle (Binary.encode (name,interface))
167− hClose handle
168− writeFile (elmo flags filePath) (jsModule metaModule)
169− return (name,interface)
170−
171−printTypes interfaces moduleTypes moduleAliases moduleImports = do
172− putStrLn ""
173− let rules = Alias.rules interfaces moduleAliases moduleImports
174− forM_ (Map.toList moduleTypes) $ \(n,t) -> do
175− print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
176− putStrLn ""
177−
178−getRuntime :: Flags -> IO FilePath
179−getRuntime flags =
180− case runtime flags of
181− Just fp -> return fp
182− Nothing -> getDataFileName "elm-runtime.js"
183−
184−build :: Flags -> FilePath -> IO ()
185−build flags rootFile = do
186− let noPrelude = no_prelude flags
187− builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
188−
189− files <- if make flags
190− then getSortedDependencies (src_dir flags) builtIns rootFile
191− else return [rootFile]
36+ files <- if Flag.make flags
37+ then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
38+ else return [rootFile]
19239
193− (moduleName, interfaces) <- buildFiles flags (length files) builtIns "" files
40+ (moduleName, interfaces) <-
41+ File.build flags (length files) builtIns "" files
19442
195− js <- foldM appendToOutput BS.empty files
43+ js <- foldM appendToOutput BS.empty files
19644
197− (extension, code) <- case only_js flags of
198− True -> do
199− putStr "Generating JavaScript ... "
200− return ("js", js)
201− False -> do
202− putStr "Generating HTML ... "
203− rtsPath <- getRuntime flags
204− return ("html", BS.pack . renderHtml $
205− createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
45+ (extension, code) <-
46+ if Flag.only_js flags
47+ then do putStr "Generating JavaScript ... "
48+ return ("js", js)
49+ else do putStr "Generating HTML ... "
50+ return (makeHtml js moduleName)
20651
207− let targetFile = buildPath flags rootFile extension
208− createDirectoryIfMissing True (takeDirectory targetFile)
209− BS.writeFile targetFile code
210− putStrLn "Done"
52+ let targetFile = Utils.buildPath flags rootFile extension
53+ createDirectoryIfMissing True (takeDirectory targetFile)
54+ BS.writeFile targetFile code
55+ putStrLn "Done"
21156
21257 where
21358 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
214− appendToOutput js filePath =
215− do src <- BS.readFile (elmo flags filePath)
216− return (BS.append src js)
59+ appendToOutput js filePath = do
60+ src <- BS.readFile (Utils.elmo flags filePath)
61+ return (BS.append src js)
21762
218− sources js = map Link (scripts flags) ++ [ Source js ]
63+ sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
21964
220−buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
221−buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
222−buildFiles flags numModules interfaces _ (filePath:rest) = do
223− (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
224− let interfaces' = Map.insert name interface interfaces
225− buildFiles flags numModules interfaces' name rest
65+ makeHtml js moduleName = ("html", BS.pack $ renderHtml html)
66+ where
67+ rtsPath = Maybe.fromMaybe Path.runtime (Flag.runtime flags)
68+ html = Html.generate rtsPath (takeBaseName rootFile) (sources js) moduleName ""