on 9d678a1 help sign in
elk/compiler/Compiler.hs
71 lines 2.5 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Main where
4import Control.Monad (foldM, when)
5import qualified Data.Maybe as Maybe
6import Text.Blaze.Html.Renderer.String (renderHtml)
7import qualified Data.ByteString.Lazy.Char8 as BS
8import qualified System.Console.CmdArgs as CmdArgs
9import System.Directory
10import System.Exit (exitSuccess)
11import System.FilePath
12import GHC.Conc
14import Build.Dependencies (getSortedDependencies)
15import qualified Generate.Html as Html
16import qualified Metadata.Prelude as Prelude
17import qualified Build.Utils as Utils
18import qualified Build.Flags as Flag
19import qualified Build.File as File
20import qualified Elm.Internal.Paths as Path
22main :: IO ()
23main = do setNumCapabilities =<< getNumProcessors
24 compileArgs =<< CmdArgs.cmdArgs Flag.flags
26compileArgs :: Flag.Flags -> IO ()
27compileArgs flags =
28 do when (Flag.get_runtime flags) $
29 do putStrLn Path.runtime
30 exitSuccess
31 case Flag.files flags of
32 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
33 fs -> mapM_ (build flags) fs
35build :: Flag.Flags -> FilePath -> IO ()
36build flags rootFile =
37 do let noPrelude = Flag.no_prelude flags
38 builtIns <- Prelude.interfaces noPrelude
40 files <- if Flag.make flags
41 then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
42 else return [rootFile]
44 moduleName <- File.build flags builtIns files
46 js <- foldM appendToOutput BS.empty files
48 (extension, code) <-
49 if Flag.only_js flags
50 then do putStr "Generating JavaScript ... "
51 return ("js", js)
52 else do putStr "Generating HTML ... "
53 return (makeHtml js moduleName)
55 let targetFile = Utils.buildPath flags rootFile extension
56 createDirectoryIfMissing True (takeDirectory targetFile)
57 BS.writeFile targetFile code
58 putStrLn "Done"
60 where
61 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
62 appendToOutput js filePath = do
63 src <- BS.readFile (Utils.elmo flags filePath)
64 return (BS.append src js)
66 sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
68 makeHtml js moduleName = ("html", BS.pack $ renderHtml html)
69 where
70 rtsPath = Maybe.fromMaybe Path.runtime (Flag.set_runtime flags)
71 html = Html.generate rtsPath (takeBaseName rootFile) (sources js) moduleName ""