git.iko.soy/elk
on 2ec15df help sign in
elk/builder/src/Generate/Output.hs
244 lines 6.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.Output
4 ( generate
5 , generateReplFile
6 , noDebugUsesInPackage
7 , Options(..)
8 , Output(..)
9 , output
10 )
11 where
14import Control.Concurrent.MVar (MVar, putMVar)
15import Control.Monad.Trans (liftIO)
16import qualified Data.ByteString.Builder as B
17import qualified Data.Map as Map
18import Data.Monoid ((<>))
19import qualified System.Directory as Dir
20import qualified System.FilePath as FP
21import System.FilePath ((</>))
23import qualified Elm.Compiler.Module as Module
24import qualified Elm.Compiler.Objects as Obj
25import qualified Elm.Interface as I
26import qualified Elm.Name as N
27import qualified Elm.Package as Pkg
29import qualified Elm.Project.Json as Project
30import qualified Elm.Project.Summary as Summary
31import qualified File.Args as Args
32import qualified File.Crawl as Crawl
33import qualified File.IO as IO
34import qualified Generate.Functions as Functions
35import qualified Generate.Html as Html
36import qualified Generate.Nitpick as Nitpick
37import qualified Reporting.Exit as Exit
38import qualified Reporting.Exit.Make as E
39import qualified Reporting.Task as Task
40import qualified Stuff.Paths as Paths
41import Terminal.Args (Parser(..))
45-- GENERATE
48data Options =
49 Options
50 { _mode :: Obj.Mode
51 , _target :: Obj.Target
52 , _output :: Maybe Output
53 }
56generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
57generate options summary graph@(Crawl.Graph args _ _ _ _) =
58 case args of
59 Args.Pkg _ ->
60 return ()
62 Args.Roots name names ->
63 do objectGraph <- organize summary graph
65 case _mode options of
66 Obj.Debug -> return ()
67 Obj.Dev -> return ()
68 Obj.Prod -> noDebugUses summary objectGraph
70 generateMonolith options summary objectGraph (name:names)
74-- GENERATE MONOLITH
77generateMonolith :: Options -> Summary.Summary -> Obj.Graph -> [Module.Raw] -> Task.Task ()
78generateMonolith (Options mode target maybeOutput) (Summary.Summary _ project _ ifaces _) graph rootNames =
79 do let pkg = Project.getName project
80 let roots = map (Module.Canonical pkg) rootNames
81 case Obj.generate mode target ifaces 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" ]