git.iko.soy/elk
on 0e89c32 help sign in
elk/compiler/Compiler.hs
194 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
13import GHC.Conc
15import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
16import qualified Text.Blaze.Html.Renderer.String as Normal
17import qualified Text.Jasmine as JS
18import qualified Data.ByteString.Lazy.Char8 as BS
20import qualified Metadata.Prelude as Prelude
21import qualified Transform.Canonicalize as Canonical
22import SourceSyntax.Module
23import Initialize (buildFromSource, getSortedDependencies)
24import Generate.JavaScript (jsModule)
25import Generate.Html (createHtml, JSStyle(..), JSSource(..))
26import Paths_Elm
28import SourceSyntax.PrettyPrint (pretty, variable)
29import Text.PrettyPrint as P
30import qualified Type.Type as Type
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 = do setNumCapabilities =<< getNumProcessors
72 compileArgs =<< cmdArgs flags
74compileArgs :: Flags -> IO ()
75compileArgs flags =
76 case files flags of
77 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
78 fs -> mapM_ (build flags) fs
81file :: Flags -> FilePath -> String -> FilePath
82file flags filePath ext = output_directory flags </> replaceExtension filePath ext
84elmo :: Flags -> FilePath -> FilePath
85elmo flags filePath = file flags filePath "elmo"
87elmi :: Flags -> FilePath -> FilePath
88elmi flags filePath = file flags filePath "elmi"
91buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO ModuleInterface
92buildFile flags moduleNum numModules interfaces filePath =
93 do compiled <- alreadyCompiled
94 if not compiled then compile
95 else getInterface `fmap` Binary.decodeFile (elmi flags filePath)
96 where
97 getInterface :: (String, ModuleInterface) -> ModuleInterface
98 getInterface = snd
100 alreadyCompiled :: IO Bool
101 alreadyCompiled = do
102 existsi <- doesFileExist (elmi flags filePath)
103 existso <- doesFileExist (elmo flags filePath)
104 if not existsi || not existso
105 then return False
106 else do tsrc <- getModificationTime filePath
107 tint <- getModificationTime (elmo flags filePath)
108 return (tsrc < tint)
110 number :: String
111 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
113 name :: String
114 name = List.intercalate "." (splitDirectories (dropExtensions filePath))
116 compile :: IO ModuleInterface
117 compile = do
118 putStrLn $ concat [ number, " Compiling ", name
119 , replicate (max 1 (20 - length name)) ' '
120 , "( " ++ filePath ++ " )" ]
121 source <- readFile filePath
122 createDirectoryIfMissing True (output_directory flags)
123 metaModule <-
124 case buildFromSource (no_prelude flags) interfaces source of
125 Left err -> mapM print err >> exitFailure
126 Right modul -> do
127 case print_program flags of
128 False -> return ()
129 True -> print . pretty $ program modul
130 return modul
132 if print_types flags then printTypes metaModule else return ()
133 tipes <- Traverse.traverse Type.toSrcType (types metaModule)
134 let interface = Canonical.interface name $ ModuleInterface {
135 iTypes = tipes,
136 iAdts = datatypes metaModule,
137 iAliases = aliases metaModule
138 }
139 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
140 Binary.encodeFile (elmi flags filePath) (name,interface)
141 writeFile (elmo flags filePath) (jsModule metaModule)
142 return interface
144printTypes metaModule = do
145 putStrLn ""
146 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
147 pt <- Type.extraPretty t
148 print $ variable n <+> P.text ":" <+> pt
149 putStrLn ""
151getRuntime :: Flags -> IO FilePath
152getRuntime flags =
153 case runtime flags of
154 Just fp -> return fp
155 Nothing -> getDataFileName "elm-runtime.js"
157build :: Flags -> FilePath -> IO ()
158build flags rootFile = do
159 let noPrelude = no_prelude flags
160 files <- if make flags then getSortedDependencies noPrelude rootFile else return [rootFile]
161 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
162 interfaces <- buildFiles flags (length files) ifaces files
163 js <- foldM appendToOutput "" files
164 case only_js flags of
165 True -> do
166 putStr "Generating JavaScript ... "
167 writeFile (file flags rootFile "js") (genJs js)
168 putStrLn "Done"
169 False -> do
170 putStr "Generating HTML ... "
171 runtime <- getRuntime flags
172 let html = genHtml $ createHtml runtime (takeBaseName rootFile) (sources js) ""
173 writeFile (file flags rootFile "html") html
174 putStrLn "Done"
176 where
177 appendToOutput :: String -> FilePath -> IO String
178 appendToOutput js filePath =
179 do src <- readFile (elmo flags filePath)
180 return (src ++ js)
182 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
183 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
184 sources js = map Link (scripts flags) ++
185 [ Source (if minify flags then Minified else Readable) js ]
188buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
189buildFiles _ _ interfaces [] = return interfaces
190buildFiles flags numModules interfaces (filePath:rest) = do
191 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
192 let moduleName = List.intercalate "." . splitDirectories $ dropExtensions filePath
193 interfaces' = Map.insert moduleName interface interfaces
194 buildFiles flags numModules interfaces' rest