git.iko.soy/elk
on f609efa help sign in
elk/builder/src/Generate/Output.hs
214 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.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.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 Reporting.Task as Task
36import qualified Stuff.Paths as Paths
37import Terminal.Args (Parser(..), suggestFiles)
41-- GENERATE
44data Options =
45 Options
46 { _mode :: Obj.Mode
47 , _target :: Obj.Target
48 , _output :: Maybe Output
49 }
52generate :: Options -> Summary.Summary -> Crawl.Result -> Task.Task ()
53generate options summary graph@(Crawl.Graph args _ _ _ _) =
54 case args of
55 Args.Pkg _ ->
56 return ()
58 Args.Roots names ->
59 generateMonolith options summary graph (NonEmpty.toList names)
63-- GENERATE MONOLITH
66generateMonolith :: Options -> Summary.Summary -> Crawl.Result -> [Module.Raw] -> Task.Task ()
67generateMonolith (Options debug target maybeOutput) summary@(Summary.Summary _ project _ ifaces _) graph rootNames =
68 do let pkg = Project.getName project
69 let roots = map (Module.Canonical pkg) rootNames
70 objectGraph <- organize summary graph
71 case Obj.generate debug target ifaces objectGraph roots of
72 Obj.None ->
73 return ()
75 Obj.Some name names builder ->
76 let
77 monolith =
78 "(function(scope){\n'use strict';"
79 <> Functions.functions <> builder <> "}(this));"
80 in
81 liftIO $
82 case maybeOutput of
83 Nothing ->
84 IO.writeBuilder "elm.js" monolith
86 Just None ->
87 return ()
89 Just (JavaScript maybeDir fileName) ->
90 do path <- toWritablePath maybeDir fileName
91 IO.writeBuilder path monolith
93 Just (Html maybeDir fileName) ->
94 case names of
95 [] ->
96 do path <- toWritablePath maybeDir fileName
97 IO.writeBuilder path (Html.sandwich name monolith)
99 _:_ ->
100 return ()
104-- GENERATE REPL MONOLITH
107generateReplFile :: Summary.Summary -> Crawl.Result -> I.Interface -> N.Name -> Task.Task FilePath
108generateReplFile summary@(Summary.Summary _ project _ _ _) graph iface name =
109 do
110 objectGraph <- organize summary graph
112 let home = Module.Canonical (Project.getName project) "Elm_Repl"
113 let builder = Obj.generateForRepl objectGraph iface home name
115 liftIO $ IO.writeBuilder Paths.temp $
116 replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
118 return Paths.temp
121replRecovery :: B.Builder
122replRecovery =
123 "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
127-- ORGANIZE
130organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
131organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
132 do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
133 foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
134 return (Obj.union localObjs foreignObjs)
137loadModuleObj :: FilePath -> Module.Raw -> Task.Task Obj.Graph
138loadModuleObj root name =
139 IO.readBinary (Paths.elmo root name)
142loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
143loadPackageObj ( name, (version,_) ) =
144 do dir <- Task.getPackageCacheDirFor name version
145 IO.readBinary (dir </> "objs.dat")
149-- OUTPUT
152data Output
153 = None
154 | Html (Maybe FilePath) FilePath
155 | JavaScript (Maybe FilePath) FilePath
158toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
159toWritablePath maybeDir fileName =
160 case maybeDir of
161 Nothing ->
162 do return fileName
164 Just dir ->
165 do Dir.createDirectoryIfMissing True dir
166 return (dir </> fileName)
170-- OUTPUT PARSER
173output :: Parser Output
174output =
175 Parser
176 { _singular = "output file"
177 , _plural = "output files"
178 , _parser = parseOutput
179 , _suggest = suggestFiles ["js","html"]
180 , _examples = exampleOutput
181 }
184parseOutput :: String -> Maybe Output
185parseOutput string =
186 if string == "/dev/null" || string == "NUL" || string == "$null" then
187 Just None
189 else if FP.takeExtension string == ".html" && length string > 5 then
190 splitOutput Html string
192 else if FP.takeExtension string == ".js" && length string > 3 then
193 splitOutput JavaScript string
195 else
196 Nothing
199splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
200splitOutput toOutput string =
201 case FP.splitPath string of
202 [] ->
203 Nothing
205 [name] ->
206 Just $ toOutput Nothing name
208 segments ->
209 Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
212exampleOutput :: String -> IO [String]
213exampleOutput _ =
214 return [ "elm.js", "index.html", "/dev/null" ]