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