git.iko.soy/elk
on bf83edc help sign in
elk/builder/src/Generate/Output.hs
244 lines 6.6 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.Module as Module
25import qualified Elm.Compiler.Objects as Obj
26import qualified Elm.Interface as I
27import qualified Elm.Name as N
28import qualified Elm.Package as Pkg
30import qualified Elm.Project.Json as Project
31import qualified Elm.Project.Summary as Summary
32import qualified File.Args as Args
33import qualified File.Crawl as Crawl
34import qualified File.IO as IO
35import qualified Generate.Functions as Functions
36import qualified Generate.Html as Html
37import qualified Generate.Nitpick as Nitpick
38import qualified Generate.JavaScript.Mode as Mode
39import qualified Reporting.Exit as Exit
40import qualified Reporting.Exit.Make as E
41import qualified Reporting.Task as Task
42import qualified Stuff.Paths as Paths
43import Terminal.Args (Parser(..))
47-- GENERATE
50data Mode = Debug | Dev | Prod
53generate :: Mode -> Mode.Target -> Maybe Output -> Summary.Summary -> Crawl.Result -> Task.Task ()
54generate mode target maybeOutput summary graph@(Crawl.Graph args _ _ _ _) =
55 case args of
56 Args.Pkg _ ->
57 return ()
59 Args.Roots name names ->
60 do objectGraph <- organize summary graph
62 realMode <-
63 case mode of
64 Debug -> return (Mode.debug target (error "TODO"))
65 Dev -> return (Mode.dev target)
66 Prod ->
67 do noDebugUses summary objectGraph
68 return (Mode.prod target objectGraph)
70 generateMonolith realMode maybeOutput summary objectGraph (name:names)
74-- GENERATE MONOLITH
77generateMonolith :: Mode.Mode -> Maybe Output -> Summary.Summary -> Obj.Graph -> [Module.Raw] -> Task.Task ()
78generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
79 do let pkg = Project.getName project
80 let roots = map (Module.Canonical pkg) rootNames
81 case Obj.generate mode graph roots of
82 Obj.None ->
83 return ()
85 Obj.Some name _names builder ->
86 let
87 monolith =
88 "(function(scope){\n'use strict';"
89 <> Functions.functions <> builder <> "}(this));"
90 in
91 liftIO $
92 case maybeOutput of
93 Nothing ->
94 IO.writeBuilder "elm.js" monolith
96 Just output_ ->
97 case output_ of
98 None ->
99 return ()
101 JavaScript maybeDir fileName ->
102 do path <- toWritablePath maybeDir fileName
103 IO.writeBuilder path monolith
105 HtmlBuilder mvar ->
106 putMVar mvar (Html.sandwich name monolith)
108 Html maybeDir fileName ->
109 do path <- toWritablePath maybeDir fileName
110 IO.writeBuilder path (Html.sandwich name monolith)
114-- GENERATE REPL MONOLITH
117generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
118generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
119 do
120 objectGraph <- organize summary graph
122 let home = Module.Canonical (Project.getName project) "Elm_Repl"
123 let builder = Obj.generateForRepl objectGraph iface home name
125 liftIO $ IO.writeBuilder (Paths.temp "js") $
126 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
128 return (Paths.temp "js")
131replRecovery :: B.Builder
132replRecovery =
133 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
137-- ORGANIZE
140organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
141organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
142 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
143 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
144 return (Obj.union localObjs foreignObjs)
147loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
148loadModuleObj root name =
149 IO.readBinary (Paths.elmo root name)
152loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
153loadPackageObj ( name, (version,_) ) =
154 do dir <- Task.getPackageCacheDirFor name version
155 IO.readBinary (dir </> "objs.dat")
159-- NO DEBUG USES
162noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
163noDebugUses (Summary.Summary _ project _ _ _) graph =
164 case Nitpick.findDebugUses (Project.getName project) graph of
165 [] ->
166 return ()
168 m:ms ->
169 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
172noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
173noDebugUsesInPackage summary graph =
174 noDebugUses summary =<< organize summary graph
178-- OUTPUT
181data Output
182 = None
183 | Html (Maybe FilePath) FilePath
184 | JavaScript (Maybe FilePath) FilePath
185 | HtmlBuilder (MVar B.Builder)
188toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
189toWritablePath maybeDir fileName =
190 case maybeDir of
191 Nothing ->
192 do return fileName
194 Just dir ->
195 do Dir.createDirectoryIfMissing True dir
196 return (dir </> fileName)
200-- OUTPUT PARSER
203output :: Parser Output
204output =
205 Parser
206 { _singular = "output file"
207 , _plural = "output files"
208 , _parser = parseOutput
209 , _suggest = \_ -> return []
210 , _examples = exampleOutput
211 }
214parseOutput :: String -> Maybe Output
215parseOutput string =
216 if string == "/dev/null" || string == "NUL" || string == "$null" then
217 Just None
219 else if FP.takeExtension string == ".html" && length string > 5 then
220 splitOutput Html string
222 else if FP.takeExtension string == ".js" && length string > 3 then
223 splitOutput JavaScript string
225 else
226 Nothing
229splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
230splitOutput toOutput string =
231 case FP.splitPath string of
232 [] ->
233 Nothing
235 [name] ->
236 Just $ toOutput Nothing name
238 segments ->
239 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
242exampleOutput :: String -> IO [String]
243exampleOutput _ =
244 return [ "elm.js", "index.html", "/dev/null" ]