git.iko.soy/elk
on eaa751d help sign in
elk/compiler/Compiler.hs
182 lines 6.9 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 Data.Binary (encodeFile, decodeFile)
8import Data.Version (showVersion)
9import System.Console.CmdArgs hiding (program)
10import System.Directory
11import System.Exit
12import System.FilePath
14import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
15import qualified Text.Blaze.Html.Renderer.String as Normal
16import qualified Text.Jasmine as JS
17import qualified Data.ByteString.Lazy.Char8 as BS
19import SourceSyntax.Module
20import Initialize (buildFromSource, getSortedModuleNames, Interfaces)
21import Generate.JavaScript (jsModule)
22import Generate.Html (createHtml, JSStyle(..), JSSource(..))
23import Paths_Elm
25import SourceSyntax.PrettyPrint (pretty)
26import Text.PrettyPrint as P
27import qualified Type.Type as Type
28import qualified Parse.Type as Parse
29import qualified Data.Traversable as Traverse
31data Flags =
32 Flags { make :: Bool
33 , files :: [FilePath]
34 , runtime :: Maybe FilePath
35 , only_js :: Bool
36 , print_types :: Bool
37 , print_program :: Bool
38 , scripts :: [FilePath]
39 , no_prelude :: Bool
40 , minify :: Bool
41 , output_directory :: FilePath
42 }
43 deriving (Data,Typeable,Show,Eq)
45flags = Flags
46 { make = False
47 &= help "automatically compile dependencies."
48 , files = def &= args &= typ "FILES"
49 , runtime = Nothing &= typFile
50 &= help "Specify a custom location for Elm's runtime system."
51 , only_js = False
52 &= help "Compile only to JavaScript."
53 , print_types = False
54 &= help "Print out infered types of top-level definitions."
55 , print_program = False
56 &= help "Print out an internal representation of a program."
57 , scripts = [] &= typFile
58 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
59 , no_prelude = False
60 &= help "Do not import Prelude by default, used only when compiling standard libraries."
61 , minify = False
62 &= help "Minify generated JavaScript and HTML"
63 , output_directory = "ElmFiles" &= typFile
64 &= help "Output files to directory specified. Defaults to ElmFiles/ directory."
65 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
66 &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
68main :: IO ()
69main = compileArgs =<< cmdArgs flags
71compileArgs :: Flags -> IO ()
72compileArgs flags =
73 case files flags of
74 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
75 fs -> mapM_ (build flags) fs
78file :: Flags -> FilePath -> String -> FilePath
79file flags filePath ext = output_directory flags </> replaceExtension filePath ext
81elmo :: Flags -> FilePath -> FilePath
82elmo flags filePath = file flags filePath "elmo"
83elmi flags filePath = file flags filePath "elmi"
86buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO ModuleInterface
87buildFile flags moduleNum numModules interfaces filePath =
88 do compiled <- alreadyCompiled
89 if compiled then decodeFile (elmi flags filePath) else compile
91 where
92 alreadyCompiled :: IO Bool
93 alreadyCompiled = do
94 exists <- doesFileExist (elmo flags filePath)
95 if not exists then return False
96 else do tsrc <- getModificationTime filePath
97 tint <- getModificationTime (elmo flags filePath)
98 return (tsrc < tint)
100 number :: String
101 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
103 name :: String
104 name = List.intercalate "." (splitDirectories (dropExtensions filePath))
106 compile :: IO ModuleInterface
107 compile = do
108 putStrLn (number ++ " Compiling " ++ name)
109 source <- readFile filePath
110 createDirectoryIfMissing True (output_directory flags)
111 metaModule <-
112 case buildFromSource interfaces source of
113 Left err -> mapM print err >> exitFailure
114 Right modul -> do
115 if print_program flags then print . pretty $ program modul else return ()
116 return modul
118 if print_types flags then printTypes metaModule else return ()
119 tipes <- toSrcTypes (types metaModule)
120 let interface = ModuleInterface {
121 iTypes = tipes,
122 iAdts = datatypes metaModule
123 }
124 encodeFile (elmi flags filePath) interface
125 let js = jsModule metaModule
126 writeFile (elmo flags filePath) js
127 return interface
129toSrcTypes tipes = Traverse.traverse convert tipes
130 where
131 convert t = fmap (Parse.readType . P.render) (Type.extraPretty t)
133printTypes metaModule = do
134 putStrLn ""
135 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
136 pt <- Type.extraPretty t
137 print $ P.text n <+> P.text ":" <+> pt
138 putStrLn ""
140getRuntime :: Flags -> IO FilePath
141getRuntime flags =
142 case runtime flags of
143 Just fp -> return fp
144 Nothing -> getDataFileName "elm-runtime.js"
146build :: Flags -> FilePath -> IO ()
147build flags rootFile = do
148 files <- if make flags then getSortedModuleNames rootFile else return [rootFile]
149 let initialInterface = if no_prelude flags then Map.empty else Map.empty
150 interfaces <- buildFiles flags (length files) initialInterface files
151 js <- foldM appendToOutput "" files
152 case only_js flags of
153 True -> do
154 putStr "Generating JavaScript ... "
155 writeFile (file flags rootFile "js") (genJs js)
156 putStrLn "Done"
157 False -> do
158 putStr "Generating HTML ... "
159 runtime <- getRuntime flags
160 let html = genHtml $ createHtml runtime rootFile (sources js) ""
161 writeFile (file flags rootFile "html") html
162 putStrLn "Done"
164 where
165 appendToOutput :: String -> FilePath -> IO String
166 appendToOutput js filePath =
167 do src <- readFile (elmo flags filePath)
168 return (src ++ js)
170 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
171 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
172 sources js = map Link (scripts flags) ++
173 [ Source (if minify flags then Minified else Readable) js ]
176buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
177buildFiles _ _ interfaces [] = return interfaces
178buildFiles flags numModules interfaces (filePath:rest) = do
179 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
180 let moduleName = List.intercalate "." (splitDirectories (dropExtensions filePath))
181 interfaces' = Map.insert moduleName interface interfaces
182 buildFiles flags numModules interfaces' rest