git.iko.soy/elk
on f320cea help sign in
elk/builder/src/Generate/Output.hs
273 lines 7.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.Output
4 ( Mode(..)
5 , Mode.Target(..)
6 , generate
7 , generateReplFile
8 , noDebugUsesInPackage
9 , Output(..)
10 , output
11 )
12 where
15import Control.Concurrent.MVar (MVar, putMVar)
16import Control.Monad.Trans (liftIO)
17import qualified Data.ByteString.Builder as B
18import qualified Data.Map as Map
19import Data.Monoid ((<>))
20import qualified System.Directory as Dir
21import qualified System.FilePath as FP
22import System.FilePath ((</>))
24import qualified Elm.Compiler as Compiler
25import qualified Elm.Compiler.Module as Module
26import qualified Elm.Compiler.Objects as Obj
27import qualified Elm.Interface as I
28import qualified Elm.Name as N
29import qualified Elm.Package as Pkg
31import qualified AST.Module.Name as ModuleName
32import qualified Elm.Project.Json as Project
33import qualified Elm.Project.Summary as Summary
34import qualified File.Args as Args
35import qualified File.Crawl as Crawl
36import qualified File.IO as IO
37import qualified Generate.Functions as Functions
38import qualified Generate.Html as Html
39import qualified Generate.Nitpick as Nitpick
40import qualified Generate.JavaScript.Mode as Mode
41import qualified Reporting.Exit as Exit
42import qualified Reporting.Exit.Make as E
43import qualified Reporting.Task as Task
44import qualified Stuff.Paths as Paths
45import Terminal.Args (Parser(..))
49-- GENERATE
52data Mode = Debug | Dev | Prod
55generate
56 :: Mode
57 -> Mode.Target
58 -> Maybe Output
59 -> Summary.Summary
60 -> Crawl.Result
61 -> Map.Map Module.Raw Compiler.Artifacts
62 -> Task.Task ()
63generate mode target maybeOutput summary graph@(Crawl.Graph args _ _ _ _) artifacts =
64 case args of
65 Args.Pkg _ ->
66 return ()
68 Args.Roots name names ->
69 do objectGraph <- organize summary graph
71 realMode <-
72 case mode of
73 Debug ->
74 return $ Mode.debug target (getInterfaces summary artifacts)
76 Dev ->
77 return $ Mode.dev target
79 Prod ->
80 do noDebugUses summary objectGraph
81 return $ Mode.prod target objectGraph
83 generateMonolith realMode maybeOutput summary objectGraph (name:names)
86getInterfaces :: Summary.Summary -> Map.Map Module.Raw Compiler.Artifacts -> I.Interfaces
87getInterfaces (Summary.Summary _ project _ interfaces _) artifacts =
88 let
89 pkg = Project.getName project
90 addArtifact home (Compiler.Artifacts elmi _ _) ifaces =
91 Map.insert (ModuleName.Canonical pkg home) elmi ifaces
92 in
93 Map.foldrWithKey addArtifact interfaces artifacts
97-- GENERATE MONOLITH
100generateMonolith
101 :: Mode.Mode
102 -> Maybe Output
103 -> Summary.Summary
104 -> Obj.Graph
105 -> [Module.Raw]
106 -> Task.Task ()
107generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
108 do let pkg = Project.getName project
109 let roots = map (Module.Canonical pkg) rootNames
110 case Obj.generate mode graph roots of
111 Obj.None ->
112 return ()
114 Obj.Some name _names builder ->
115 let
116 monolith =
117 "(function(scope){\n'use strict';"
118 <> Functions.functions <> builder <> "}(this));"
119 in
120 liftIO $
121 case maybeOutput of
122 Nothing ->
123 IO.writeBuilder "elm.js" monolith
125 Just output_ ->
126 case output_ of
127 None ->
128 return ()
130 JavaScript maybeDir fileName ->
131 do path <- toWritablePath maybeDir fileName
132 IO.writeBuilder path monolith
134 HtmlBuilder mvar ->
135 putMVar mvar (Html.sandwich name monolith)
137 Html maybeDir fileName ->
138 do path <- toWritablePath maybeDir fileName
139 IO.writeBuilder path (Html.sandwich name monolith)
143-- GENERATE REPL MONOLITH
146generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
147generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
148 do
149 objectGraph <- organize summary graph
151 let home = Module.Canonical (Project.getName project) "Elm_Repl"
152 let builder = Obj.generateForRepl True objectGraph iface home name
154 liftIO $ IO.writeBuilder (Paths.temp "js") $
155 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
157 return (Paths.temp "js")
160replRecovery :: B.Builder
161replRecovery =
162 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
166-- ORGANIZE
169organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
170organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
171 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
172 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
173 return (Obj.union localObjs foreignObjs)
176loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
177loadModuleObj root name =
178 IO.readBinary (Paths.elmo root name)
181loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
182loadPackageObj ( name, (version,_) ) =
183 do dir <- Task.getPackageCacheDirFor name version
184 IO.readBinary (dir </> "objs.dat")
188-- NO DEBUG USES
191noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
192noDebugUses (Summary.Summary _ project _ _ _) graph =
193 case Nitpick.findDebugUses (Project.getName project) graph of
194 [] ->
195 return ()
197 m:ms ->
198 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
201noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
202noDebugUsesInPackage summary graph =
203 noDebugUses summary =<< organize summary graph
207-- OUTPUT
210data Output
211 = None
212 | Html (Maybe FilePath) FilePath
213 | JavaScript (Maybe FilePath) FilePath
214 | HtmlBuilder (MVar B.Builder)
217toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
218toWritablePath maybeDir fileName =
219 case maybeDir of
220 Nothing ->
221 do return fileName
223 Just dir ->
224 do Dir.createDirectoryIfMissing True dir
225 return (dir </> fileName)
229-- OUTPUT PARSER
232output :: Parser Output
233output =
234 Parser
235 { _singular = "output file"
236 , _plural = "output files"
237 , _parser = parseOutput
238 , _suggest = \_ -> return []
239 , _examples = exampleOutput
240 }
243parseOutput :: String -> Maybe Output
244parseOutput string =
245 if string == "/dev/null" || string == "NUL" || string == "$null" then
246 Just None
248 else if FP.takeExtension string == ".html" && length string > 5 then
249 splitOutput Html string
251 else if FP.takeExtension string == ".js" && length string > 3 then
252 splitOutput JavaScript string
254 else
255 Nothing
258splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
259splitOutput toOutput string =
260 case FP.splitPath string of
261 [] ->
262 Nothing
264 [name] ->
265 Just $ toOutput Nothing name
267 segments ->
268 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
271exampleOutput :: String -> IO [String]
272exampleOutput _ =
273 return [ "elm.js", "index.html", "/dev/null" ]