git.iko.soy/elk
on 1c91efd help sign in
elk/builder/src/Generate/Output.hs
297 lines 7.8 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 locals _ _ _) 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 do interfaces <- getInterfaces summary locals artifacts
76 return $ Mode.debug target interfaces
78 Dev ->
79 return $ Mode.dev target
81 Prod ->
82 do noDebugUses summary objectGraph
83 return $ Mode.prod target objectGraph
85 generateMonolith realMode maybeOutput summary objectGraph (name:names)
88getInterfaces
89 :: Summary.Summary
90 -> Map.Map Module.Raw a
91 -> Map.Map Module.Raw Compiler.Artifacts
92 -> Task.Task I.Interfaces
93getInterfaces (Summary.Summary root project _ interfaces _) locals artifacts =
94 let
95 pkg =
96 Project.getName project
98 addArtifact home (Compiler.Artifacts elmi _ _) ifaces =
99 (ModuleName.Canonical pkg home, elmi) : ifaces
101 addInterface home iface ifaces =
102 (ModuleName.Canonical pkg home, iface) : ifaces
104 readInterface home _ =
105 IO.readBinary (Paths.elmi root home)
106 in
107 do cached <- Map.traverseWithKey readInterface (Map.difference locals artifacts)
108 return $
109 Map.union interfaces $ Map.fromList $
110 Map.foldrWithKey addInterface (Map.foldrWithKey addArtifact [] artifacts) cached
114-- GENERATE MONOLITH
117generateMonolith
118 :: Mode.Mode
119 -> Maybe Output
120 -> Summary.Summary
121 -> Obj.Graph
122 -> [Module.Raw]
123 -> Task.Task ()
124generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
125 do let pkg = Project.getName project
126 let roots = map (Module.Canonical pkg) rootNames
127 case Obj.generate mode graph roots of
128 Obj.None ->
129 return ()
131 Obj.Some name _names builder ->
132 let
133 monolith =
134 "(function(scope){\n'use strict';"
135 <> Functions.functions <> builder <> "}(this));"
136 in
137 liftIO $
138 case maybeOutput of
139 Nothing ->
140 IO.writeBuilder "index.html" (Html.sandwich name monolith)
142 Just output_ ->
143 case output_ of
144 None ->
145 return ()
147 JavaScript maybeDir fileName ->
148 do path <- toWritablePath maybeDir fileName
149 IO.writeBuilder path monolith
151 HtmlBuilder mvar ->
152 putMVar mvar (Html.sandwich name monolith)
154 Html maybeDir fileName ->
155 do path <- toWritablePath maybeDir fileName
156 IO.writeBuilder path (Html.sandwich name monolith)
160-- GENERATE REPL MONOLITH
163generateReplFile
164 :: Bool
165 -> L.Localizer
166 -> Summary.Summary
167 -> Crawl.Result
168 -> I.Interface
169 -> N.Name
170 -> Task.Task FilePath
171generateReplFile noColors localizer summary@(Summary.Summary _ project _ _ _) graph iface name =
172 do
173 objectGraph <- organize summary graph
175 let home = Module.Canonical (Project.getName project) N.replModule
176 let builder = Obj.generateForRepl (not noColors) localizer objectGraph iface home name
178 liftIO $ IO.writeBuilder (Paths.temp "js") $
179 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
181 return (Paths.temp "js")
184replRecovery :: B.Builder
185replRecovery =
186 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
190-- ORGANIZE
193organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
194organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
195 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
196 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
197 return (Obj.union localObjs foreignObjs)
200loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
201loadModuleObj root name =
202 IO.readBinary (Paths.elmo root name)
205loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
206loadPackageObj ( name, (version,_) ) =
207 do dir <- Task.getPackageCacheDirFor name version
208 IO.readBinary (dir </> "objs.dat")
212-- NO DEBUG USES
215noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
216noDebugUses (Summary.Summary _ project _ _ _) graph =
217 case Nitpick.findDebugUses (Project.getName project) graph of
218 [] ->
219 return ()
221 m:ms ->
222 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
225noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
226noDebugUsesInPackage summary graph =
227 noDebugUses summary =<< organize summary graph
231-- OUTPUT
234data Output
235 = None
236 | Html (Maybe FilePath) FilePath
237 | JavaScript (Maybe FilePath) FilePath
238 | HtmlBuilder (MVar B.Builder)
241toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
242toWritablePath maybeDir fileName =
243 case maybeDir of
244 Nothing ->
245 do return fileName
247 Just dir ->
248 do Dir.createDirectoryIfMissing True dir
249 return (dir </> fileName)
253-- OUTPUT PARSER
256output :: Parser Output
257output =
258 Parser
259 { _singular = "output file"
260 , _plural = "output files"
261 , _parser = parseOutput
262 , _suggest = \_ -> return []
263 , _examples = exampleOutput
264 }
267parseOutput :: String -> Maybe Output
268parseOutput string =
269 if string == "/dev/null" || string == "NUL" || string == "$null" then
270 Just None
272 else if FP.takeExtension string == ".html" && length string > 5 then
273 splitOutput Html string
275 else if FP.takeExtension string == ".js" && length string > 3 then
276 splitOutput JavaScript string
278 else
279 Nothing
282splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
283splitOutput toOutput string =
284 case FP.splitPath string of
285 [] ->
286 Nothing
288 [name] ->
289 Just $ toOutput Nothing name
291 segments ->
292 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
295exampleOutput :: String -> IO [String]
296exampleOutput _ =
297 return [ "elm.js", "index.html", "/dev/null" ]