git.iko.soy/elk
on e4e8d89 help sign in
elk/compiler/Compiler.hs
190 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, getSortedDependencies)
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"
85elmi :: Flags -> FilePath -> FilePath
86elmi flags filePath = file flags filePath "elmi"
89buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO ModuleInterface
90buildFile flags moduleNum numModules interfaces filePath =
91 do compiled <- alreadyCompiled
92 if not compiled then compile
93 else getInterface `fmap` Binary.decodeFile (elmi flags filePath)
94 where
95 getInterface :: (String, ModuleInterface) -> ModuleInterface
96 getInterface = snd
98 alreadyCompiled :: IO Bool
99 alreadyCompiled = do
100 existsi <- doesFileExist (elmi flags filePath)
101 existso <- doesFileExist (elmo flags filePath)
102 if not existsi || not existso
103 then return False
104 else do tsrc <- getModificationTime filePath
105 tint <- getModificationTime (elmo flags filePath)
106 return (tsrc < tint)
108 number :: String
109 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
111 name :: String
112 name = List.intercalate "." (splitDirectories (dropExtensions filePath))
114 compile :: IO ModuleInterface
115 compile = do
116 putStrLn (number ++ " Compiling " ++ name)
117 source <- readFile filePath
118 createDirectoryIfMissing True (output_directory flags)
119 metaModule <-
120 case buildFromSource (no_prelude flags) interfaces source of
121 Left err -> mapM print err >> exitFailure
122 Right modul -> do
123 case print_program flags of
124 False -> return ()
125 True -> print . pretty $ program modul
126 return modul
128 if print_types flags then printTypes metaModule else return ()
129 tipes <- Traverse.traverse Type.toSrcType (types metaModule)
130 let interface = Canonical.interface name $ ModuleInterface {
131 iTypes = tipes,
132 iAdts = datatypes metaModule,
133 iAliases = aliases metaModule
134 }
135 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
136 Binary.encodeFile (elmi flags filePath) (name,interface)
137 writeFile (elmo flags filePath) (jsModule metaModule)
138 return interface
140printTypes metaModule = do
141 putStrLn ""
142 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
143 pt <- Type.extraPretty t
144 print $ variable n <+> P.text ":" <+> pt
145 putStrLn ""
147getRuntime :: Flags -> IO FilePath
148getRuntime flags =
149 case runtime flags of
150 Just fp -> return fp
151 Nothing -> getDataFileName "elm-runtime.js"
153build :: Flags -> FilePath -> IO ()
154build flags rootFile = do
155 let noPrelude = no_prelude flags
156 files <- if make flags then getSortedDependencies noPrelude rootFile else return [rootFile]
157 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
158 interfaces <- buildFiles flags (length files) ifaces files
159 js <- foldM appendToOutput "" files
160 case only_js flags of
161 True -> do
162 putStr "Generating JavaScript ... "
163 writeFile (file flags rootFile "js") (genJs js)
164 putStrLn "Done"
165 False -> do
166 putStr "Generating HTML ... "
167 runtime <- getRuntime flags
168 let html = genHtml $ createHtml runtime (takeBaseName rootFile) (sources js) ""
169 writeFile (file flags rootFile "html") html
170 putStrLn "Done"
172 where
173 appendToOutput :: String -> FilePath -> IO String
174 appendToOutput js filePath =
175 do src <- readFile (elmo flags filePath)
176 return (src ++ js)
178 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
179 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
180 sources js = map Link (scripts flags) ++
181 [ Source (if minify flags then Minified else Readable) js ]
184buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
185buildFiles _ _ interfaces [] = return interfaces
186buildFiles flags numModules interfaces (filePath:rest) = do
187 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
188 let moduleName = List.intercalate "." . splitDirectories $ dropExtensions filePath
189 interfaces' = Map.insert moduleName interface interfaces
190 buildFiles flags numModules interfaces' rest