git.iko.soy/elk
on 2b0bc09 help sign in
elk/builder/src/Generate/Output.hs
280 lines 7.3 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 :: L.Localizer
149 -> Summary.Summary
150 -> Crawl.Result
151 -> I.Interface
152 -> N.Name
153 -> Task.Task FilePath
154generateReplFile localizer summary@(Summary.Summary _ project _ _ _) graph iface name =
155 do
156 objectGraph <- organize summary graph
158 let home = Module.Canonical (Project.getName project) N.replModule
159 let builder = Obj.generateForRepl True localizer objectGraph iface home name
161 liftIO $ IO.writeBuilder (Paths.temp "js") $
162 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
164 return (Paths.temp "js")
167replRecovery :: B.Builder
168replRecovery =
169 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
173-- ORGANIZE
176organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
177organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
178 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
179 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
180 return (Obj.union localObjs foreignObjs)
183loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
184loadModuleObj root name =
185 IO.readBinary (Paths.elmo root name)
188loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
189loadPackageObj ( name, (version,_) ) =
190 do dir <- Task.getPackageCacheDirFor name version
191 IO.readBinary (dir </> "objs.dat")
195-- NO DEBUG USES
198noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
199noDebugUses (Summary.Summary _ project _ _ _) graph =
200 case Nitpick.findDebugUses (Project.getName project) graph of
201 [] ->
202 return ()
204 m:ms ->
205 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
208noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
209noDebugUsesInPackage summary graph =
210 noDebugUses summary =<< organize summary graph
214-- OUTPUT
217data Output
218 = None
219 | Html (Maybe FilePath) FilePath
220 | JavaScript (Maybe FilePath) FilePath
221 | HtmlBuilder (MVar B.Builder)
224toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
225toWritablePath maybeDir fileName =
226 case maybeDir of
227 Nothing ->
228 do return fileName
230 Just dir ->
231 do Dir.createDirectoryIfMissing True dir
232 return (dir </> fileName)
236-- OUTPUT PARSER
239output :: Parser Output
240output =
241 Parser
242 { _singular = "output file"
243 , _plural = "output files"
244 , _parser = parseOutput
245 , _suggest = \_ -> return []
246 , _examples = exampleOutput
247 }
250parseOutput :: String -> Maybe Output
251parseOutput string =
252 if string == "/dev/null" || string == "NUL" || string == "$null" then
253 Just None
255 else if FP.takeExtension string == ".html" && length string > 5 then
256 splitOutput Html string
258 else if FP.takeExtension string == ".js" && length string > 3 then
259 splitOutput JavaScript string
261 else
262 Nothing
265splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
266splitOutput toOutput string =
267 case FP.splitPath string of
268 [] ->
269 Nothing
271 [name] ->
272 Just $ toOutput Nothing name
274 segments ->
275 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
278exampleOutput :: String -> IO [String]
279exampleOutput _ =
280 return [ "elm.js", "index.html", "/dev/null" ]