git.iko.soy/elk
on 2ea433c help sign in
elk/builder/src/Generate/Output.hs
195 lines 4.9 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.List.NonEmpty as NonEmpty
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.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 Reporting.Task as Task
34import qualified Stuff.Paths as Paths
35import Terminal.Args (Parser(..), suggestFiles)
39-- GENERATE
42data Options =
43 Options
44 { _warn :: Bool
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 names ->
58 generateMonolith options summary graph (NonEmpty.toList names)
62-- GENERATE MONOLITH
65generateMonolith :: Options -> Summary.Summary -> Crawl.Result -> [Module.Raw] -> Task.Task ()
66generateMonolith (Options _ debug target output_) summary@(Summary.Summary _ project _ ifaces _) graph names =
67 do
68 objectGraph <- organize summary graph
69 let pkg = Project.getName project
70 let roots = map (Module.Canonical pkg) names
71 let (Right builder) = Obj.generate debug target ifaces objectGraph roots
72 let monolith =
73 "(function(scope){\n'use strict';" <> Functions.functions <> builder <> "}(this));"
75 liftIO $
76 case output_ of
77 Nothing ->
78 IO.writeBuilder "elm.js" monolith
80 Just None ->
81 return ()
83 Just (Custom maybeDir fileName) ->
84 do path <- safeCustomPath maybeDir fileName
85 IO.writeBuilder path monolith
89-- GENERATE REPL MONOLITH
92generateReplFile :: Summary.Summary -> Crawl.Result -> N.Name -> Task.Task FilePath
93generateReplFile summary@(Summary.Summary _ project _ ifaces _) graph name =
94 do
95 objectGraph <- organize summary graph
97 let home = Module.Canonical (Project.getName project) "ElmRepl"
98 let builder = Obj.generateForRepl ifaces objectGraph home name
100 liftIO $ IO.writeBuilder Paths.temp $
101 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
103 return Paths.temp
106replRecovery :: B.Builder
107replRecovery =
108 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
112-- ORGANIZE
115organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
116organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
117 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
118 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
119 return (Obj.union localObjs foreignObjs)
122loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
123loadModuleObj root name =
124 IO.readBinary (Paths.elmo root name)
127loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
128loadPackageObj ( name, (version,_) ) =
129 do dir <- Task.getPackageCacheDirFor name version
130 IO.readBinary (dir </> "objs.dat")
134-- OUTPUT
137data Output
138 = None
139 | Custom (Maybe FilePath) FilePath
142safeCustomPath :: Maybe FilePath -> FilePath -> IO FilePath
143safeCustomPath maybeDirectory fileName =
144 case maybeDirectory of
145 Nothing ->
146 do return fileName
148 Just dir ->
149 do Dir.createDirectoryIfMissing True dir
150 return (dir </> fileName)
154-- OUTPUT PARSER
157output :: Parser Output
158output =
159 Parser
160 { _singular = "output file"
161 , _plural = "output files"
162 , _parser = parseOutput
163 , _suggest = suggestFiles ["js","html"]
164 , _examples = exampleOutput
165 }
168parseOutput :: String -> Maybe Output
169parseOutput string =
170 if string == "/dev/null" || string == "NUL" || string == "$null" then
171 Just None
173 else if FP.takeExtension string == "js" then
174 toCustom string
176 else
177 Nothing
180toCustom :: String -> Maybe Output
181toCustom string =
182 case FP.splitPath string of
183 [] ->
184 Nothing
186 [name] ->
187 Just $ Custom Nothing name
189 segments ->
190 Just $ Custom (Just (FP.joinPath (init segments))) (last segments)
193exampleOutput :: String -> IO [String]
194exampleOutput _ =
195 return [ "elm.js", "index.html", "/dev/null" ]