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