git.iko.soy/elk
on ce652d9 help sign in
elk/compiler/Compiler.hs
152 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 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 obj <-
102 if takeExtension filePath == ".js" then return source else
103 case buildFromSource (no_prelude flags) source of
104 Left err -> mapM print err >> exitFailure
105 Right modul -> return . jsModule $ (modul :: MetadataModule () ())
106 createDirectoryIfMissing True (output_directory flags)
107 writeFile (elmo flags filePath) 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 (file flags 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 (file flags rootFile "html") html
132 putStrLn "Done"
134 where
135 appendToOutput :: String -> FilePath -> IO String
136 appendToOutput js filePath =
137 do src <- readFile (elmo flags filePath)
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