git.iko.soy/elk
on d4e9599 help sign in
elk/builder/src/Generate/Output.hs
194 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 { _mode :: Obj.Mode
45 , _target :: Obj.Target
46 , _output :: Maybe Output
47 }
50generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
51generate options summary graph@(Crawl.Graph args _ _ _ _) =
52 case args of
53 Args.Pkg _ ->
54 return ()
56 Args.Roots names ->
57 generateMonolith options summary graph (NonEmpty.toList names)
61-- GENERATE MONOLITH
64generateMonolith :: Options -> Summary.Summary -> Crawl.Result -> [Module.Raw] -> Task.Task ()
65generateMonolith (Options debug target output_) summary@(Summary.Summary _ project _ ifaces _) graph names =
66 do
67 objectGraph <- organize summary graph
68 let pkg = Project.getName project
69 let roots = map (Module.Canonical pkg) names
70 let (Right builder) = Obj.generate debug target ifaces objectGraph roots
71 let monolith =
72 "(function(scope){\n'use strict';" <> Functions.functions <> builder <> "}(this));"
74 liftIO $
75 case output_ of
76 Nothing ->
77 IO.writeBuilder "elm.js" monolith
79 Just None ->
80 return ()
82 Just (Custom maybeDir fileName) ->
83 do path <- safeCustomPath maybeDir fileName
84 IO.writeBuilder path monolith
88-- GENERATE REPL MONOLITH
91generateReplFile :: Summary.Summary -> Crawl.Result -> N.Name -> Task.Task FilePath
92generateReplFile summary@(Summary.Summary _ project _ ifaces _) graph name =
93 do
94 objectGraph <- organize summary graph
96 let home = Module.Canonical (Project.getName project) "ElmRepl"
97 let builder = Obj.generateForRepl ifaces objectGraph home name
99 liftIO $ IO.writeBuilder Paths.temp $
100 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
102 return Paths.temp
105replRecovery :: B.Builder
106replRecovery =
107 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
111-- ORGANIZE
114organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
115organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
116 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
117 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
118 return (Obj.union localObjs foreignObjs)
121loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
122loadModuleObj root name =
123 IO.readBinary (Paths.elmo root name)
126loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
127loadPackageObj ( name, (version,_) ) =
128 do dir <- Task.getPackageCacheDirFor name version
129 IO.readBinary (dir </> "objs.dat")
133-- OUTPUT
136data Output
137 = None
138 | Custom (Maybe FilePath) FilePath
141safeCustomPath :: Maybe FilePath -> FilePath -> IO FilePath
142safeCustomPath maybeDirectory fileName =
143 case maybeDirectory of
144 Nothing ->
145 do return fileName
147 Just dir ->
148 do Dir.createDirectoryIfMissing True dir
149 return (dir </> fileName)
153-- OUTPUT PARSER
156output :: Parser Output
157output =
158 Parser
159 { _singular = "output file"
160 , _plural = "output files"
161 , _parser = parseOutput
162 , _suggest = suggestFiles ["js","html"]
163 , _examples = exampleOutput
164 }
167parseOutput :: String -> Maybe Output
168parseOutput string =
169 if string == "/dev/null" || string == "NUL" || string == "$null" then
170 Just None
172 else if FP.takeExtension string == ".js" then
173 toCustom string
175 else
176 Nothing
179toCustom :: String -> Maybe Output
180toCustom string =
181 case FP.splitPath string of
182 [] ->
183 Nothing
185 [name] ->
186 Just $ Custom Nothing name
188 segments ->
189 Just $ Custom (Just (FP.joinPath (init segments))) (last segments)
192exampleOutput :: String -> IO [String]
193exampleOutput _ =
194 return [ "elm.js", "index.html", "/dev/null" ]