git.iko.soy/elk
on e80ea9e help sign in
elk/compiler/Compiler.hs
159 lines 5.8 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 SourceSyntax.Module
21import Initialize (buildFromSource, getSortedModuleNames)
22import Generate.JavaScript (jsModule)
23import Generate.Html (createHtml, JSStyle(..), JSSource(..))
24import qualified Metadata.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
70file :: Flags -> FilePath -> String -> FilePath
71file flags filePath ext = output_directory flags </> replaceExtension filePath ext
73elmo :: Flags -> FilePath -> FilePath
74elmo flags filePath = file flags filePath "elmo"
77buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
78buildFile flags moduleNum numModules filePath =
79 do compiled <- alreadyCompiled
80 if compiled then readFile (elmo flags filePath) else compile
82 where
83 alreadyCompiled :: IO Bool
84 alreadyCompiled = do
85 exists <- doesFileExist (elmo flags filePath)
86 if not exists then return False
87 else do tsrc <- getModificationTime filePath
88 tint <- getModificationTime (elmo flags filePath)
89 return (tsrc < tint)
91 number :: String
92 number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
94 name :: String
95 name = intercalate "." (splitDirectories (dropExtensions filePath))
97 compile :: IO Interface
98 compile = do
99 putStrLn (number ++ " Compiling " ++ name)
100 source <- readFile filePath
101 (interface,obj) <-
102 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 -> do exs <- exportInfo (modul :: Module () String)
106 return (exs, jsModule modul)
107 createDirectoryIfMissing True (output_directory flags)
108 writeFile (elmo flags filePath) obj
109 return obj
112getRuntime :: Flags -> IO FilePath
113getRuntime flags =
114 case runtime flags of
115 Just fp -> return fp
116 Nothing -> getDataFileName "elm-runtime.js"
118build :: Flags -> FilePath -> IO ()
119build flags rootFile = do
120 files <- if make flags then getSortedModuleNames rootFile else return [rootFile]
121 buildFiles flags (length files) Map.empty files
122 js <- foldM appendToOutput "" files
123 case only_js flags of
124 True -> do
125 putStr "Generating JavaScript ... "
126 writeFile (file flags rootFile "js") (genJs js)
127 putStrLn "Done"
128 False -> do
129 putStr "Generating HTML ... "
130 runtime <- getRuntime flags
131 let html = genHtml $ createHtml runtime rootFile (sources js) ""
132 writeFile (file flags rootFile "html") html
133 putStrLn "Done"
135 where
136 appendToOutput :: String -> FilePath -> IO String
137 appendToOutput js filePath =
138 do src <- readFile (elmo flags filePath)
139 return (src ++ js)
141 genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
142 genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id
143 sources js = map Link (scripts flags) ++
144 [ Source (if minify flags then Minified else Readable) js ]
147buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO ()
148buildFiles _ _ _ [] = return ()
149buildFiles flags numModules interfaces (filePath:rest) = do
150 interface <- buildFile flags (numModules - length rest) numModules filePath
151 let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
152 interfaces' = Map.insert moduleName interface interfaces
153 buildFiles flags numModules interfaces' rest
156exportInfo :: Module t v -> IO String
157exportInfo (Module names exs ims stmts) =
158 do print exs
159 return (show exs)