git.iko.soy/elk
on d57b91c help sign in
elk/compiler/Compiler.hs
227 lines 8.8 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
4import Control.Monad
5import qualified Data.Map as Map
6import qualified Data.List as List
7import qualified Data.Binary as Binary
8import Data.Version (showVersion)
9import System.Console.CmdArgs hiding (program)
10import System.Directory
11import System.Exit
12import System.FilePath
13import System.IO
14import GHC.Conc
16import Text.Blaze.Html.Renderer.Pretty (renderHtml)
17import qualified Data.ByteString.Lazy.Char8 as BS
18import qualified Data.ByteString.Lazy as L
20import qualified Metadata.Prelude as Prelude
21import qualified Transform.Canonicalize as Canonical
22import SourceSyntax.Module
23import Parse.Module (getModuleName)
24import Initialize (buildFromSource, getSortedDependencies)
25import Generate.JavaScript (jsModule)
26import Generate.Html (createHtml, JSSource(..))
27import Paths_Elm
29import SourceSyntax.PrettyPrint (pretty, variable)
30import Text.PrettyPrint as P
31import qualified Type.Type as Type
32import qualified Type.Alias as Alias
34data Flags =
35 Flags { make :: Bool
36 , files :: [FilePath]
37 , runtime :: Maybe FilePath
38 , only_js :: Bool
39 , print_types :: Bool
40 , print_program :: 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)
49flags = 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 , print_program = False
70 &= help "Print out an internal representation of a program."
71 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
72 &= helpArg [explicit, name "help", name "h"]
73 &= versionArg [explicit, name "version", name "v", summary (showVersion version)]
74 &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki 2011-2013")
76main :: IO ()
77main = do setNumCapabilities =<< getNumProcessors
78 compileArgs =<< cmdArgs flags
80compileArgs :: Flags -> IO ()
81compileArgs flags =
82 case files flags of
83 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
84 fs -> mapM_ (build flags) fs
87buildPath :: Flags -> FilePath -> String -> FilePath
88buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
90cachePath :: Flags -> FilePath -> String -> FilePath
91cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
93elmo :: Flags -> FilePath -> FilePath
94elmo flags filePath = cachePath flags filePath "elmo"
96elmi :: Flags -> FilePath -> FilePath
97elmi flags filePath = cachePath flags filePath "elmi"
100buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String,ModuleInterface)
101buildFile flags moduleNum numModules interfaces filePath =
102 do compiled <- alreadyCompiled
103 case compiled of
104 False -> compile
105 True -> do
106 handle <- openBinaryFile (elmi flags filePath) ReadMode
107 bits <- L.hGetContents handle
108 let info :: (String, ModuleInterface)
109 info = Binary.decode bits
110 modInterface = snd info
112 when (print_types flags)
113 (printTypes interfaces
114 (iTypes modInterface)
115 (iAliases modInterface)
116 (iImports modInterface))
118 L.length bits `seq` hClose handle
119 return info
120 where
121 alreadyCompiled :: IO Bool
122 alreadyCompiled = do
123 existsi <- doesFileExist (elmi flags filePath)
124 existso <- doesFileExist (elmo flags filePath)
125 if not existsi || not existso
126 then return False
127 else do tsrc <- getModificationTime filePath
128 tint <- getModificationTime (elmo flags filePath)
129 return (tsrc <= tint)
131 number :: String
132 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
134 compile :: IO (String,ModuleInterface)
135 compile = do
136 source <- readFile filePath
137 let name = case getModuleName source of
138 Just n -> n
139 Nothing -> "Main"
140 putStrLn $ concat [ number, " Compiling ", name
141 , replicate (max 1 (20 - length name)) ' '
142 , "( " ++ filePath ++ " )" ]
144 createDirectoryIfMissing True (cache_dir flags)
145 createDirectoryIfMissing True (build_dir flags)
146 metaModule <-
147 case buildFromSource (no_prelude flags) interfaces source of
148 Left errors -> do
149 mapM print (List.intersperse (P.text " ") errors)
150 exitFailure
151 Right modul -> do
152 case print_program flags of
153 False -> return ()
154 True -> print . pretty $ program modul
155 return modul
157 when (print_types flags)
158 (printTypes interfaces
159 (types metaModule) (aliases metaModule) (imports metaModule))
161 let interface = Canonical.interface name $ ModuleInterface {
162 iTypes = types metaModule,
163 iImports = imports metaModule,
164 iAdts = datatypes metaModule,
165 iAliases = aliases metaModule,
166 iFixities = fixities metaModule
167 }
169 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
170 handle <- openBinaryFile (elmi flags filePath) WriteMode
171 L.hPut handle (Binary.encode (name,interface))
172 hClose handle
173 writeFile (elmo flags filePath) (jsModule metaModule)
174 return (name,interface)
176printTypes interfaces moduleTypes moduleAliases moduleImports = do
177 putStrLn ""
178 let rules = Alias.rules interfaces moduleAliases moduleImports
179 forM_ (Map.toList moduleTypes) $ \(n,t) -> do
180 print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
181 putStrLn ""
183getRuntime :: Flags -> IO FilePath
184getRuntime flags =
185 case runtime flags of
186 Just fp -> return fp
187 Nothing -> getDataFileName "elm-runtime.js"
189build :: Flags -> FilePath -> IO ()
190build flags rootFile = do
191 let noPrelude = no_prelude flags
192 files <- if make flags then getSortedDependencies (src_dir flags) noPrelude rootFile
193 else return [rootFile]
194 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
195 (moduleName, interfaces) <- buildFiles flags (length files) ifaces "" files
196 js <- foldM appendToOutput BS.empty files
198 (extension, code) <- case only_js flags of
199 True -> do
200 putStr "Generating JavaScript ... "
201 return ("js", js)
202 False -> do
203 putStr "Generating HTML ... "
204 rtsPath <- getRuntime flags
205 return ("html", BS.pack . renderHtml $
206 createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
208 let targetFile = buildPath flags rootFile extension
209 createDirectoryIfMissing True (takeDirectory targetFile)
210 BS.writeFile targetFile code
211 putStrLn "Done"
213 where
214 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
215 appendToOutput js filePath =
216 do src <- BS.readFile (elmo flags filePath)
217 return (BS.append src js)
219 sources js = map Link (scripts flags) ++ [ Source js ]
222buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
223buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
224buildFiles flags numModules interfaces _ (filePath:rest) = do
225 (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
226 let interfaces' = Map.insert name interface interfaces
227 buildFiles flags numModules interfaces' name rest