git.iko.soy/elk
on dcbe2fc help sign in
elk/compiler/Compiler.hs
210 lines 8.2 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 }
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 , print_types = False
65 &= help "Print out infered types of top-level definitions."
66 , print_program = False
67 &= help "Print out an internal representation of a program."
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 L.length bits `seq` hClose handle
108 return info
109 where
110 alreadyCompiled :: IO Bool
111 alreadyCompiled = do
112 existsi <- doesFileExist (elmi flags filePath)
113 existso <- doesFileExist (elmo flags filePath)
114 if not existsi || not existso
115 then return False
116 else do tsrc <- getModificationTime filePath
117 tint <- getModificationTime (elmo flags filePath)
118 return (tsrc < tint)
120 number :: String
121 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
123 compile :: IO (String,ModuleInterface)
124 compile = do
125 source <- readFile filePath
126 let name = case getModuleName source of
127 Just n -> n
128 Nothing -> "Main"
129 putStrLn $ concat [ number, " Compiling ", name
130 , replicate (max 1 (20 - length name)) ' '
131 , "( " ++ filePath ++ " )" ]
133 createDirectoryIfMissing True (cache_dir flags)
134 createDirectoryIfMissing True (build_dir flags)
135 metaModule <-
136 case buildFromSource (no_prelude flags) interfaces source of
137 Left errors -> do
138 mapM print (List.intersperse (P.text " ") errors)
139 exitFailure
140 Right modul -> do
141 case print_program flags of
142 False -> return ()
143 True -> print . pretty $ program modul
144 return modul
146 if print_types flags then printTypes interfaces metaModule else return ()
147 let interface = Canonical.interface name $ ModuleInterface {
148 iTypes = types metaModule,
149 iAdts = datatypes metaModule,
150 iAliases = aliases metaModule,
151 iFixities = fixities metaModule
152 }
153 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
154 handle <- openBinaryFile (elmi flags filePath) WriteMode
155 L.hPut handle (Binary.encode (name,interface))
156 hClose handle
157 writeFile (elmo flags filePath) (jsModule metaModule)
158 return (name,interface)
160printTypes interfaces metaModule = do
161 putStrLn ""
162 let rules = Alias.rules interfaces metaModule
163 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
164 print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules 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 BS.empty files
181 (extension, code) <- case only_js flags of
182 True -> do
183 putStr "Generating JavaScript ... "
184 return ("js", js)
185 False -> do
186 putStr "Generating HTML ... "
187 rtsPath <- getRuntime flags
188 return ("html", BS.pack . renderHtml $
189 createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
191 let targetFile = buildPath flags rootFile extension
192 createDirectoryIfMissing True (takeDirectory targetFile)
193 BS.writeFile targetFile code
194 putStrLn "Done"
196 where
197 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
198 appendToOutput js filePath =
199 do src <- BS.readFile (elmo flags filePath)
200 return (BS.append src js)
202 sources js = map Link (scripts flags) ++ [ Source js ]
205buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
206buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
207buildFiles flags numModules interfaces _ (filePath:rest) = do
208 (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
209 let interfaces' = Map.insert name interface interfaces
210 buildFiles flags numModules interfaces' name rest