@@ -1,295 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
8− , noDebugUsesInPackage
15−import Control.Concurrent.MVar (MVar, putMVar)
16−import Control.Monad.Trans (liftIO)
17−import qualified Data.ByteString.Builder as B
18−import qualified Data.Map as Map
19−import Data.Monoid ((<>))
20−import qualified Data.Name as Name
21−import qualified System.Directory as Dir
22−import qualified System.FilePath as FP
23−import System.FilePath ((</>))
25−import qualified Elm.Compiler as Compiler
26−import qualified Elm.Compiler.Objects as Obj
27−import qualified Elm.Interface as I
28−import qualified Elm.ModuleName as ModuleName
29−import qualified Elm.Package as Pkg
30−import qualified Elm.Project.Json as Project
31−import qualified Elm.Project.Summary as Summary
32−import qualified File.Args as Args
33−import qualified File.Crawl as Crawl
34−import qualified File.IO as IO
35−import qualified Generate.Functions as Functions
36−import qualified Generate.Html as Html
37−import qualified Generate.Nitpick as Nitpick
38−import qualified Generate.JavaScript.Mode as Mode
39−import qualified Reporting.Exit as Exit
40−import qualified Reporting.Exit.Make as E
41−import qualified Reporting.Render.Type.Localizer as L
42−import qualified Reporting.Task as Task
43−import qualified Stuff.Paths as Paths
44−import Terminal.Args (Parser(..))
51−data Mode = Debug | Dev | Prod
60− -> Map.Map ModuleName.Raw Compiler.Artifacts
62−generate mode target maybeOutput summary graph@(Crawl.Graph args locals _ _ _) artifacts =
67− Args.Roots name names ->
68− do objectGraph <- organize summary graph
73− do interfaces <- getInterfaces summary locals artifacts
74− return $ Mode.debug target interfaces
77− return $ Mode.dev target
80− do noDebugUses summary objectGraph
81− return $ Mode.prod target objectGraph
83− generateMonolith realMode maybeOutput summary objectGraph (name:names)
88− -> Map.Map ModuleName.Raw a
89− -> Map.Map ModuleName.Raw Compiler.Artifacts
90− -> Task.Task I.Interfaces
91−getInterfaces (Summary.Summary root project _ interfaces _) locals artifacts =
94− Project.getName project
96− addArtifact home (Compiler.Artifacts elmi _ _) ifaces =
97− (ModuleName.Canonical pkg home, elmi) : ifaces
99− addInterface home iface ifaces =
100− (ModuleName.Canonical pkg home, iface) : ifaces
102− readInterface home _ =
103− IO.readBinary (Paths.elmi root home)
105− do cached <- Map.traverseWithKey readInterface (Map.difference locals artifacts)
107− Map.union interfaces $ Map.fromList $
108− Map.foldrWithKey addInterface (Map.foldrWithKey addArtifact [] artifacts) cached
122−generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
123− do let pkg = Project.getName project
124− let roots = map (ModuleName.Canonical pkg) rootNames
125− case Obj.generate mode graph roots of
129− Obj.Some name _names builder ->
132− "(function(scope){\n'use strict';"
133− <> Functions.functions <> builder <> "}(this));"
138− IO.writeBuilder "index.html" (Html.sandwich name monolith)
145− JavaScript maybeDir fileName ->
146− do path <- toWritablePath maybeDir fileName
147− IO.writeBuilder path monolith
150− putMVar mvar (Html.sandwich name monolith)
152− Html maybeDir fileName ->
153− do path <- toWritablePath maybeDir fileName
154− IO.writeBuilder path (Html.sandwich name monolith)
158−-- GENERATE REPL MONOLITH
168− -> Task.Task FilePath
169−generateReplFile noColors localizer summary@(Summary.Summary _ project _ _ _) graph iface name =
171− objectGraph <- organize summary graph
173− let home = ModuleName.Canonical (Project.getName project) Name.replModule
174− let builder = Obj.generateForRepl (not noColors) localizer objectGraph iface home name
176− liftIO $ IO.writeBuilder (Paths.temp "js") $
177− replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
179− return (Paths.temp "js")
182−replRecovery :: B.Builder
184− "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
191−organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
192−organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
193− do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
194− foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
195− return (Obj.union localObjs foreignObjs)
198−loadModuleObj :: FilePath -> ModuleName.Raw -> Task.Task Obj.Graph
199−loadModuleObj root name =
200− IO.readBinary (Paths.elmo root name)
203−loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
204−loadPackageObj ( name, (version,_) ) =
205− do dir <- Task.getPackageCacheDirFor name version
206− IO.readBinary (dir </> "objs.dat")
213−noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
214−noDebugUses (Summary.Summary _ project _ _ _) graph =
215− case Nitpick.findDebugUses (Project.getName project) graph of
220− Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
223−noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
224−noDebugUsesInPackage summary graph =
225− noDebugUses summary =<< organize summary graph
234− | Html (Maybe FilePath) FilePath
235− | JavaScript (Maybe FilePath) FilePath
236− | HtmlBuilder (MVar B.Builder)
239−toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
240−toWritablePath maybeDir fileName =
246− do Dir.createDirectoryIfMissing True dir
247− return (dir </> fileName)
254−output :: Parser Output
257− { _singular = "output file"
258− , _plural = "output files"
259− , _parser = parseOutput
260− , _suggest = \_ -> return []
261− , _examples = exampleOutput
265−parseOutput :: String -> Maybe Output
267− if string == "/dev/null" || string == "NUL" || string == "$null" then
270− else if FP.takeExtension string == ".html" && length string > 5 then
271− splitOutput Html string
273− else if FP.takeExtension string == ".js" && length string > 3 then
274− splitOutput JavaScript string
280−splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
281−splitOutput toOutput string =
282− case FP.splitPath string of
287− Just $ toOutput Nothing name
290− Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
293−exampleOutput :: String -> IO [String]
295− return [ "elm.js", "index.html", "/dev/null" ]