git.iko.soy/elk
on 51dfa67 help sign in
elk/compiler/Compiler.hs
202 lines 7.7 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 errors -> do
126 mapM print (List.intersperse (P.text " ") errors)
127 exitFailure
128 Right modul -> do
129 case print_program flags of
130 False -> return ()
131 True -> print . pretty $ program modul
132 return modul
134 if print_types flags then printTypes metaModule else return ()
135 tipes <- Traverse.traverse Type.toSrcType (types metaModule)
136 let interface = Canonical.interface name $ ModuleInterface {
137 iTypes = tipes,
138 iAdts = datatypes metaModule,
139 iAliases = aliases metaModule
140 }
141 createDirectoryIfMissing True . dropFileName $ elmi flags filePath
142 Binary.encodeFile (elmi flags filePath) (name,interface)
143 writeFile (elmo flags filePath) (jsModule metaModule)
144 return interface
146printTypes metaModule = do
147 putStrLn ""
148 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
149 pt <- Type.extraPretty t
150 print $ variable n <+> P.text ":" <+> pt
151 putStrLn ""
153getRuntime :: Flags -> IO FilePath
154getRuntime flags =
155 case runtime flags of
156 Just fp -> return fp
157 Nothing -> getDataFileName "elm-runtime.js"
159build :: Flags -> FilePath -> IO ()
160build flags rootFile = do
161 let noPrelude = no_prelude flags
162 files <- if make flags then getSortedDependencies noPrelude rootFile else return [rootFile]
163 let ifaces = if noPrelude then Map.empty else Prelude.interfaces
164 interfaces <- buildFiles flags (length files) ifaces files
165 js <- foldM appendToOutput "" files
166 case only_js flags of
167 True -> do
168 putStr "Generating JavaScript ... "
169 writeFile (file flags rootFile "js") (genJs js)
170 putStrLn "Done"
171 False -> do
172 putStr "Generating HTML ... "
173 runtime <- getRuntime flags
174 let html = genHtml $ createHtml runtime (takeBaseName rootFile) (sources js) ""
175 writeFile (file flags rootFile "html") html
176 putStrLn "Done"
178 where
179 appendToOutput :: String -> FilePath -> IO String
180 appendToOutput js filePath =
181 do src <- readFile (elmo flags filePath)
182 return (src ++ js)
184 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
185 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
186 sources js = map Link (scripts flags) ++
187 [ Source (if minify flags then Minified else Readable) js ]
190buildFiles :: Flags -> Int -> Interfaces -> [FilePath] -> IO Interfaces
191buildFiles _ _ interfaces [] = return interfaces
192buildFiles flags numModules interfaces (filePath:rest) = do
193 interface <- buildFile flags (numModules - length rest) numModules interfaces filePath
194 let moduleName = List.intercalate "." . splitDirectories $ dropExtensions filePath
195 interfaces' = Map.insert moduleName interface interfaces
196 buildFiles flags numModules interfaces' rest
199exportInfo :: Module -> IO String
200exportInfo (Module names exs ims stmts) =
201 do print exs
202 return (show exs)