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