git.iko.soy/elk
on 2f4ea95 help sign in
elk/builder/src/Generate/Output.hs
199 lines 5.0 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 let pkg = Project.getName project
67 let roots = map (Module.Canonical pkg) names
68 objectGraph <- organize summary graph
69 case Obj.generate debug target ifaces objectGraph roots of
70 Nothing ->
71 return ()
73 Just builder ->
74 let
75 monolith =
76 "(function(scope){\n'use strict';"
77 <> Functions.functions <> builder <> "}(this));"
78 in
79 liftIO $
80 case output_ of
81 Nothing ->
82 IO.writeBuilder "elm.js" monolith
84 Just None ->
85 return ()
87 Just (Custom maybeDir fileName) ->
88 do path <- safeCustomPath maybeDir fileName
89 IO.writeBuilder path monolith
93-- GENERATE REPL MONOLITH
96generateReplFile :: Summary.Summary -> Crawl.Result -> N.Name -> Task.Task FilePath
97generateReplFile summary@(Summary.Summary _ project _ ifaces _) graph name =
98 do
99 objectGraph <- organize summary graph
101 let home = Module.Canonical (Project.getName project) "ElmRepl"
102 let builder = Obj.generateForRepl ifaces objectGraph home name
104 liftIO $ IO.writeBuilder Paths.temp $
105 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
107 return Paths.temp
110replRecovery :: B.Builder
111replRecovery =
112 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
116-- ORGANIZE
119organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
120organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
121 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
122 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
123 return (Obj.union localObjs foreignObjs)
126loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
127loadModuleObj root name =
128 IO.readBinary (Paths.elmo root name)
131loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
132loadPackageObj ( name, (version,_) ) =
133 do dir <- Task.getPackageCacheDirFor name version
134 IO.readBinary (dir </> "objs.dat")
138-- OUTPUT
141data Output
142 = None
143 | Custom (Maybe FilePath) FilePath
146safeCustomPath :: Maybe FilePath -> FilePath -> IO FilePath
147safeCustomPath maybeDirectory fileName =
148 case maybeDirectory of
149 Nothing ->
150 do return fileName
152 Just dir ->
153 do Dir.createDirectoryIfMissing True dir
154 return (dir </> fileName)
158-- OUTPUT PARSER
161output :: Parser Output
162output =
163 Parser
164 { _singular = "output file"
165 , _plural = "output files"
166 , _parser = parseOutput
167 , _suggest = suggestFiles ["js","html"]
168 , _examples = exampleOutput
169 }
172parseOutput :: String -> Maybe Output
173parseOutput string =
174 if string == "/dev/null" || string == "NUL" || string == "$null" then
175 Just None
177 else if FP.takeExtension string == ".js" then
178 toCustom string
180 else
181 Nothing
184toCustom :: String -> Maybe Output
185toCustom string =
186 case FP.splitPath string of
187 [] ->
188 Nothing
190 [name] ->
191 Just $ Custom Nothing name
193 segments ->
194 Just $ Custom (Just (FP.joinPath (init segments))) (last segments)
197exampleOutput :: String -> IO [String]
198exampleOutput _ =
199 return [ "elm.js", "index.html", "/dev/null" ]