git.iko.soy/elk
on e6be50e help sign in
elk/compiler/Compiler.hs
211 lines 8.3 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 qualified Text.Blaze.Html.Renderer.Pretty as Pretty
17import qualified Text.Blaze.Html.Renderer.String as Normal
18import qualified Text.Jasmine as JS
19import qualified Data.ByteString.Lazy.Char8 as BS
20import qualified Data.ByteString.Lazy as L
22import qualified Metadata.Prelude as Prelude
23import qualified Transform.Canonicalize as Canonical
24import SourceSyntax.Module
25import Parse.Module (getModuleName)
26import Initialize (buildFromSource, getSortedDependencies)
27import Generate.JavaScript (jsModule)
28import Generate.Html (createHtml, JSStyle(..), JSSource(..))
29import Paths_Elm
31import SourceSyntax.PrettyPrint (pretty, variable)
32import Text.PrettyPrint as P
33import qualified Type.Type as Type
35data Flags =
36 Flags { make :: Bool
37 , files :: [FilePath]
38 , runtime :: Maybe FilePath
39 , only_js :: Bool
40 , print_types :: Bool
41 , print_program :: Bool
42 , scripts :: [FilePath]
43 , no_prelude :: Bool
44 , minify :: Bool
45 , cache_dir :: FilePath
46 , build_dir :: FilePath
47 }
48 deriving (Data,Typeable,Show,Eq)
50flags = Flags
51 { make = False
52 &= help "automatically compile dependencies."
53 , files = def &= args &= typ "FILES"
54 , runtime = Nothing &= typFile
55 &= help "Specify a custom location for Elm's runtime system."
56 , only_js = False
57 &= help "Compile only to JavaScript."
58 , print_types = False
59 &= help "Print out infered types of top-level definitions."
60 , print_program = False
61 &= help "Print out an internal representation of a program."
62 , scripts = [] &= typFile
63 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
64 , no_prelude = False
65 &= help "Do not import Prelude by default, used only when compiling standard libraries."
66 , minify = False
67 &= help "Minify generated JavaScript and HTML"
68 , cache_dir = "cache" &= typFile
69 &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."
70 , build_dir = "build" &= typFile
71 &= help "Directory for generated HTML and JS files. Defaults to build/ directory."
72 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
73 &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
75main :: IO ()
76main = do setNumCapabilities =<< getNumProcessors
77 compileArgs =<< cmdArgs flags
79compileArgs :: Flags -> IO ()
80compileArgs flags =
81 case files flags of
82 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
83 fs -> mapM_ (build flags) fs
86buildPath :: Flags -> FilePath -> String -> FilePath
87buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
89cachePath :: Flags -> FilePath -> String -> FilePath
90cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
92elmo :: Flags -> FilePath -> FilePath
93elmo flags filePath = cachePath flags filePath "elmo"
95elmi :: Flags -> FilePath -> FilePath
96elmi flags filePath = cachePath flags filePath "elmi"
99buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String,ModuleInterface)
100buildFile flags moduleNum numModules interfaces filePath =
101 do compiled <- alreadyCompiled
102 case compiled of
103 False -> compile
104 True -> do
105 handle <- openBinaryFile (elmi flags filePath) ReadMode
106 bits <- L.hGetContents handle
107 let info :: (String, ModuleInterface)
108 info = Binary.decode bits
109 L.length bits `seq` hClose handle
110 return info
111 where
112 alreadyCompiled :: IO Bool
113 alreadyCompiled = do
114 existsi <- doesFileExist (elmi flags filePath)
115 existso <- doesFileExist (elmo flags filePath)
116 if not existsi || not existso
117 then return False
118 else do tsrc <- getModificationTime filePath
119 tint <- getModificationTime (elmo flags filePath)
120 return (tsrc < tint)
122 number :: String
123 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
125 compile :: IO (String,ModuleInterface)
126 compile = do
127 source <- readFile filePath
128 let name = case getModuleName source of
129 Just n -> n
130 Nothing -> "Main"
131 putStrLn $ concat [ number, " Compiling ", name
132 , replicate (max 1 (20 - length name)) ' '
133 , "( " ++ filePath ++ " )" ]
135 createDirectoryIfMissing True (cache_dir flags)
136 createDirectoryIfMissing True (build_dir flags)
137 metaModule <-
138 case buildFromSource (no_prelude flags) interfaces source of
139 Left errors -> do
140 mapM print (List.intersperse (P.text " ") errors)
141 exitFailure
142 Right modul -> do
143 case print_program flags of
144 False -> return ()
145 True -> print . pretty $ program modul
146 return modul
148 if print_types flags then printTypes metaModule else return ()
149 let interface = Canonical.interface name $ ModuleInterface {
150 iTypes = types metaModule,
151 iAdts = datatypes metaModule,
152 iAliases = aliases metaModule
153 }
154 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
155 handle <- openBinaryFile (elmi flags filePath) WriteMode
156 L.hPut handle (Binary.encode (name,interface))
157 hClose handle
158 writeFile (elmo flags filePath) (jsModule metaModule)
159 return (name,interface)
161printTypes metaModule = do
162 putStrLn ""
163 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
164 print $ variable n <+> P.text ":" <+> pretty t
165 putStrLn ""
167getRuntime :: Flags -> IO FilePath
168getRuntime flags =
169 case runtime flags of
170 Just fp -> return fp
171 Nothing -> getDataFileName "elm-runtime.js"
173build :: Flags -> FilePath -> IO ()
174build flags rootFile = do
175 let noPrelude = no_prelude flags
176 files <- if make flags then getSortedDependencies noPrelude rootFile else return [rootFile]
177 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
178 (moduleName, interfaces) <- buildFiles flags (length files) ifaces "" files
179 js <- foldM appendToOutput "" files
180 case only_js flags of
181 True -> do
182 putStr "Generating JavaScript ... "
183 writeFile (buildPath flags rootFile "js") (genJs js)
184 putStrLn "Done"
185 False -> do
186 putStr "Generating HTML ... "
187 runtime <- getRuntime flags
188 let html = genHtml $ createHtml runtime (takeBaseName rootFile) (sources js) moduleName ""
189 htmlFile = buildPath flags rootFile "html"
190 createDirectoryIfMissing True (takeDirectory htmlFile)
191 writeFile htmlFile html
192 putStrLn "Done"
194 where
195 appendToOutput :: String -> FilePath -> IO String
196 appendToOutput js filePath =
197 do src <- readFile (elmo flags filePath)
198 return (src ++ js)
200 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
201 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
202 sources js = map Link (scripts flags) ++
203 [ Source (if minify flags then Minified else Readable) js ]
206buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
207buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
208buildFiles flags numModules interfaces _ (filePath:rest) = do
209 (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
210 let interfaces' = Map.insert name interface interfaces
211 buildFiles flags numModules interfaces' name rest