41aaab9 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Avoid reading i.dat and o.dat on scratch builds

41aaab9Evan Czaplicki8 years ago

builder/src/Build.hs+3−3

compare with master

unifiedsplit

@@ -63,7 +63,7 @@ data Env =

65makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env

66−makeEnv key root (Details.Details _ validOutline locals foreigns) =

66+makeEnv key root (Details.Details _ validOutline locals foreigns _) =

67 case validOutline of

68 Details.ValidApp (Outline.AppOutline _ srcDirs _ _ _ _) ->

69 Env key root Pkg.dummyName srcDirs locals foreigns

@@ -626,9 +626,9 @@ compile (Env key root pkg _ _ _) local@(Details.Local path time _ _) ifaces modu

626

627

628writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()

629−writeDetails root (Details.Details time outline locals foreigns) results =

629+writeDetails root (Details.Details time outline locals foreigns extras) results =

630 File.writeBinary (Stuff.details root) $

631− Details.Details time outline (Map.foldrWithKey addNewLocal locals results) foreigns

631+ Details.Details time outline (Map.foldrWithKey addNewLocal locals results) foreigns extras

632

633

634addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local

builder/src/Elm/Details.hs+50−32

@@ -13,7 +13,7 @@ module Elm.Details

15import Control.Concurrent (forkIO)

16−import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar, takeMVar)

16+import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)

17import Control.Monad (liftM, liftM2, liftM4)

18import Data.Binary (Binary, get, put, getWord8, putWord8)

19import qualified Data.Map as Map

@@ -59,6 +59,7 @@ data Details =

59 , _outline :: ValidOutline

60 , _locals :: Map.Map ModuleName.Raw Local

61 , _foreigns :: Map.Map ModuleName.Raw Foreign

62+ , _extras :: Extras

62 }

63 }

@@ -80,22 +81,31 @@ data Foreign =

80 Foreign Pkg.Name [Pkg.Name]

81 Foreign Pkg.Name [Pkg.Name]

84+data Extras

85+ = ArtifactsCached

86+ | ArtifactsFresh Interfaces Opt.GlobalGraph

87+

88+

89+type Interfaces =

90+ Map.Map ModuleName.Canonical I.DependencyInterface

91+

92+

84-- LOAD

94-- LOAD

87loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))

97loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))

88−loadObjects root _ =

98+loadObjects root (Details _ _ _ _ extras) =

99+ case extras of

100+ ArtifactsFresh _ o -> newMVar (Just o)

89− fork (File.readBinary (Stuff.objects root))

101+ ArtifactsCached -> fork (File.readBinary (Stuff.objects root))

102

103

92loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))

104loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))

93−loadInterfaces root _ =

105+loadInterfaces root (Details _ _ _ _ extras) =

106+ case extras of

107+ ArtifactsFresh i _ -> newMVar (Just i)

94− fork (File.readBinary (Stuff.interfaces root))

108+ ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))

95−

96−

97−type Interfaces =

98− Map.Map ModuleName.Canonical I.DependencyInterface

109

100

110

101

111

@@ -110,7 +120,7 @@ verify style root =

110 Nothing ->

120 Nothing ->

111 verifyFromScratch style root newTime

121 verifyFromScratch style root newTime

112

122

113− Just details@(Details oldTime _ _ _) ->

123+ Just details@(Details oldTime _ _ _ _) ->

114 if oldTime == newTime

124 if oldTime == newTime

115 then return (Right details)

125 then return (Right details)

116 else verifyFromScratch style root newTime

126 else verifyFromScratch style root newTime

@@ -140,16 +150,11 @@ data Env =

140 , _root :: FilePath

150 , _root :: FilePath

141 , _cache :: Stuff.PackageCache

151 , _cache :: Stuff.PackageCache

142 , _manager :: Http.Manager

152 , _manager :: Http.Manager

143− , _connection :: Connection

153+ , _connection :: Solver.Connection

144 , _registry :: Registry.Registry

154 , _registry :: Registry.Registry

145 }

155 }

146

156

147

157

148−data Connection

149− = Online

150− | Offline

151−

152−

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

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

154initEnv key root =

159initEnv key root =

155 do cacheMVar <- fork Stuff.getPackageCache

160 do cacheMVar <- fork Stuff.getPackageCache

@@ -169,7 +174,11 @@ initEnv key root =

169 do eitherRegistry <- Registry.fetch manager cache

174 do eitherRegistry <- Registry.fetch manager cache

170 case eitherRegistry of

175 case eitherRegistry of

171 Right latestRegistry ->

176 Right latestRegistry ->

177+ let

178+ conn = Solver.Online manager

172− return $ Right (Env key root cache manager Online latestRegistry, outline)

179+ env = Env key root cache manager conn latestRegistry

180+ in

181+ return $ Right (env, outline)

