git.iko.soy/elk
on 44fecef help sign in
elk/compiler/Compiler.hs
155 lines 5.6 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
4import Control.Monad (foldM, when)
5import qualified Data.Map as Map
6import Data.Either (lefts, rights)
7import Data.List (intersect, intercalate, lookup)
8import Data.Maybe (fromMaybe)
9import Data.Version (showVersion)
10import System.Console.CmdArgs
11import System.Directory
12import System.Exit
13import System.FilePath
14import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
15import qualified Text.Blaze.Html.Renderer.String as Normal
17import qualified Text.Jasmine as JS
18import qualified Data.ByteString.Lazy.Char8 as BS
20import Ast
21import Initialize (buildFromSource, getSortedModuleNames)
22import CompileToJS (jsModule)
23import GenerateHtml (createHtml, JSStyle(..), JSSource(..))
24import qualified Libraries as Libraries
25import Paths_Elm
27data 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 }
37 deriving (Data,Typeable,Show,Eq)
39flags = 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 and HTML"
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")
58main :: IO ()
59main = compileArgs =<< cmdArgs flags
61compileArgs :: Flags -> IO ()
62compileArgs flags =
63 case files flags of
64 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
65 fs -> mapM_ (build flags) fs
68type Interface = String
70buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
71buildFile flags moduleNum numModules filePath =
72 do compiled <- alreadyCompiled
73 if compiled then getInterface else compile
75 where
76 file :: String -> FilePath
77 file ext = output_directory flags </> replaceExtension filePath ext
79 interface :: FilePath
80 interface = file "elmi"
82 alreadyCompiled :: IO Bool
83 alreadyCompiled = do
84 exists <- doesFileExist interface
85 if not exists then return False
86 else do tsrc <- getModificationTime filePath
87 tint <- getModificationTime interface
88 return (tsrc < tint)
90 number :: String
91 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
93 name :: String
94 name = intercalate "." (splitDirectories (dropExtensions filePath))
96 compile :: IO Interface
97 compile = do
98 putStrLn (number ++ " Compiling " ++ name)
99 source <- readFile filePath
100 (inter,obj) <-
101 if takeExtension filePath == ".js" then return ("",source) else
102 case buildFromSource (no_prelude flags) source of
103 Left err -> putStrLn err >> exitFailure
104 Right modul -> return (show modul, jsModule modul)
105 createDirectoryIfMissing True (output_directory flags)
106 writeFile interface inter
107 writeFile (file "elmo") obj
108 return inter
110 getInterface :: IO Interface
111 getInterface = do
112 readFile interface
114getRuntime :: Flags -> IO FilePath
115getRuntime flags =
116 case runtime flags of
117 Just fp -> return fp
118 Nothing -> getDataFileName "elm-runtime.js"
120build :: Flags -> FilePath -> IO ()
121build flags rootFile = do
122 files <- if make flags then getSortedModuleNames rootFile else return [rootFile]
123 buildFiles flags (length files) Map.empty files
124 js <- foldM appendToOutput "" files
125 case only_js flags of
126 True -> do
127 putStr "Generating JavaScript ... "
128 writeFile (replaceExtension rootFile "js") (genJs js)
129 putStrLn "Done"
130 False -> do
131 putStr "Generating HTML ... "
132 runtime <- getRuntime flags
133 let html = genHtml $ createHtml runtime rootFile (sources js) ""
134 writeFile (replaceExtension rootFile "html") html
135 putStrLn "Done"
137 where
138 appendToOutput :: String -> FilePath -> IO String
139 appendToOutput js filePath =
140 do src <- readFile (output_directory flags </> replaceExtension filePath "elmo")
141 return (src ++ js)
143 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
144 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
145 sources js = map Link (scripts flags) ++
146 [ Source (if minify flags then Minified else Readable) js ]
149buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
150buildFiles _ _ _ [] = return ()
151buildFiles flags numModules interfaces (filePath:rest) = do
152 interface <- buildFile flags (numModules - length rest) numModules filePath
153 let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
154 interfaces' = Map.insert moduleName interface interfaces
155 buildFiles flags numModules interfaces' rest