git.iko.soy/elk
on master help sign in
Move Deps.Cache to cleaner Deps.Registry module

The new module provides more focused functions, allowing other parts of the compiler to decide if they want to use an Http.Manager or not. If they decide to use it, they can then thread it around themselves. This moves that decision to specific endpoints like `elm make` and `elm repl` allowing them to speed things up on a case-by-case basis.

commit08ebf20e99ea9f4f8085ce7a5a4dae81307d9d78 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 12 Feb 2019, 19:38 (8 years ago) parent45c13a7
3 files changed+246−543
compare with master
unifiedsplit
builder/src/Deps/Cache.hs−248 builder/src/Deps/Registry.hs+246 builder/src/Generate/Output.hs−295
builder/src/Deps/Cache.hsdeleted−248
@@ -1,248 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Deps.Cache
4− ( optionalUpdate
5− , mandatoryUpdate
6− , PackageRegistry
7− , getPackageRegistry
8− , getVersions
9− , getElmJson
10− , getDocs
11− )
12− where
13−
14−
15−import Prelude hiding (all)
16−import Control.Monad (liftM2)
17−import Control.Monad.Except (catchError, liftIO)
18−import Data.Binary (Binary, get, put)
19−import qualified Data.ByteString as BS
20−import Data.Function (on)
21−import qualified Data.List as List
22−import qualified Data.Map as Map
23−import qualified Data.Name as Name
24−import System.FilePath ((</>))
25−
26−import qualified Deps.Website as Website
27−import qualified Elm.Docs as Docs
28−import qualified Elm.Package as Pkg
29−import qualified Elm.Project.Json as Project
30−import qualified Elm.Version as V
31−import qualified File.IO as IO
32−import qualified Json.Decode as Decode
33−import qualified Reporting.Exit as Exit
34−import qualified Reporting.Exit.Assets as E
35−import qualified Reporting.Progress as Progress
36−import qualified Reporting.Suggest as Suggest
37−import qualified Reporting.Task as Task
38−
39−
40−
41−-- PACKAGE REGISTRY
42−
43−
44−data PackageRegistry =
45− PackageRegistry Int (Map.Map Pkg.Name [V.Version])
46−
47−
48−getPackageRegistry :: Task.Task PackageRegistry
49−getPackageRegistry =
50− do path <- getRegistryPath
51− exists <- liftIO $ IO.exists path
52− if exists
53− then unsafeGetRegistry path
54− else rebuild
55−
56−
57−getRegistryPath :: Task.Task FilePath
58−getRegistryPath =
59− do dir <- Task.getPackageCacheDir
60− return (dir </> "versions.dat")
61−
62−
63−unsafeGetRegistry :: FilePath -> Task.Task PackageRegistry
64−unsafeGetRegistry path =
65− do maybeRegistry <- liftIO $ IO.readBinary path
66− case maybeRegistry of
67− Just registry ->
68− return registry
69−
70− Nothing ->
71− liftIO (putStrLn path) >>
72− Task.throw (error "TODO corrupt binary 3")
73−
74−
75−
76−-- REBUILD
77−
78−
79−rebuild :: Task.Task PackageRegistry
80−rebuild =
81− do path <- getRegistryPath
82− packages <- Website.getAllPackages
83− let size = Map.foldr ((+) . length) 0 packages
84− let registry = PackageRegistry size packages
85− liftIO $ IO.writeBinary path registry
86− return registry
87−
88−
89−
90−-- UPDATE
91−
92−
93−optionalUpdate :: Task.Task PackageRegistry
94−optionalUpdate =
95− update False
96−
97−
98−mandatoryUpdate :: Task.Task PackageRegistry
99−mandatoryUpdate =
100− update True
101−
102−
103−update :: Bool -> Task.Task PackageRegistry
104−update isMandatory =
105− do path <- getRegistryPath
106− exists <- liftIO $ IO.exists path
107− if not exists
108− then rebuild
109− else
110− do registry <- unsafeGetRegistry path
111− if isMandatory
112− then attemptUpdate registry
113− else attemptUpdate registry `catchError` recoverUpdate registry
114−
115−
116−recoverUpdate :: PackageRegistry -> a -> Task.Task PackageRegistry
117−recoverUpdate registry _ =
118− do Task.report Progress.UnableToLoadLatestPackages
119− return registry
120−
121−
122−attemptUpdate :: PackageRegistry -> Task.Task PackageRegistry
123−attemptUpdate oldRegistry@(PackageRegistry size packages) =
124− do news <- Website.getNewPackages size
125− case news of
126− [] ->
127− return oldRegistry
128−
129− _:_ ->
130− let
131− newSize = size + length news
132− newPkgs = List.foldl' addNew packages news
133− newRegistry = PackageRegistry newSize newPkgs
134− in
135− do path <- getRegistryPath
136− liftIO $ IO.writeBinary path newRegistry
137− return newRegistry
138−
139−
140−addNew :: Map.Map Pkg.Name [V.Version] -> (Pkg.Name, V.Version) -> Map.Map Pkg.Name [V.Version]
141−addNew packages (name, version) =
142− Map.insertWith (++) name [version] packages
143−
144−
145−
146−-- GET VERSIONS
147−
148−
149−getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [V.Version]
150−getVersions name (PackageRegistry _ pkgs) =
151− case Map.lookup name pkgs of
152− Just vsns ->
153− Right vsns
154−
155− Nothing ->
156− Left (nearbyNames name (Map.keys pkgs))
157−
158−
159−nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
160−nearbyNames (Pkg.Name author1 project1) possibleNames =
161− let
162− authorDist = authorDistance (Name.toChars author1)
163− projectDist = projectDistance (Name.toChars project1)
164−
165− addDistance name@(Pkg.Name author2 project2) =
166− ( authorDist author2 + projectDist project2, name )
167− in
168− map snd $ take 4 $
169− List.sortBy (compare `on` fst) $
170− map addDistance possibleNames
171−
172−
173−authorDistance :: String -> Name.Name -> Int
174−authorDistance bad possibility =
175− abs (Suggest.distance bad (Name.toChars possibility))
176−
177−
178−projectDistance :: String -> Name.Name -> Int
179−projectDistance bad possibility =
180− if possibility == "elm" || possibility == "elm-explorations" then
181− 0
182− else
183− abs (Suggest.distance bad (Name.toChars possibility))
184−
185−
186−
187−-- PACKAGE INFO
188−
189−
190−getElmJson :: Pkg.Name -> V.Version -> Task.Task Project.PkgInfo
191−getElmJson name version =
192− do dir <- Task.getPackageCacheDirFor name version
193− let elmJson = dir </> "elm.json"
194−
195− exists <- liftIO $ IO.exists elmJson
196−
197− json <-
198− if exists
199− then liftIO (BS.readFile elmJson)
200− else
201− do bits <- Website.getElmJson name version
202− liftIO (BS.writeFile elmJson bits)
203− return bits
204−
205− case Decode.fromByteString Project.pkgDecoder json of
206− Right pkgInfo ->
207− return pkgInfo
208−
209− Left _ ->
210− do liftIO $ IO.remove elmJson
211− Task.throw $ Exit.Assets $ E.CorruptElmJson name version
212−
213−
214−
215−-- DOCS
216−
217−
218−getDocs :: Pkg.Name -> V.Version -> Task.Task Docs.Documentation
219−getDocs name version =
220− do dir <- Task.getPackageCacheDirFor name version
221− let docsJson = dir </> "docs.json"
222−
223− exists <- liftIO $ IO.exists docsJson
224−
225− json <-
226− if exists
227− then liftIO (BS.readFile docsJson)
228− else
229− do bits <- Website.getDocs name version
230− liftIO (BS.writeFile docsJson bits)
231− return bits
232−
233− case Decode.fromByteString (Docs.toDict <$> Decode.list Docs.decoder) json of
234− Right pkgInfo ->
235− return pkgInfo
236−
237− Left _ ->
238− do liftIO $ IO.remove docsJson
239− Task.throw $ Exit.Assets $ E.CorruptDocumentation name version
240−
241−
242−
243−-- BINARY
244−
245−
246−instance Binary PackageRegistry where
247− get = liftM2 PackageRegistry get get
248− put (PackageRegistry a b) = put a >> put b
builder/src/Deps/Registry.hsnew file+246
@@ -0,0 +1,246 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
3+module Deps.Registry
4+ ( Registry(..)
5+ , KnownVersions(..)
6+ , read
7+ , fetch
8+ , update
9+ , latest
10+ , getVersions
11+ , getVersions'
12+ )
13+ where
14+
15+
16+import Prelude hiding (read)
17+import Control.Monad (liftM2)
18+import Data.Binary (Binary, get, put)
19+import Data.Function (on)
20+import qualified Data.List as List
21+import qualified Data.Map.Strict as Map
22+import qualified Data.Name as Name
23+import qualified Data.Utf8 as Utf8
24+
25+import qualified Deps.Website as Website
26+import qualified Elm.Package as Pkg
27+import qualified Elm.Version as V
28+import qualified File
29+import qualified Http
30+import qualified Json.Decode as D
31+import qualified Reporting.Exit as E
32+import qualified Reporting.Suggest as Suggest
33+import qualified Stuff
34+
35+
36+
37+-- REGISTRY
38+
39+
40+data Registry =
41+ Registry
42+ { _count :: !Int
43+ , _versions :: !(Map.Map Pkg.Name KnownVersions)
44+ }
45+
46+
47+data KnownVersions =
48+ KnownVersions
49+ { _newest :: V.Version
50+ , _previous :: ![V.Version]
51+ }
52+
53+
54+
55+-- READ
56+
57+
58+read :: Stuff.PackageCache -> IO (Maybe Registry)
59+read cache =
60+ do let path = Stuff.registry cache
61+ exists <- File.exists path
62+ if exists
63+ then File.readBinary path
64+ else return Nothing
65+
66+
67+
68+-- FETCH
69+
70+
71+fetch :: Http.Manager -> Stuff.PackageCache -> IO (Either E.RegistryProblem Registry)
72+fetch manager cache =
73+ post manager "/all-packages" allPkgsDecoder $
74+ \versions ->
75+ do let size = Map.foldr' addEntry 0 versions
76+ let registry = Registry size versions
77+ let path = Stuff.registry cache
78+ File.writeBinary path registry
79+ return registry
80+
81+
82+addEntry :: KnownVersions -> Int -> Int
83+addEntry (KnownVersions _ vs) count =
84+ count + 1 + length vs
85+
86+
87+allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)
88+allPkgsDecoder =
89+ do pairs <- D.pairs (D.list (D.mapError (\_ -> ()) V.decoder))
90+ checkKeys pairs Map.empty
91+ where
92+ checkKeys pairs pkgs =
93+ case pairs of
94+ [] ->
95+ return pkgs
96+
97+ (key, versions) : rest ->
98+ case Pkg.fromString key of
99+ Right pkg ->
100+ case List.sortBy (flip compare) versions of
101+ [] ->
102+ D.failure ()
103+
104+ v:vs ->
105+ checkKeys rest (Map.insert pkg (KnownVersions v vs) pkgs)
106+
107+ Left _ ->
108+ D.failure ()
109+
110+
111+
112+-- UPDATE
113+
114+
115+update :: Http.Manager -> Stuff.PackageCache -> Registry -> IO (Either E.RegistryProblem Registry)
116+update manager cache oldRegistry@(Registry size packages) =
117+ post manager ("/all-packages/since/" ++ show size) (D.list newPkgDecoder) $
118+ \news ->
119+ case news of
120+ [] ->
121+ return oldRegistry
122+
123+ _:_ ->
124+ let
125+ newSize = size + length news
126+ newPkgs = foldr addNew packages news
127+ newRegistry = Registry newSize newPkgs
128+ in
129+ do File.writeBinary (Stuff.registry cache) newRegistry
130+ return newRegistry
131+
132+
133+addNew :: (Pkg.Name, V.Version) -> Map.Map Pkg.Name KnownVersions -> Map.Map Pkg.Name KnownVersions
134+addNew (name, version) versions =
135+ let
136+ add maybeKnowns =
137+ case maybeKnowns of
138+ Just (KnownVersions v vs) ->
139+ KnownVersions version (v:vs)
140+
141+ Nothing ->
142+ KnownVersions version []
143+ in
144+ Map.alter (Just . add) name versions
145+
146+
147+newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)
148+newPkgDecoder =
149+ do str <- D.string
150+ case Utf8.split 0x40 {-@-} str of
151+ [key, value] ->
152+ case Pkg.fromString key of
153+ Right pkg ->
154+ case V.fromString value of
155+ Just vsn -> return (pkg, vsn)
156+ Nothing -> D.failure ()
157+
158+ Left _ ->
159+ D.failure ()
160+
161+ _ ->
162+ D.failure ()
163+
164+
165+
166+-- LATEST
167+
168+
169+latest :: Http.Manager -> Stuff.PackageCache -> IO (Either E.RegistryProblem Registry)
170+latest manager cache =
171+ do maybeOldRegistry <- read cache
172+ case maybeOldRegistry of
173+ Just oldRegistry ->
174+ update manager cache oldRegistry
175+
176+ Nothing ->
177+ fetch manager cache
178+
179+
180+
181+-- GET VERSIONS
182+
183+
184+getVersions :: Pkg.Name -> Registry -> Maybe KnownVersions
185+getVersions name (Registry _ versions) =
186+ Map.lookup name versions
187+
188+
189+getVersions' :: Pkg.Name -> Registry -> Either [Pkg.Name] KnownVersions
190+getVersions' name (Registry _ versions) =
191+ case Map.lookup name versions of
192+ Just kvs -> Right kvs
193+ Nothing -> Left $ nearbyNames name (Map.keys versions)
194+
195+
196+nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
197+nearbyNames (Pkg.Name author1 project1) possibleNames =
198+ let
199+ authorDist = authorDistance (Name.toChars author1)
200+ projectDist = projectDistance (Name.toChars project1)
201+
202+ addDistance name@(Pkg.Name author2 project2) =
203+ ( authorDist author2 + projectDist project2, name )
204+ in
205+ map snd $ take 4 $
206+ List.sortBy (compare `on` fst) $
207+ map addDistance possibleNames
208+
209+
210+authorDistance :: String -> Name.Name -> Int
211+authorDistance bad possibility =
212+ abs (Suggest.distance bad (Name.toChars possibility))
213+
214+
215+projectDistance :: String -> Name.Name -> Int
216+projectDistance bad possibility =
217+ if possibility == "elm" || possibility == "elm-explorations"
218+ then 0
219+ else abs (Suggest.distance bad (Name.toChars possibility))
220+
221+
222+
223+-- POST
224+
225+
226+post :: Http.Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Either E.RegistryProblem b)
227+post manager path decoder callback =
228+ Http.post manager (Website.route path []) [] E.RP_Http $
229+ \body ->
230+ case D.fromByteString decoder body of
231+ Right a -> Right <$> callback a
232+ Left _ -> return $ Left E.RP_Data
233+
234+
235+
236+-- BINARY
237+
238+
239+instance Binary Registry where
240+ get = liftM2 Registry get get
241+ put (Registry a b) = put a >> put b
242+
243+
244+instance Binary KnownVersions where
245+ get = liftM2 KnownVersions get get
246+ put (KnownVersions a b) = put a >> put b
builder/src/Generate/Output.hsdeleted−295
@@ -1,295 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Generate.Output
4− ( Mode(..)
5− , Mode.Target(..)
6− , generate
7− , generateReplFile
8− , noDebugUsesInPackage
9− , Output(..)
10− , output
11− )
12− where
13−
14−
15−import Control.Concurrent.MVar (MVar, putMVar)
16−import Control.Monad.Trans (liftIO)
17−import qualified Data.ByteString.Builder as B
18−import qualified Data.Map as Map
19−import Data.Monoid ((<>))
20−import qualified Data.Name as Name
21−import qualified System.Directory as Dir
22−import qualified System.FilePath as FP
23−import System.FilePath ((</>))
24−
25−import qualified Elm.Compiler as Compiler
26−import qualified Elm.Compiler.Objects as Obj
27−import qualified Elm.Interface as I
28−import qualified Elm.ModuleName as ModuleName
29−import qualified Elm.Package as Pkg
30−import qualified Elm.Project.Json as Project
31−import qualified Elm.Project.Summary as Summary
32−import qualified File.Args as Args
33−import qualified File.Crawl as Crawl
34−import qualified File.IO as IO
35−import qualified Generate.Functions as Functions
36−import qualified Generate.Html as Html
37−import qualified Generate.Nitpick as Nitpick
38−import qualified Generate.JavaScript.Mode as Mode
39−import qualified Reporting.Exit as Exit
40−import qualified Reporting.Exit.Make as E
41−import qualified Reporting.Render.Type.Localizer as L
42−import qualified Reporting.Task as Task
43−import qualified Stuff.Paths as Paths
44−import Terminal.Args (Parser(..))
45−
46−
47−
48−-- GENERATE
49−
50−
51−data Mode = Debug | Dev | Prod
52−
53−
54−generate
55− :: Mode
56− -> Mode.Target
57− -> Maybe Output
58− -> Summary.Summary
59− -> Crawl.Result
60− -> Map.Map ModuleName.Raw Compiler.Artifacts
61− -> Task.Task ()
62−generate mode target maybeOutput summary graph@(Crawl.Graph args locals _ _ _) artifacts =
63− case args of
64− Args.Pkg _ ->
65− return ()
66−
67− Args.Roots name names ->
68− do objectGraph <- organize summary graph
69−
70− realMode <-
71− case mode of
72− Debug ->
73− do interfaces <- getInterfaces summary locals artifacts
74− return $ Mode.debug target interfaces
75−
76− Dev ->
77− return $ Mode.dev target
78−
79− Prod ->
80− do noDebugUses summary objectGraph
81− return $ Mode.prod target objectGraph
82−
83− generateMonolith realMode maybeOutput summary objectGraph (name:names)
84−
85−
86−getInterfaces
87− :: Summary.Summary
88− -> Map.Map ModuleName.Raw a
89− -> Map.Map ModuleName.Raw Compiler.Artifacts
90− -> Task.Task I.Interfaces
91−getInterfaces (Summary.Summary root project _ interfaces _) locals artifacts =
92− let
93− pkg =
94− Project.getName project
95−
96− addArtifact home (Compiler.Artifacts elmi _ _) ifaces =
97− (ModuleName.Canonical pkg home, elmi) : ifaces
98−
99− addInterface home iface ifaces =
100− (ModuleName.Canonical pkg home, iface) : ifaces
101−
102− readInterface home _ =
103− IO.readBinary (Paths.elmi root home)
104− in
105− do cached <- Map.traverseWithKey readInterface (Map.difference locals artifacts)
106− return $
107− Map.union interfaces $ Map.fromList $
108− Map.foldrWithKey addInterface (Map.foldrWithKey addArtifact [] artifacts) cached
109−
110−
111−
112−-- GENERATE MONOLITH
113−
114−
115−generateMonolith
116− :: Mode.Mode
117− -> Maybe Output
118− -> Summary.Summary
119− -> Obj.Graph
120− -> [ModuleName.Raw]
121− -> Task.Task ()
122−generateMonolith mode maybeOutput (Summary.Summary _ project _ _ _) graph rootNames =
123− do let pkg = Project.getName project
124− let roots = map (ModuleName.Canonical pkg) rootNames
125− case Obj.generate mode graph roots of
126− Obj.None ->
127− return ()
128−
129− Obj.Some name _names builder ->
130− let
131− monolith =
132− "(function(scope){\n'use strict';"
133− <> Functions.functions <> builder <> "}(this));"
134− in
135− liftIO $
136− case maybeOutput of
137− Nothing ->
138− IO.writeBuilder "index.html" (Html.sandwich name monolith)
139−
140− Just output_ ->
141− case output_ of
142− None ->
143− return ()
144−
145− JavaScript maybeDir fileName ->
146− do path <- toWritablePath maybeDir fileName
147− IO.writeBuilder path monolith
148−
149− HtmlBuilder mvar ->
150− putMVar mvar (Html.sandwich name monolith)
151−
152− Html maybeDir fileName ->
153− do path <- toWritablePath maybeDir fileName
154− IO.writeBuilder path (Html.sandwich name monolith)
155−
156−
157−
158−-- GENERATE REPL MONOLITH
159−
160−
161−generateReplFile
162− :: Bool
163− -> L.Localizer
164− -> Summary.Summary
165− -> Crawl.Result
166− -> I.Interface
167− -> Name.Name
168− -> Task.Task FilePath
169−generateReplFile noColors localizer summary@(Summary.Summary _ project _ _ _) graph iface name =
170− do
171− objectGraph <- organize summary graph
172−
173− let home = ModuleName.Canonical (Project.getName project) Name.replModule
174− let builder = Obj.generateForRepl (not noColors) localizer objectGraph iface home name
175−
176− liftIO $ IO.writeBuilder (Paths.temp "js") $
177− replRecovery <> "(function(){\n'use strict';" <> Functions.functions <> builder <> "}());"
178−
179− return (Paths.temp "js")
180−
181−
182−replRecovery :: B.Builder
183−replRecovery =
184− "process.on('uncaughtException', function(err) { process.stderr.write(err.toString()); process.exit(1); });"
185−
186−
187−
188−-- ORGANIZE
189−
190−
191−organize :: Summary.Summary -> Crawl.Result -> Task.Task Obj.Graph
192−organize (Summary.Summary root _ _ _ deps) (Crawl.Graph _ locals _ _ _) =
193− do localObjs <- Obj.unions <$> traverse (loadModuleObj root) (Map.keys locals)
194− foreignObjs <- Obj.unions <$> traverse loadPackageObj (Map.toList deps)
195− return (Obj.union localObjs foreignObjs)
196−
197−
198−loadModuleObj :: FilePath -> ModuleName.Raw -> Task.Task Obj.Graph
199−loadModuleObj root name =
200− IO.readBinary (Paths.elmo root name)
201−
202−
203−loadPackageObj :: ( Pkg.Name, (Pkg.Version, deps) ) -> Task.Task Obj.Graph
204−loadPackageObj ( name, (version,_) ) =
205− do dir <- Task.getPackageCacheDirFor name version
206− IO.readBinary (dir </> "objs.dat")
207−
208−
209−
210−-- NO DEBUG USES
211−
212−
213−noDebugUses :: Summary.Summary -> Obj.Graph -> Task.Task ()
214−noDebugUses (Summary.Summary _ project _ _ _) graph =
215− case Nitpick.findDebugUses (Project.getName project) graph of
216− [] ->
217− return ()
218−
219− m:ms ->
220− Task.throw (Exit.Make (E.CannotOptimizeDebugValues m ms))
221−
222−
223−noDebugUsesInPackage :: Summary.Summary -> Crawl.Result -> Task.Task ()
224−noDebugUsesInPackage summary graph =
225− noDebugUses summary =<< organize summary graph
226−
227−
228−
229−-- OUTPUT
230−
231−
232−data Output
233− = None
234− | Html (Maybe FilePath) FilePath
235− | JavaScript (Maybe FilePath) FilePath
236− | HtmlBuilder (MVar B.Builder)
237−
238−
239−toWritablePath :: Maybe FilePath -> FilePath -> IO FilePath
240−toWritablePath maybeDir fileName =
241− case maybeDir of
242− Nothing ->
243− do return fileName
244−
245− Just dir ->
246− do Dir.createDirectoryIfMissing True dir
247− return (dir </> fileName)
248−
249−
250−
251−-- OUTPUT PARSER
252−
253−
254−output :: Parser Output
255−output =
256− Parser
257− { _singular = "output file"
258− , _plural = "output files"
259− , _parser = parseOutput
260− , _suggest = \_ -> return []
261− , _examples = exampleOutput
262− }
263−
264−
265−parseOutput :: String -> Maybe Output
266−parseOutput string =
267− if string == "/dev/null" || string == "NUL" || string == "$null" then
268− Just None
269−
270− else if FP.takeExtension string == ".html" && length string > 5 then
271− splitOutput Html string
272−
273− else if FP.takeExtension string == ".js" && length string > 3 then
274− splitOutput JavaScript string
275−
276− else
277− Nothing
278−
279−
280−splitOutput :: (Maybe FilePath -> FilePath -> Output) -> String -> Maybe Output
281−splitOutput toOutput string =
282− case FP.splitPath string of
283− [] ->
284− Nothing
285−
286− [name] ->
287− Just $ toOutput Nothing name
288−
289− segments ->
290− Just $ toOutput (Just (FP.joinPath (init segments))) (last segments)
291−
292−
293−exampleOutput :: String -> IO [String]
294−exampleOutput _ =
295− return [ "elm.js", "index.html", "/dev/null" ]