git.iko.soy/elk
on aefea20 help sign in
elk/builder/src/Generate/Output.hs
240 lines 6.2 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.Task as Task
38import qualified Stuff.Paths as Paths
39import Terminal.Args (Parser(..), suggestFiles)
43-- GENERATE
46data Options =
47 Options
48 { _mode :: Obj.Mode
49 , _target :: Obj.Target
50 , _output :: Maybe Output
51 }
54generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
55generate options summary graph@(Crawl.Graph args _ _ _ _) =
56 case args of
57 Args.Pkg _ ->
58 return ()
60 Args.Roots name names ->
61 do objectGraph <- organize summary graph
63 case _mode options of
64 Obj.Dev -> return ()
65 Obj.Prod -> noDebugUses summary objectGraph
67 generateMonolith options summary objectGraph (name:names)
71-- GENERATE MONOLITH
74generateMonolith :: Options -> Summary.Summary -> Obj.Graph -> [Module.Raw] -> Task.Task ()
75generateMonolith (Options mode target maybeOutput) (Summary.Summary _ project _ ifaces _) graph rootNames =
76 do let pkg = Project.getName project
77 let roots = map (Module.Canonical pkg) rootNames
78 case Obj.generate mode target ifaces graph roots of
79 Obj.None ->
80 return ()
82 Obj.Some name names builder ->
83 let
84 monolith =
85 "(function(scope){\n'use strict';"
86 <> Functions.functions <> builder <> "}(this));"
87 in
88 liftIO $
89 case maybeOutput of
90 Nothing ->
91 IO.writeBuilder "elm.js" monolith
93 Just None ->
94 return ()
96 Just (JavaScript maybeDir fileName) ->
97 do path <- toWritablePath maybeDir fileName
98 IO.writeBuilder path monolith
100 Just (Html maybeDir fileName) ->
101 case names of
102 [] ->
103 do path <- toWritablePath maybeDir fileName
104 IO.writeBuilder path (Html.sandwich name monolith)
106 _:_ ->
107 return ()
111-- GENERATE REPL MONOLITH
114generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
115generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
116 do
117 objectGraph <- organize summary graph
119 let home = Module.Canonical (Project.getName project) "Elm_Repl"
120 let builder = Obj.generateForRepl objectGraph iface home name
122 liftIO $ IO.writeBuilder Paths.temp $
123 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
125 return Paths.temp
128replRecovery :: B.Builder
129replRecovery =
130 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
134-- ORGANIZE
137organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
138organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
139 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
140 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
141 return (Obj.union localObjs foreignObjs)
144loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
145loadModuleObj root name =
146 IO.readBinary (Paths.elmo root name)
149loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
150loadPackageObj ( name, (version,_) ) =
151 do dir <- Task.getPackageCacheDirFor name version
152 IO.readBinary (dir </> "objs.dat")
156-- NO DEBUG USES
159noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
160noDebugUses (Summary.Summary _ project _ _ _) graph =
161 case Nitpick.findDebugUses (Project.getName project) graph of
162 [] ->
163 return ()
165 m:ms ->
166 Task.throw (Exit.CannotOptimizeDebug m ms)
169noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
170noDebugUsesInPackage summary graph =
171 noDebugUses summary =<< organize summary graph
175-- OUTPUT
178data Output
179 = None
180 | Html (Maybe FilePath) FilePath
181 | JavaScript (Maybe FilePath) FilePath
184toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
185toWritablePath maybeDir fileName =
186 case maybeDir of
187 Nothing ->
188 do return fileName
190 Just dir ->
191 do Dir.createDirectoryIfMissing True dir
192 return (dir </> fileName)
196-- OUTPUT PARSER
199output :: Parser Output
200output =
201 Parser
202 { _singular = "output file"
203 , _plural = "output files"
204 , _parser = parseOutput
205 , _suggest = suggestFiles ["js","html"]
206 , _examples = exampleOutput
207 }
210parseOutput :: String -> Maybe Output
211parseOutput string =
212 if string == "/dev/null" || string == "NUL" || string == "$null" then
213 Just None
215 else if FP.takeExtension string == ".html" && length string > 5 then
216 splitOutput Html string
218 else if FP.takeExtension string == ".js" && length string > 3 then
219 splitOutput JavaScript string
221 else
222 Nothing
225splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
226splitOutput toOutput string =
227 case FP.splitPath string of
228 [] ->
229 Nothing
231 [name] ->
232 Just $ toOutput Nothing name
234 segments ->
235 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
238exampleOutput :: String -> IO [String]
239exampleOutput _ =
240 return [ "elm.js", "index.html", "/dev/null" ]