@@ -1,91 +1,156 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22module Main where
33
4+import Control.Monad (foldM, when)
5+import qualified Data.Map as Map
46import Data.Either (lefts, rights)
5−import Data.List (intersect, intercalate,lookup)
7+import Data.List (intersect, intercalate, lookup)
68import Data.Maybe (fromMaybe)
79import Data.Version (showVersion)
810import System.Console.CmdArgs
11+import System.Directory
912import System.Exit
1013import System.FilePath
11−import Text.Blaze.Html.Renderer.String (renderHtml)
14+import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
15+import qualified Text.Blaze.Html.Renderer.String as Normal
1216
1317import qualified Text.Jasmine as JS
1418import qualified Data.ByteString.Lazy.Char8 as BS
1519
1620import Ast
17−import Initialize (build,buildFromSource)
18−import CompileToJS
19−import GenerateHtml
21+import Initialize (buildFromSource, getSortedModuleNames)
22+import CompileToJS (jsModule)
23+import GenerateHtml (createHtml, JSStyle(..), JSSource(..))
2024import qualified Libraries as Libraries
2125import Paths_Elm
2226
23−data ELM =
24− ELM { make :: Bool
25− , files :: [FilePath]
26− , runtime :: Maybe FilePath
27− , separate_js :: Bool
28− , only_js :: Bool
29− , import_js :: [FilePath]
30− , no_prelude :: Bool
31− , noscript :: Bool
32− , minify :: Bool
33− , output_directory :: Maybe FilePath
34− }
27+data Flags =
28+ Flags { make :: Bool
29+ , files :: [FilePath]
30+ , runtime :: Maybe FilePath
31+ , only_js :: Bool
32+ , scripts :: [FilePath]
33+ , no_prelude :: Bool
34+ , minify :: Bool
35+ , output_directory :: FilePath
36+ }
3537 deriving (Data,Typeable,Show,Eq)
3638
37−elm = ELM { make = False &= help "automatically compile dependencies."
38− , files = def &= args &= typ "FILES"
39− , runtime = Nothing &= typFile &=
40− help "Specify a custom location for Elm's runtime system."
41− , separate_js = False &= help "Compile to separate HTML and JS files."
42− , only_js = False &= help "Compile only to JavaScript."
43− , import_js = [] &= typFile &= help "Include a JavaScript file before the body of the Elm program. Can be used many times. Files will be included in the given order."
44− , no_prelude = False &= help "Do not import Prelude by default, used only when compiling standard libraries."
45− , noscript = True &= help "Add generated <noscript> tag to HTML output."
46− , minify = False &= help "Minify generated JavaScript"
47− , output_directory = Nothing &= typFile &= help "Output files to directory specified. Defaults to the location of original file."
48− } &=
49− help "Compile Elm programs to HTML, CSS, and JavaScript." &=
50− summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
51−
52−main = do
53− args <- cmdArgs elm
54− mini <- getDataFileName "elm-runtime.js"
55− compileArgs mini args
56−
57−compileArgs mini flags =
58− case files flags of
59− [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
60− fs -> mapM_ (fileTo flags what loc) fs
61− where loc = fromMaybe mini (runtime flags)
62− what | only_js flags = JS
63− | separate_js flags = Split
64− | otherwise = HTML
65−
66−data What = JS | HTML | Split
67−
68−fileTo flags what rtLoc file = do
69− let jsStyle = if minify flags then Minified else Readable
70− formatJS = if minify flags then BS.unpack . JS.minify . BS.pack else id
71− prelude = not (no_prelude flags)
72− ems <- if make flags then build prelude file
73− else do src <- readFile file
74− return (fmap (:[]) (buildFromSource prelude src))
75− jss <- concat `fmap` mapM readFile (import_js flags)
76− case ems of
77− Left err -> do putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
78− exitFailure
79− Right ms' ->
80− let path = fromMaybe "" (output_directory flags) </> file
81− js = replaceExtension path ".js"
82− html = replaceExtension path ".html"
83− ms = if no_prelude flags then ms' else map Libraries.addPrelude ms'
84− txt = jss ++ concatMap jsModule ms
85− in case what of
86− JS -> writeFile js (formatJS txt)
87− HTML -> writeFile html . renderHtml $
88− modulesToHtml jsStyle "" rtLoc jss (noscript flags) ms
89− Split ->
90− do writeFile html . renderHtml $ linkedHtml rtLoc js ms
91− writeFile js (formatJS txt)
39+flags = Flags
40+ { make = False
41+ &= help "automatically compile dependencies."
42+ , files = def &= args &= typ "FILES"
43+ , runtime = Nothing &= typFile
44+ &= help "Specify a custom location for Elm's runtime system."
45+ , only_js = False
46+ &= help "Compile only to JavaScript."
47+ , scripts = [] &= typFile
48+ &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
49+ , no_prelude = False
50+ &= help "Do not import Prelude by default, used only when compiling standard libraries."
51+ , minify = False
52+ &= help "Minify generated JavaScript"
53+ , output_directory = "ElmFiles" &= typFile
54+ &= help "Output files to directory specified. Defaults to ElmFiles/ directory."
55+ } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
56+ &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
57+
58+main :: IO ()
59+main = compileArgs =<< cmdArgs flags
60+
61+compileArgs :: Flags -> IO ()
62+compileArgs flags =
63+ let builder file = if make flags then build flags file
64+ else buildFile flags 1 1 file >> return ()
65+ in case files flags of
66+ [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
67+ fs -> mapM_ builder fs
68+
69+
70+type Interface = String
71+
72+buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
73+buildFile flags moduleNum numModules filePath =
74+ do compiled <- alreadyCompiled
75+ if compiled then getInterface else compile
76+
77+ where
78+ file :: String -> FilePath
79+ file ext = replaceExtension filePath ext
80+
81+ interface :: FilePath
82+ interface = file "elmi"
83+
84+ alreadyCompiled :: IO Bool
85+ alreadyCompiled = do
86+ exists <- doesFileExist interface
87+ if not exists then return False
88+ else do tsrc <- getModificationTime filePath
89+ tint <- getModificationTime interface
90+ return (tsrc < tint)
91+
92+ number :: String
93+ number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
94+
95+ name :: String
96+ name = intercalate "." (splitDirectories (dropExtensions filePath))
97+
98+ compile :: IO Interface
99+ compile = do
100+ putStrLn (number ++ " Compiling " ++ name)
101+ source <- readFile filePath
102+ js <- if takeExtension filePath == ".js" then return source else
103+ case buildFromSource (no_prelude flags) source of
104+ Left err -> putStrLn err >> exitFailure
105+ Right modul -> return (jsModule modul)
106+ writeFile interface js
107+ writeFile (file "elmo") js
108+ when (only_js flags) (writeFile (file "js") js)
109+ return js
110+
111+ getInterface :: IO Interface
112+ getInterface = do
113+ readFile interface
114+
115+getRuntime :: Flags -> IO FilePath
116+getRuntime flags =
117+ case runtime flags of
118+ Just fp -> return fp
119+ Nothing -> getDataFileName "elm-runtime.js"
120+
121+build :: Flags -> FilePath -> IO ()
122+build flags rootFile = do
123+ files <- getSortedModuleNames rootFile
124+ buildFiles flags (length files) Map.empty files
125+ js <- foldM appendToOutput "" files
126+ case only_js flags of
127+ True -> do
128+ putStr "\nGenerating JavaScript... "
129+ writeFile (replaceExtension rootFile "js") (genJs js)
130+ putStrLn "Done"
131+ False -> do
132+ putStr "\nGenerating HTML... "
133+ runtime <- getRuntime flags
134+ let html = genHtml $ createHtml runtime rootFile (sources js) ""
135+ writeFile (replaceExtension rootFile "html") html
136+ putStrLn "Done"
137+
138+ where
139+ appendToOutput :: String -> FilePath -> IO String
140+ appendToOutput js filePath =
141+ do src <- readFile (replaceExtension filePath "elmo")
142+ return (src ++ js)
143+
144+ genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
145+ genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
146+ sources js = map Link (scripts flags) ++
147+ [ Source (if minify flags then Minified else Readable) js ]
148+
149+
150+buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
151+buildFiles _ _ _ [] = return ()
152+buildFiles flags numModules interfaces (filePath:rest) = do
153+ interface <- buildFile flags (numModules - length rest) numModules filePath
154+ let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
155+ interfaces' = Map.insert moduleName interface interfaces
156+ buildFiles flags numModules interfaces' rest