git.iko.soy/elk
on 7dbdaae help sign in
elk/builder/src/Generate/Output.hs
281 lines 7.4 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.Render.Type.Localizer as L
44import qualified Reporting.Task as Task
45import qualified Stuff.Paths as Paths
46import Terminal.Args (Parser(..))
50-- GENERATE
53data Mode = Debug | Dev | Prod
56generate
57 :: Mode
58 -> Mode.Target
59 -> Maybe Output
60 -> Summary.Summary
61 -> Crawl.Result
62 -> Map.Map Module.Raw Compiler.Artifacts
63 -> Task.Task ()
64generate mode target maybeOutput summary graph@(Crawl.Graph args _ _ _ _) artifacts =
65 case args of
66 Args.Pkg _ ->
67 return ()
69 Args.Roots name names ->
70 do objectGraph <- organize summary graph
72 realMode <-
73 case mode of
74 Debug ->
75 return $ Mode.debug target (getInterfaces summary artifacts)
77 Dev ->
78 return $ Mode.dev target
80 Prod ->
81 do noDebugUses summary objectGraph
82 return $ Mode.prod target objectGraph
84 generateMonolith realMode maybeOutput summary objectGraph (name:names)
87getInterfaces :: Summary.Summary -> Map.Map Module.Raw Compiler.Artifacts -> I.Interfaces
88getInterfaces (Summary.Summary _ project _ interfaces _) artifacts =
89 let
90 pkg = Project.getName project
91 addArtifact home (Compiler.Artifacts elmi _ _) ifaces =
92 Map.insert (ModuleName.Canonical pkg home) elmi ifaces
93 in
94 Map.foldrWithKey addArtifact interfaces artifacts
98-- GENERATE MONOLITH
101generateMonolith
102 :: Mode.Mode
103 -> Maybe Output
104 -> Summary.Summary
105 -> Obj.Graph
106 -> [Module.Raw]
107 -> Task.Task ()
108generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
109 do let pkg = Project.getName project
110 let roots = map (Module.Canonical pkg) rootNames
111 case Obj.generate mode graph roots of
112 Obj.None ->
113 return ()
115 Obj.Some name _names builder ->
116 let
117 monolith =
118 "(function(scope){\n'use strict';"
119 <> Functions.functions <> builder <> "}(this));"
120 in
121 liftIO $
122 case maybeOutput of
123 Nothing ->
124 IO.writeBuilder "elm.js" monolith
126 Just output_ ->
127 case output_ of
128 None ->
129 return ()
131 JavaScript maybeDir fileName ->
132 do path <- toWritablePath maybeDir fileName
133 IO.writeBuilder path monolith
135 HtmlBuilder mvar ->
136 putMVar mvar (Html.sandwich name monolith)
138 Html maybeDir fileName ->
139 do path <- toWritablePath maybeDir fileName
140 IO.writeBuilder path (Html.sandwich name monolith)
144-- GENERATE REPL MONOLITH
147generateReplFile
148 :: Bool
149 -> L.Localizer
150 -> Summary.Summary
151 -> Crawl.Result
152 -> I.Interface
153 -> N.Name
154 -> Task.Task FilePath
155generateReplFile noColors localizer summary@(Summary.Summary _ project _ _ _) graph iface name =
156 do
157 objectGraph <- organize summary graph
159 let home = Module.Canonical (Project.getName project) N.replModule
160 let builder = Obj.generateForRepl (not noColors) localizer objectGraph iface home name
162 liftIO $ IO.writeBuilder (Paths.temp "js") $
163 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
165 return (Paths.temp "js")
168replRecovery :: B.Builder
169replRecovery =
170 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
174-- ORGANIZE
177organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
178organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
179 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
180 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
181 return (Obj.union localObjs foreignObjs)
184loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
185loadModuleObj root name =
186 IO.readBinary (Paths.elmo root name)
189loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
190loadPackageObj ( name, (version,_) ) =
191 do dir <- Task.getPackageCacheDirFor name version
192 IO.readBinary (dir </> "objs.dat")
196-- NO DEBUG USES
199noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
200noDebugUses (Summary.Summary _ project _ _ _) graph =
201 case Nitpick.findDebugUses (Project.getName project) graph of
202 [] ->
203 return ()
205 m:ms ->
206 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
209noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
210noDebugUsesInPackage summary graph =
211 noDebugUses summary =<< organize summary graph
215-- OUTPUT
218data Output
219 = None
220 | Html (Maybe FilePath) FilePath
221 | JavaScript (Maybe FilePath) FilePath
222 | HtmlBuilder (MVar B.Builder)
225toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
226toWritablePath maybeDir fileName =
227 case maybeDir of
228 Nothing ->
229 do return fileName
231 Just dir ->
232 do Dir.createDirectoryIfMissing True dir
233 return (dir </> fileName)
237-- OUTPUT PARSER
240output :: Parser Output
241output =
242 Parser
243 { _singular = "output file"
244 , _plural = "output files"
245 , _parser = parseOutput
246 , _suggest = \_ -> return []
247 , _examples = exampleOutput
248 }
251parseOutput :: String -> Maybe Output
252parseOutput string =
253 if string == "/dev/null" || string == "NUL" || string == "$null" then
254 Just None
256 else if FP.takeExtension string == ".html" && length string > 5 then
257 splitOutput Html string
259 else if FP.takeExtension string == ".js" && length string > 3 then
260 splitOutput JavaScript string
262 else
263 Nothing
266splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
267splitOutput toOutput string =
268 case FP.splitPath string of
269 [] ->
270 Nothing
272 [name] ->
273 Just $ toOutput Nothing name
275 segments ->
276 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
279exampleOutput :: String -> IO [String]
280exampleOutput _ =
281 return [ "elm.js", "index.html", "/dev/null" ]