git.iko.soy/elk
on bf2e5eb help sign in
elk/builder/src/Generate/Output.hs
242 lines 6.3 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.Monad.Trans (liftIO)
15import qualified Data.ByteString.Builder as B
16import qualified Data.Map as Map
17import Data.Monoid ((<>))
18import qualified System.Directory as Dir
19import qualified System.FilePath as FP
20import System.FilePath ((</>))
22import qualified Elm.Compiler.Module as Module
23import qualified Elm.Compiler.Objects as Obj
24import qualified Elm.Interface as I
25import qualified Elm.Name as N
26import qualified Elm.Package as Pkg
28import qualified Elm.Project.Json as Project
29import qualified Elm.Project.Summary as Summary
30import qualified File.Args as Args
31import qualified File.Crawl as Crawl
32import qualified File.IO as IO
33import qualified Generate.Functions as Functions
34import qualified Generate.Html as Html
35import qualified Generate.Nitpick as Nitpick
36import qualified Reporting.Exit as Exit
37import qualified Reporting.Exit.Make as E
38import qualified Reporting.Task as Task
39import qualified Stuff.Paths as Paths
40import Terminal.Args (Parser(..), suggestFiles)
44-- GENERATE
47data Options =
48 Options
49 { _mode :: Obj.Mode
50 , _target :: Obj.Target
51 , _output :: Maybe Output
52 }
55generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
56generate options summary graph@(Crawl.Graph args _ _ _ _) =
57 case args of
58 Args.Pkg _ ->
59 return ()
61 Args.Roots name names ->
62 do objectGraph <- organize summary graph
64 case _mode options of
65 Obj.Debug -> return ()
66 Obj.Dev -> return ()
67 Obj.Prod -> noDebugUses summary objectGraph
69 generateMonolith options summary objectGraph (name:names)
73-- GENERATE MONOLITH
76generateMonolith :: Options -> Summary.Summary -> Obj.Graph -> [Module.Raw] -> Task.Task ()
77generateMonolith (Options mode target maybeOutput) (Summary.Summary _ project _ ifaces _) graph rootNames =
78 do let pkg = Project.getName project
79 let roots = map (Module.Canonical pkg) rootNames
80 case Obj.generate mode target ifaces graph roots of
81 Obj.None ->
82 return ()
84 Obj.Some name names builder ->
85 let
86 monolith =
87 "(function(scope){\n'use strict';"
88 <> Functions.functions <> builder <> "}(this));"
89 in
90 liftIO $
91 case maybeOutput of
92 Nothing ->
93 IO.writeBuilder "elm.js" monolith
95 Just None ->
96 return ()
98 Just (JavaScript maybeDir fileName) ->
99 do path <- toWritablePath maybeDir fileName
100 IO.writeBuilder path monolith
102 Just (Html maybeDir fileName) ->
103 case names of
104 [] ->
105 do path <- toWritablePath maybeDir fileName
106 IO.writeBuilder path (Html.sandwich name monolith)
108 _:_ ->
109 return ()
113-- GENERATE REPL MONOLITH
116generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
117generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
118 do
119 objectGraph <- organize summary graph
121 let home = Module.Canonical (Project.getName project) "Elm_Repl"
122 let builder = Obj.generateForRepl objectGraph iface home name
124 liftIO $ IO.writeBuilder (Paths.temp "js") $
125 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
127 return (Paths.temp "js")
130replRecovery :: B.Builder
131replRecovery =
132 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
136-- ORGANIZE
139organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
140organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
141 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
142 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
143 return (Obj.union localObjs foreignObjs)
146loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
147loadModuleObj root name =
148 IO.readBinary (Paths.elmo root name)
151loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
152loadPackageObj ( name, (version,_) ) =
153 do dir <- Task.getPackageCacheDirFor name version
154 IO.readBinary (dir </> "objs.dat")
158-- NO DEBUG USES
161noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
162noDebugUses (Summary.Summary _ project _ _ _) graph =
163 case Nitpick.findDebugUses (Project.getName project) graph of
164 [] ->
165 return ()
167 m:ms ->
168 Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
171noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
172noDebugUsesInPackage summary graph =
173 noDebugUses summary =<< organize summary graph
177-- OUTPUT
180data Output
181 = None
182 | Html (Maybe FilePath) FilePath
183 | JavaScript (Maybe FilePath) FilePath
186toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
187toWritablePath maybeDir fileName =
188 case maybeDir of
189 Nothing ->
190 do return fileName
192 Just dir ->
193 do Dir.createDirectoryIfMissing True dir
194 return (dir </> fileName)
198-- OUTPUT PARSER
201output :: Parser Output
202output =
203 Parser
204 { _singular = "output file"
205 , _plural = "output files"
206 , _parser = parseOutput
207 , _suggest = suggestFiles ["js","html"]
208 , _examples = exampleOutput
209 }
212parseOutput :: String -> Maybe Output
213parseOutput string =
214 if string == "/dev/null" || string == "NUL" || string == "$null" then
215 Just None
217 else if FP.takeExtension string == ".html" && length string > 5 then
218 splitOutput Html string
220 else if FP.takeExtension string == ".js" && length string > 3 then
221 splitOutput JavaScript string
223 else
224 Nothing
227splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
228splitOutput toOutput string =
229 case FP.splitPath string of
230 [] ->
231 Nothing
233 [name] ->
234 Just $ toOutput Nothing name
236 segments ->
237 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
240exampleOutput :: String -> IO [String]
241exampleOutput _ =
242 return [ "elm.js", "index.html", "/dev/null" ]