git.iko.soy/elk
on f5bdb2c help sign in
elk/compiler/Compiler.hs
156 lines 5.6 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"
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 let builder file = if make flags then build flags file
64 else buildFile flags 1 1 file >> return ()
65 in case files flags of
66 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
67 fs -> mapM_ builder fs
70type Interface = String
72buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
73buildFile flags moduleNum numModules filePath =
74 do compiled <- alreadyCompiled
75 if compiled then getInterface else compile
77 where
78 file :: String -> FilePath
79 file ext = replaceExtension filePath ext
81 interface :: FilePath
82 interface = file "elmi"
84 alreadyCompiled :: IO Bool
85 alreadyCompiled = do
86 exists <- doesFileExist interface
87 if not exists then return False
88 else do tsrc <- getModificationTime filePath
89 tint <- getModificationTime interface
90 return (tsrc < tint)
92 number :: String
93 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
95 name :: String
96 name = intercalate "." (splitDirectories (dropExtensions filePath))
98 compile :: IO Interface
99 compile = do
100 putStrLn (number ++ " Compiling " ++ name)
101 source <- readFile filePath
102 js <- if takeExtension filePath == ".js" then return source else
103 case buildFromSource (no_prelude flags) source of
104 Left err -> putStrLn err >> exitFailure
105 Right modul -> return (jsModule modul)
106 writeFile interface js
107 writeFile (file "elmo") js
108 when (only_js flags) (writeFile (file "js") js)
109 return js
111 getInterface :: IO Interface
112 getInterface = do
113 readFile interface
115getRuntime :: Flags -> IO FilePath
116getRuntime flags =
117 case runtime flags of
118 Just fp -> return fp
119 Nothing -> getDataFileName "elm-runtime.js"
121build :: Flags -> FilePath -> IO ()
122build flags rootFile = do
123 files <- getSortedModuleNames rootFile
124 buildFiles flags (length files) Map.empty files
125 js <- foldM appendToOutput "" files
126 case only_js flags of
127 True -> do
128 putStr "\nGenerating JavaScript... "
129 writeFile (replaceExtension rootFile "js") (genJs js)
130 putStrLn "Done"
131 False -> do
132 putStr "\nGenerating HTML... "
133 runtime <- getRuntime flags
134 let html = genHtml $ createHtml runtime rootFile (sources js) ""
135 writeFile (replaceExtension rootFile "html") html
136 putStrLn "Done"
138 where
139 appendToOutput :: String -> FilePath -> IO String
140 appendToOutput js filePath =
141 do src <- readFile (replaceExtension filePath "elmo")
142 return (src ++ js)
144 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
145 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
146 sources js = map Link (scripts flags) ++
147 [ Source (if minify flags then Minified else Readable) js ]
150buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
151buildFiles _ _ _ [] = return ()
152buildFiles flags numModules interfaces (filePath:rest) = do
153 interface <- buildFile flags (numModules - length rest) numModules filePath
154 let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
155 interfaces' = Map.insert moduleName interface interfaces
156 buildFiles flags numModules interfaces' rest