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