git.iko.soy/elk
on 748c608 help sign in
elk/compiler/Compiler.hs
193 lines 7.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 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 case print_program flags of
123 False -> return ()
124 True -> print . pretty $ program modul
125 return modul
127 if print_types flags then printTypes metaModule else return ()
128 tipes <- toSrcTypes (types metaModule)
129 let interface = Canonical.interface name $ ModuleInterface {
130 iTypes = tipes,
131 iAdts = datatypes metaModule,
132 iAliases = aliases metaModule
133 }
134 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
135 Binary.encodeFile (elmi flags filePath) (name,interface)
136 writeFile (elmo flags filePath) (jsModule metaModule)
137 return interface
139toSrcTypes tipes = Traverse.traverse convert tipes
140 where
141 convert t = fmap (Parse.readType . P.render) (Type.extraPretty t)
143printTypes metaModule = do
144 putStrLn ""
145 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
146 pt <- Type.extraPretty t
147 print $ variable n <+> P.text ":" <+> pt
148 putStrLn ""
150getRuntime :: Flags -> IO FilePath
151getRuntime flags =
152 case runtime flags of
153 Just fp -> return fp
154 Nothing -> getDataFileName "elm-runtime.js"
156build :: Flags -> FilePath -> IO ()
157build flags rootFile = do
158 let noPrelude = no_prelude flags
159 files <- if make flags then getSortedModuleNames noPrelude rootFile else return [rootFile]
160 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
161 interfaces <- buildFiles flags (length files) ifaces files
162 js <- foldM appendToOutput "" files
163 case only_js flags of
164 True -> do
165 putStr "Generating JavaScript ... "
166 writeFile (file flags rootFile "js") (genJs js)
167 putStrLn "Done"
168 False -> do
169 putStr "Generating HTML ... "
170 runtime <- getRuntime flags
171 let html = genHtml $ createHtml runtime rootFile (sources js) ""
172 writeFile (file flags rootFile "html") html
173 putStrLn "Done"
175 where
176 appendToOutput :: String -> FilePath -> IO String
177 appendToOutput js filePath =
178 do src <- readFile (elmo flags filePath)
179 return (src ++ js)
181 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
182 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
183 sources js = map Link (scripts flags) ++
184 [ Source (if minify flags then Minified else Readable) js ]
187buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
188buildFiles _ _ interfaces [] = return interfaces
189buildFiles flags numModules interfaces (filePath:rest) = do
190 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
191 let moduleName = List.intercalate "." (splitDirectories (dropExtensions filePath))
192 interfaces' = Map.insert moduleName interface interfaces
193 buildFiles flags numModules interfaces' rest