git.iko.soy/elk
on 684ec7a help sign in
elk/builder/src/Generate/Output.hs
213 lines 5.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.Output
4 ( generate
5 , generateReplFile
6 , Options(..)
7 , Output(..)
8 , output
9 )
10 where
13import Control.Monad.Trans (liftIO)
14import qualified Data.ByteString.Builder as B
15import qualified Data.Map as Map
16import Data.Monoid ((<>))
17import qualified System.Directory as Dir
18import qualified System.FilePath as FP
19import System.FilePath ((</>))
21import qualified Elm.Compiler.Module as Module
22import qualified Elm.Compiler.Objects as Obj
23import qualified Elm.Interface as I
24import qualified Elm.Name as N
25import qualified Elm.Package as Pkg
27import qualified Elm.Project.Json as Project
28import qualified Elm.Project.Summary as Summary
29import qualified File.Args as Args
30import qualified File.Crawl as Crawl
31import qualified File.IO as IO
32import qualified Generate.Functions as Functions
33import qualified Generate.Html as Html
34import qualified Reporting.Task as Task
35import qualified Stuff.Paths as Paths
36import Terminal.Args (Parser(..), suggestFiles)
40-- GENERATE
43data Options =
44 Options
45 { _mode :: Obj.Mode
46 , _target :: Obj.Target
47 , _output :: Maybe Output
48 }
51generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
52generate options summary graph@(Crawl.Graph args _ _ _ _) =
53 case args of
54 Args.Pkg _ ->
55 return ()
57 Args.Roots name names ->
58 generateMonolith options summary graph (name:names)
62-- GENERATE MONOLITH
65generateMonolith :: Options -> Summary.Summary -> Crawl.Result -> [Module.Raw] -> Task.Task ()
66generateMonolith (Options mode target maybeOutput) summary@(Summary.Summary _ project _ ifaces _) graph rootNames =
67 do let pkg = Project.getName project
68 let roots = map (Module.Canonical pkg) rootNames
69 objectGraph <- organize summary graph
70 case Obj.generate mode target ifaces objectGraph roots of
71 Obj.None ->
72 return ()
74 Obj.Some name names builder ->
75 let
76 monolith =
77 "(function(scope){\n'use strict';"
78 <> Functions.functions <> builder <> "}(this));"
79 in
80 liftIO $
81 case maybeOutput of
82 Nothing ->
83 IO.writeBuilder "elm.js" monolith
85 Just None ->
86 return ()
88 Just (JavaScript maybeDir fileName) ->
89 do path <- toWritablePath maybeDir fileName
90 IO.writeBuilder path monolith
92 Just (Html maybeDir fileName) ->
93 case names of
94 [] ->
95 do path <- toWritablePath maybeDir fileName
96 IO.writeBuilder path (Html.sandwich name monolith)
98 _:_ ->
99 return ()
103-- GENERATE REPL MONOLITH
106generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
107generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
108 do
109 objectGraph <- organize summary graph
111 let home = Module.Canonical (Project.getName project) "Elm_Repl"
112 let builder = Obj.generateForRepl objectGraph iface home name
114 liftIO $ IO.writeBuilder Paths.temp $
115 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
117 return Paths.temp
120replRecovery :: B.Builder
121replRecovery =
122 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
126-- ORGANIZE
129organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
130organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
131 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
132 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
133 return (Obj.union localObjs foreignObjs)
136loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
137loadModuleObj root name =
138 IO.readBinary (Paths.elmo root name)
141loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
142loadPackageObj ( name, (version,_) ) =
143 do dir <- Task.getPackageCacheDirFor name version
144 IO.readBinary (dir </> "objs.dat")
148-- OUTPUT
151data Output
152 = None
153 | Html (Maybe FilePath) FilePath
154 | JavaScript (Maybe FilePath) FilePath
157toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
158toWritablePath maybeDir fileName =
159 case maybeDir of
160 Nothing ->
161 do return fileName
163 Just dir ->
164 do Dir.createDirectoryIfMissing True dir
165 return (dir </> fileName)
169-- OUTPUT PARSER
172output :: Parser Output
173output =
174 Parser
175 { _singular = "output file"
176 , _plural = "output files"
177 , _parser = parseOutput
178 , _suggest = suggestFiles ["js","html"]
179 , _examples = exampleOutput
180 }
183parseOutput :: String -> Maybe Output
184parseOutput string =
185 if string == "/dev/null" || string == "NUL" || string == "$null" then
186 Just None
188 else if FP.takeExtension string == ".html" && length string > 5 then
189 splitOutput Html string
191 else if FP.takeExtension string == ".js" && length string > 3 then
192 splitOutput JavaScript string
194 else
195 Nothing
198splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
199splitOutput toOutput string =
200 case FP.splitPath string of
201 [] ->
202 Nothing
204 [name] ->
205 Just $ toOutput Nothing name
207 segments ->
208 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
211exampleOutput :: String -> IO [String]
212exampleOutput _ =
213 return [ "elm.js", "index.html", "/dev/null" ]