git.iko.soy/elk
on 28db384 help sign in
elk/compiler/Compiler.hs
158 lines 5.7 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
4import Control.Monad (foldM, when)
5import qualified Data.Map as Map
6import Data.Either (lefts, rights)
7import Data.List (intersect, intercalate, lookup)
8import Data.Maybe (fromMaybe)
9import Data.Version (showVersion)
10import System.Console.CmdArgs
11import System.Directory
12import System.Exit
13import System.FilePath
14import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
15import qualified Text.Blaze.Html.Renderer.String as Normal
17import qualified Text.Jasmine as JS
18import qualified Data.ByteString.Lazy.Char8 as BS
20import Ast
21import Initialize (buildFromSource, getSortedModuleNames)
22import CompileToJS (jsModule)
23import GenerateHtml (createHtml, JSStyle(..), JSSource(..))
24import qualified Libraries as Libraries
25import Paths_Elm
27data Flags =
28 Flags { make :: Bool
29 , files :: [FilePath]
30 , runtime :: Maybe FilePath
31 , only_js :: Bool
32 , scripts :: [FilePath]
33 , no_prelude :: Bool
34 , minify :: Bool
35 , output_directory :: FilePath
36 }
37 deriving (Data,Typeable,Show,Eq)
39flags = Flags
40 { make = False
41 &= help "automatically compile dependencies."
42 , files = def &= args &= typ "FILES"
43 , runtime = Nothing &= typFile
44 &= help "Specify a custom location for Elm's runtime system."
45 , only_js = False
46 &= help "Compile only to JavaScript."
47 , scripts = [] &= typFile
48 &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
49 , no_prelude = False
50 &= help "Do not import Prelude by default, used only when compiling standard libraries."
51 , minify = False
52 &= help "Minify generated JavaScript and HTML"
53 , output_directory = "ElmFiles" &= typFile
54 &= help "Output files to directory specified. Defaults to ElmFiles/ directory."
55 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
56 &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
58main :: IO ()
59main = compileArgs =<< cmdArgs flags
61compileArgs :: Flags -> IO ()
62compileArgs flags =
63 case files flags of
64 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
65 fs -> mapM_ (build flags) fs
68type Interface = String
70buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
71buildFile flags moduleNum numModules filePath =
72 do compiled <- alreadyCompiled
73 if compiled then readFile elmo else compile
75 where
76 file :: String -> FilePath
77 file ext = output_directory flags </> replaceExtension filePath ext
79 elmo :: FilePath
80 elmo = file "elmo"
82 alreadyCompiled :: IO Bool
83 alreadyCompiled = do
84 exists <- doesFileExist elmo
85 if not exists then return False
86 else do tsrc <- getModificationTime filePath
87 tint <- getModificationTime elmo
88 return (tsrc < tint)
90 number :: String
91 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
93 name :: String
94 name = intercalate "." (splitDirectories (dropExtensions filePath))
96 compile :: IO Interface
97 compile = do
98 putStrLn (number ++ " Compiling " ++ name)
99 source <- readFile filePath
100 (interface,obj) <-
101 if takeExtension filePath == ".js" then return ("",source) else
102 case buildFromSource (no_prelude flags) source of
103 Left err -> putStrLn err >> exitFailure
104 Right modul -> do exs <- exportInfo modul
105 return (exs, jsModule modul)
106 createDirectoryIfMissing True (output_directory flags)
107 writeFile elmo obj
108 return obj
111getRuntime :: Flags -> IO FilePath
112getRuntime flags =
113 case runtime flags of
114 Just fp -> return fp
115 Nothing -> getDataFileName "elm-runtime.js"
117build :: Flags -> FilePath -> IO ()
118build flags rootFile = do
119 files <- if make flags then getSortedModuleNames rootFile else return [rootFile]
120 buildFiles flags (length files) Map.empty files
121 js <- foldM appendToOutput "" files
122 case only_js flags of
123 True -> do
124 putStr "Generating JavaScript ... "
125 writeFile (replaceExtension rootFile "js") (genJs js)
126 putStrLn "Done"
127 False -> do
128 putStr "Generating HTML ... "
129 runtime <- getRuntime flags
130 let html = genHtml $ createHtml runtime rootFile (sources js) ""
131 writeFile (replaceExtension rootFile "html") html
132 putStrLn "Done"
134 where
135 appendToOutput :: String -> FilePath -> IO String
136 appendToOutput js filePath =
137 do src <- readFile (output_directory flags </> replaceExtension filePath "elmo")
138 return (src ++ js)
140 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
141 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
142 sources js = map Link (scripts flags) ++
143 [ Source (if minify flags then Minified else Readable) js ]
146buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
147buildFiles _ _ _ [] = return ()
148buildFiles flags numModules interfaces (filePath:rest) = do
149 interface <- buildFile flags (numModules - length rest) numModules filePath
150 let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
151 interfaces' = Map.insert moduleName interface interfaces
152 buildFiles flags numModules interfaces' rest
155exportInfo :: Module -> IO String
156exportInfo (Module names ims exs stmts) =
157 do print exs
158 return (show exs)