173

182

174 Left problem ->

183 Left problem ->

175 return $ Left $ Exit.DetailsCannotGetRegistry problem

184 return $ Left $ Exit.DetailsCannotGetRegistry problem

@@ -178,10 +187,17 @@ initEnv key root =

178 do eitherRegistry <- Registry.update manager cache cachedRegistry

187 do eitherRegistry <- Registry.update manager cache cachedRegistry

179 case eitherRegistry of

188 case eitherRegistry of

180 Right latestRegistry ->

189 Right latestRegistry ->

190+ let

191+ conn = Solver.Online manager

181− return $ Right (Env key root cache manager Online latestRegistry, outline)

192+ env = Env key root cache manager conn latestRegistry

193+ in

194+ return $ Right (env, outline)

182

195

183 Left _ ->

196 Left _ ->

197+ let

184− return $ Right (Env key root cache manager Offline cachedRegistry, outline)

198+ env = Env key root cache manager Solver.Offline cachedRegistry

199+ in

200+ return $ Right (env, outline)

185

201

186

202

187

203

@@ -195,7 +211,7 @@ verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details

195verifyPkg env time outline@(Outline.PkgOutline _ _ _ _ _ direct testDirect elm) =

211verifyPkg env time outline@(Outline.PkgOutline _ _ _ _ _ direct testDirect elm) =

196 if Con.goodElm elm

212 if Con.goodElm elm

197 then

213 then

198− do solution <- solve env =<< union noDups direct testDirect

214+ do solution <- verifyConstraints env =<< union noDups direct testDirect

199 let vsns = Map.map (\(Solver.Details v _) -> v) solution

215 let vsns = Map.map (\(Solver.Details v _) -> v) solution

200 verifyDependencies env time (ValidPkg outline vsns) solution direct

216 verifyDependencies env time (ValidPkg outline vsns) solution direct

201 else

217 else

@@ -207,7 +223,7 @@ verifyApp env time outline@(Outline.AppOutline elmVersion _ direct _ _ _) =

207 if elmVersion == V.compiler

223 if elmVersion == V.compiler

208 then

224 then

209 do stated <- checkAppDeps outline

225 do stated <- checkAppDeps outline

210− actual <- solve env (Map.map Con.exactly stated)

226+ actual <- verifyConstraints env (Map.map Con.exactly stated)

211 if Map.size stated == Map.size actual

227 if Map.size stated == Map.size actual

212 then verifyDependencies env time (ValidApp outline) actual direct

228 then verifyDependencies env time (ValidApp outline) actual direct

213 else Task.throw $ Exit.DetailsHandEditedDependencies

229 else Task.throw $ Exit.DetailsHandEditedDependencies

@@ -223,15 +239,17 @@ checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) =

223

239

224

240

225

241

226−-- SOLVE

242+-- VERIFY CONSTRAINTS

227

243

228

244

229−solve :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)

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

230−solve (Env _ _ cache manager connection registry) constraints =

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

231− Task.eio (error "TODO solve problem") $

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

232− case connection of

248+ case result of

233− Online -> Solver.online cache manager registry constraints

249+ Solver.Ok details -> return details

234− Offline -> Solver.offline cache registry constraints

250+ Solver.NoSolution -> Task.throw $ Exit.DetailsNoSolution

251+ Solver.NoOfflineSolution -> Task.throw $ Exit.DetailsNoOfflineSolution

252+ Solver.Err exit -> Task.throw $ Exit.DetailsSolverProblem exit

235

253

236

254

237

255

@@ -280,14 +298,14 @@ verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =

280 deps <- traverse readMVar mvars

298 deps <- traverse readMVar mvars

281 case sequence deps of

299 case sequence deps of

282 Left problem ->

300 Left problem ->

283− error "TODO problem in verifyDependencies"

301+ error "TODO verifyDependencies" problem

284

302

285 Right artifacts ->

303 Right artifacts ->

286 let

304 let

287 objs = Map.foldr addObjects Opt.empty artifacts

305 objs = Map.foldr addObjects Opt.empty artifacts

288 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts

306 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts

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

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

290− details = Details time outline Map.empty foreigns

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

291 in

309 in

292 do File.writeBinary (Stuff.objects root) objs

310 do File.writeBinary (Stuff.objects root) objs

293 File.writeBinary (Stuff.interfaces root) ifaces

311 File.writeBinary (Stuff.interfaces root) ifaces

@@ -687,8 +705,8 @@ endpointDecoder =

687

705

688

706

689instance Binary Details where

707instance Binary Details where

690− get = liftM4 Details get get get get

708+ get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }

691− put (Details a b c d) = put a >> put b >> put c >> put d

709+ put (Details a b c d _) = put a >> put b >> put c >> put d

692

710

693

711

694instance Binary ValidOutline where

712instance Binary ValidOutline where