0fc1429 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

start using BackgroundWriter for big files in Elm.Details

0fc1429Evan Czaplicki7 years ago

builder/src/Elm/Details.hs+21−21

compare with master

unifiedsplit

@@ -33,6 +33,7 @@ import System.FilePath ((</>), (<.>))

33import qualified AST.Canonical as Can

34import qualified AST.Source as Src

35import qualified AST.Optimized as Opt

36+import qualified BackgroundWriter as BW

36import qualified Compile

37import qualified Compile

37import qualified Deps.Registry as Registry

38import qualified Deps.Registry as Registry

38import qualified Deps.Solver as Solver

39import qualified Deps.Solver as Solver

@@ -120,11 +121,11 @@ loadInterfaces root (Details _ _ _ _ extras) =

120-- VERIFY INSTALL -- used by Install

121-- VERIFY INSTALL -- used by Install

121

122

123

123−verifyInstall :: FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ())

124+verifyInstall :: BW.Scope -> FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ())

124−verifyInstall root (Solver.Env cache manager connection registry) outline =

125+verifyInstall scope root (Solver.Env cache manager connection registry) outline =

125 do time <- File.getTime (root </> "elm.json")

126 do time <- File.getTime (root </> "elm.json")

126 let key = Reporting.ignorer

127 let key = Reporting.ignorer

127− let env = Env key root cache manager connection registry

128+ let env = Env key scope root cache manager connection registry

128 case outline of

129 case outline of

129 Outline.Pkg pkg -> Task.run (verifyPkg env time pkg >> return ())

130 Outline.Pkg pkg -> Task.run (verifyPkg env time pkg >> return ())

130 Outline.App app -> Task.run (verifyApp env time app >> return ())

131 Outline.App app -> Task.run (verifyApp env time app >> return ())

@@ -134,28 +135,28 @@ verifyInstall root (Solver.Env cache manager connection registry) outline =

134-- LOAD -- used by Make, Repl, Reactor

135-- LOAD -- used by Make, Repl, Reactor

135

136

137

137−load :: Reporting.Style -> FilePath -> IO (Either Exit.Details Details)

138+load :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details)

138−load style root =

139+load style scope root =

139 do newTime <- File.getTime (root </> "elm.json")

140 do newTime <- File.getTime (root </> "elm.json")

140 maybeDetails <- File.readBinary (Stuff.details root)

141 maybeDetails <- File.readBinary (Stuff.details root)

141 case maybeDetails of

142 case maybeDetails of

142 Nothing ->

143 Nothing ->

143− generate style root newTime

144+ generate style scope root newTime

144

145

145 Just details@(Details oldTime _ _ _ _) ->

146 Just details@(Details oldTime _ _ _ _) ->

146 if oldTime == newTime

147 if oldTime == newTime

147 then return (Right details)

148 then return (Right details)

148− else generate style root newTime

149+ else generate style scope root newTime

149

150

151

152

152-- GENERATE

153-- GENERATE

153

154

155

155−generate :: Reporting.Style -> FilePath -> File.Time -> IO (Either Exit.Details Details)

156+generate :: Reporting.Style -> BW.Scope -> FilePath -> File.Time -> IO (Either Exit.Details Details)

156−generate style root time =

157+generate style scope root time =

157 Reporting.trackDetails style $ \key ->

158 Reporting.trackDetails style $ \key ->

158− do result <- initEnv key root

159+ do result <- initEnv key scope root

159 case result of

160 case result of

160 Left exit ->

161 Left exit ->

161 return (Left exit)

162 return (Left exit)

@@ -173,6 +174,7 @@ generate style root time =

173data Env =

174data Env =

174 Env

175 Env

175 { _key :: Reporting.DKey

176 { _key :: Reporting.DKey

177+ , _scope :: BW.Scope

176 , _root :: FilePath

178 , _root :: FilePath

177 , _cache :: Stuff.PackageCache

179 , _cache :: Stuff.PackageCache

178 , _manager :: Http.Manager

180 , _manager :: Http.Manager

@@ -181,8 +183,8 @@ data Env =

181 }

183 }

182

184

183

185

184−initEnv :: Reporting.DKey -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))

186+initEnv :: Reporting.DKey -> BW.Scope -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))

185−initEnv key root =

187+initEnv key scope root =

186 do mvar <- fork Solver.initEnv

188 do mvar <- fork Solver.initEnv

187 eitherOutline <- Outline.read root

189 eitherOutline <- Outline.read root

188 case eitherOutline of

190 case eitherOutline of

@@ -196,7 +198,7 @@ initEnv key root =

196 return $ Left $ Exit.DetailsCannotGetRegistry problem

198 return $ Left $ Exit.DetailsCannotGetRegistry problem

197

199

198 Right (Solver.Env cache manager connection registry) ->

200 Right (Solver.Env cache manager connection registry) ->

199− return $ Right (Env key root cache manager connection registry, outline)

201+ return $ Right (Env key scope root cache manager connection registry, outline)

200

202

201

203

202

204

@@ -243,7 +245,7 @@ checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) =

243

245

244

246

245verifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)

247verifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)

246−verifyConstraints (Env _ _ cache _ connection registry) constraints =

248+verifyConstraints (Env _ _ _ cache _ connection registry) constraints =

247 do result <- Task.io $ Solver.verify cache connection registry constraints

249 do result <- Task.io $ Solver.verify cache connection registry constraints

248 case result of

250 case result of

249 Solver.Ok details -> return details

251 Solver.Ok details -> return details

@@ -289,7 +291,7 @@ fork work =

289

291

290

292

291verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details

293verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details

292−verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =

294+verifyDependencies env@(Env key scope root _ _ _ _) time outline solution directDeps =

293 Task.eio id $

295 Task.eio id $

294 do Reporting.report key (Reporting.DStart (Map.size solution))

296 do Reporting.report key (Reporting.DStart (Map.size solution))

295 mvar <- newEmptyMVar

297 mvar <- newEmptyMVar

@@ -309,11 +311,9 @@ verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =

309 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty artifacts

311 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty artifacts

310 details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)

312 details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)

311 in

313 in

312− do -- PERF fork all three of these writes, but need to make sure

313− -- they complete before main thread with some MVar check at end

314− File.writeBinary (Stuff.objects root) objs

314+ do BW.writeBinary scope (Stuff.objects root) objs

315− File.writeBinary (Stuff.interfaces root) ifaces

315+ BW.writeBinary scope (Stuff.interfaces root) ifaces

316− File.writeBinary (Stuff.details root) details

316+ BW.writeBinary scope (Stuff.details root) details

317 return (Right details)

318

319

@@ -357,7 +357,7 @@ type Dep =

357

358

359verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep

360−verifyDep (Env key _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =

360+verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =

361 let

362 fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps

363 in