git.iko.soy/elk
on e3c3d21 help sign in
elk/compiler/Compiler.hs
220 lines 8.5 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 , scripts :: [FilePath]
41 , no_prelude :: Bool
42 , cache_dir :: FilePath
43 , build_dir :: FilePath
44 , src_dir :: [FilePath]
45 }
46 deriving (Data,Typeable,Show,Eq)
48flags = Flags
49 { files = def &= args &= typ "FILES"
50 , make = False
51 &= help "automatically compile dependencies."
52 , only_js = False
53 &= help "Compile only to JavaScript."
54 , no_prelude = False
55 &= help "Do not import Prelude by default, used only when compiling standard libraries."
56 , scripts = [] &= typFile
57 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
58 , runtime = Nothing &= typFile
59 &= help "Specify a custom location for Elm's runtime system."
60 , cache_dir = "cache" &= typFile
61 &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."
62 , build_dir = "build" &= typFile
63 &= help "Directory for generated HTML and JS files. Defaults to build/ directory."
64 , src_dir = ["."] &= typFile
65 &= help "Additional source directories besides project root. Searched when using --make"
66 , print_types = False
67 &= help "Print out infered types of top-level definitions."
68 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
69 &= helpArg [explicit, name "help", name "h"]
70 &= versionArg [explicit, name "version", name "v", summary (showVersion version)]
71 &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki 2011-2013")
73main :: IO ()
74main = do setNumCapabilities =<< getNumProcessors
75 compileArgs =<< cmdArgs flags
77compileArgs :: Flags -> IO ()
78compileArgs flags =
79 case files flags of
80 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
81 fs -> mapM_ (build flags) fs
84buildPath :: Flags -> FilePath -> String -> FilePath
85buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
87cachePath :: Flags -> FilePath -> String -> FilePath
88cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
90elmo :: Flags -> FilePath -> FilePath
91elmo flags filePath = cachePath flags filePath "elmo"
93elmi :: Flags -> FilePath -> FilePath
94elmi flags filePath = cachePath flags filePath "elmi"
97buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String,ModuleInterface)
98buildFile flags moduleNum numModules interfaces filePath =
99 do compiled <- alreadyCompiled
100 case compiled of
101 False -> compile
102 True -> do
103 handle <- openBinaryFile (elmi flags filePath) ReadMode
104 bits <- L.hGetContents handle
105 let info :: (String, ModuleInterface)
106 info = Binary.decode bits
107 modInterface = snd info
109 when (print_types flags)
110 (printTypes interfaces
111 (iTypes modInterface)
112 (iAliases modInterface)
113 (iImports modInterface))
115 L.length bits `seq` hClose handle
116 return info
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)
128 number :: String
129 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
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 ++ " )" ]
141 createDirectoryIfMissing True (cache_dir flags)
142 createDirectoryIfMissing True (build_dir flags)
143 metaModule <-
144 case buildFromSource (no_prelude flags) interfaces source of
145 Left errors -> do
146 mapM print (List.intersperse (P.text " ") errors)
147 exitFailure
148 Right modul -> return modul
150 when (print_types flags)
151 (printTypes interfaces
152 (types metaModule) (aliases metaModule) (imports metaModule))
154 let interface = Canonical.interface name $ ModuleInterface {
155 iTypes = types metaModule,
156 iImports = imports metaModule,
157 iAdts = datatypes metaModule,
158 iAliases = aliases metaModule,
159 iFixities = fixities metaModule
160 }
162 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
163 handle <- openBinaryFile (elmi flags filePath) WriteMode
164 L.hPut handle (Binary.encode (name,interface))
165 hClose handle
166 writeFile (elmo flags filePath) (jsModule metaModule)
167 return (name,interface)
169printTypes interfaces moduleTypes moduleAliases moduleImports = do
170 putStrLn ""
171 let rules = Alias.rules interfaces moduleAliases moduleImports
172 forM_ (Map.toList moduleTypes) $ \(n,t) -> do
173 print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
174 putStrLn ""
176getRuntime :: Flags -> IO FilePath
177getRuntime flags =
178 case runtime flags of
179 Just fp -> return fp
180 Nothing -> getDataFileName "elm-runtime.js"
182build :: Flags -> FilePath -> IO ()
183build flags rootFile = do
184 let noPrelude = no_prelude flags
185 files <- if make flags then getSortedDependencies (src_dir flags) noPrelude rootFile
186 else return [rootFile]
187 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
188 (moduleName, interfaces) <- buildFiles flags (length files) ifaces "" files
189 js <- foldM appendToOutput BS.empty files
191 (extension, code) <- case only_js flags of
192 True -> do
193 putStr "Generating JavaScript ... "
194 return ("js", js)
195 False -> do
196 putStr "Generating HTML ... "
197 rtsPath <- getRuntime flags
198 return ("html", BS.pack . renderHtml $
199 createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
201 let targetFile = buildPath flags rootFile extension
202 createDirectoryIfMissing True (takeDirectory targetFile)
203 BS.writeFile targetFile code
204 putStrLn "Done"
206 where
207 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
208 appendToOutput js filePath =
209 do src <- BS.readFile (elmo flags filePath)
210 return (BS.append src js)
212 sources js = map Link (scripts flags) ++ [ Source js ]
215buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
216buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
217buildFiles flags numModules interfaces _ (filePath:rest) = do
218 (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
219 let interfaces' = Map.insert name interface interfaces
220 buildFiles flags numModules interfaces' name rest