git.iko.soy/elk
on master help sign in
Rebuild cache reliably when upgrading transitive dependencies
9bac5d4Evan Czaplicki
builder/src/Deps/Verify.hs+2−3
compare with master
unifiedsplit
@@ -48,12 +48,11 @@ import qualified Stuff.Paths as Paths
48-- VERIFY
48-- VERIFY
49
49
50
50
51−verify :: FilePath -> Project -> Task.Task (Map Name Version, Summary.Summary)
51+verify :: FilePath -> Project -> Task.Task Summary.Summary
52verify root project =
52verify root project =
53 do solution <- Project.get verifyApp verifyPkg project
53 do solution <- Project.get verifyApp verifyPkg project
54 (RawInfo infos ifaces) <- verifyArtifacts solution
54 (RawInfo infos ifaces) <- verifyArtifacts solution
55− let summary = Summary.init root project infos ifaces
55+ return (Summary.init root project infos ifaces)
56− return (solution, summary)
57
56
58
57
59throw :: E.Exit -> Task.Task a
58throw :: E.Exit -> Task.Task a
builder/src/Elm/Project/Constraint.hs+26
@@ -18,6 +18,9 @@ module Elm.Project.Constraint
18 )
18 )
19 where
19 where
20
20
21+
22+import Control.Monad (liftM4)
23+import Data.Binary
21import qualified Data.Text as Text
24import qualified Data.Text as Text
22import Data.Text (Text)
25import Data.Text (Text)
23
26
@@ -232,3 +235,26 @@ expand constraint@(Range lower lowerOp upperOp upper) version
232
235
233 | otherwise =
236 | otherwise =
234 constraint
237 constraint
238+
239+
240+
241+-- BINARY
242+
243+
244+instance Binary Constraint where
245+ get = liftM4 Range get get get get
246+ put (Range a b c d) = put a >> put b >> put c >> put d
247+
248+
249+instance Binary Op where
250+ put op =
251+ case op of
252+ Less -> putWord8 0
253+ LessOrEqual -> putWord8 1
254+
255+ get =
256+ do n <- getWord8
257+ case n of
258+ 0 -> return Less
259+ 1 -> return LessOrEqual
260+ _ -> error "binary encoding of Op was corrupted"
builder/src/Stuff/Paths.hs−6
@@ -1,7 +1,6 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Stuff.Paths
2module Stuff.Paths
3 ( docs
3 ( docs
4− , solution
5 , summary
4 , summary
6 , prepublishDir
5 , prepublishDir
7 , removeStuff
6 , removeStuff
@@ -37,11 +36,6 @@ docs =
37 stuff </> "docs.json"
36 stuff </> "docs.json"
38
37
39
38
40−solution :: FilePath
41−solution =
42− stuff </> "solution.dat"
43−
44−
45summary :: FilePath
39summary :: FilePath
46summary =
40summary =
47 stuff </> "summary.dat"
41 stuff </> "summary.dat"
builder/src/Stuff/Verify.hs+79−52
@@ -5,14 +5,14 @@ module Stuff.Verify
5 where
5 where
6
6
7
7
8−import Prelude hiding (read)
8+import Control.Monad (liftM2, liftM3, liftM4)
9−import qualified Data.Map as Map
9+import Data.Binary
10import Data.Map (Map)
10import Data.Map (Map)
11
11
12+import qualified Elm.Compiler.Module as Module
12import Elm.Package (Name, Version)
13import Elm.Package (Name, Version)
13
14
14import qualified Deps.Verify as Verify
15import qualified Deps.Verify as Verify
15−import Elm.Project.Json (Project(..), PkgInfo(..))
16import qualified Elm.Project.Json as Project
16import qualified Elm.Project.Json as Project
17import qualified Elm.Project.Constraint as Con
17import qualified Elm.Project.Constraint as Con
18import qualified Elm.Project.Summary as Summary
18import qualified Elm.Project.Summary as Summary
@@ -25,72 +25,99 @@ import qualified Stuff.Paths as Path
25-- VERIFY
25-- VERIFY
26
26
27
27
28−verify :: FilePath -> Project -> Task.Task Summary.Summary
28+verify :: FilePath -> Project.Project -> Task.Task Summary.Summary
29verify root project =
29verify root project =
30− do fresh <-
30+ do exists <- IO.exists Path.summary
31− IO.andM
31+ if exists
32− [ IO.exists Path.solution
32+ then
33+ do (MiniSummary deps exposed ifaces graph) <- IO.readBinary Path.summary
34+ if isValidMiniSummary deps project
35+ then
36+ return (Summary.Summary root project exposed ifaces graph)
37+ else
33− , IO.exists Path.summary
38+ do IO.remove Path.summary
34− , checkSolution project
39+ cacheSummary root project
35− ]
40+ else
41+ cacheSummary root project
42+
43+
44+cacheSummary :: FilePath -> Project.Project -> Task.Task Summary.Summary
45+cacheSummary root project =
46+ do summary@(Summary.Summary _ _ exposed ifaces graph) <- Verify.verify root project
47+ IO.writeBinary Path.summary (MiniSummary (getDeps project) exposed ifaces graph)
48+ return summary
36
49
37− if fresh
38− then read root project
39− else rebuildCache root project
40
50
41
51
42−rebuildCache :: FilePath -> Project -> Task.Task Summary.Summary
52+-- MINI SUMMARY
43−rebuildCache root project =
44− do IO.remove Path.solution
45− IO.remove Path.summary
46
53
47− (solution, summary) <- Verify.verify root project
48
54
49− IO.writeBinary Path.solution solution
55+data MiniSummary =
50− write summary
56+ MiniSummary
51− return summary
57+ { _deps :: ProjectDeps
58+ , _exposed :: Summary.ExposedModules
59+ , _ifaces :: Module.Interfaces
60+ , _depsGraph :: Summary.DepsGraph
61+ }
52
62
53
63
64+data ProjectDeps
65+ = App (Map Name Version) (Map Name Version) (Map Name Version)
66+ | Pkg (Map Name Con.Constraint) (Map Name Con.Constraint)
54
67
55−-- READ / WRITE
56
68
69+getDeps :: Project.Project -> ProjectDeps
70+getDeps project =
71+ case project of
72+ Project.App (Project.AppInfo _ _ direct test trans) ->
73+ App direct test trans
57
74
58−read :: FilePath -> Project -> Task.Task Summary.Summary
75+ Project.Pkg (Project.PkgInfo _ _ _ _ _ direct test _) ->
59−read root project =
76+ Pkg direct test
60− do (exposed, ifaces, graph) <- IO.readBinary Path.summary
61− return (Summary.Summary root project exposed ifaces graph)
62
77
63
78
64−write :: Summary.Summary -> Task.Task ()
79+isValidMiniSummary :: ProjectDeps -> Project.Project -> Bool
65−write (Summary.Summary _ _ exposed ifaces graph) =
80+isValidMiniSummary deps project =
66− IO.writeBinary Path.summary ( exposed, ifaces, graph )
81+ case deps of
82+ App cachedDirect cachedTest cachedTrans ->
83+ case project of
84+ Project.Pkg _ ->
85+ False
67
86
87+ Project.App (Project.AppInfo _ _ direct test trans) ->
88+ cachedDirect == direct
89+ && cachedTest == test
90+ && cachedTrans == trans
68
91
92+ Pkg cachedDirect cachedTest ->
93+ case project of
94+ Project.Pkg (Project.PkgInfo _ _ _ _ _ direct test _) ->
95+ cachedDirect == direct
96+ && cachedTest == test
69
97
70−-- CHECK SOLUTION
98+ Project.App _ ->
99+ False
71
100
72
101
73−checkSolution :: Project -> Task.Task Bool
74−checkSolution project =
75− checkSolutionHelp project <$> IO.readBinary Path.solution
76
102
103+-- BINARY
77
104
78−checkSolutionHelp :: Project -> Map Name Version -> Bool
105+
79−checkSolutionHelp project solution =
106+instance Binary MiniSummary where
107+ get = liftM4 MiniSummary get get get get
108+ put (MiniSummary a b c d) = put a >> put b >> put c >> put d
109+
110+
111+
112+instance Binary ProjectDeps where
113+ put deps =
80− case project of
114+ case deps of
81− App info ->
115+ App a b c -> putWord8 0 >> put a >> put b >> put c
82− solution == Project.appSolution info
116+ Pkg a b -> putWord8 1 >> put a >> put b
83−
117+
84− Pkg info ->
118+ get =
85− allGood (_pkg_test_deps info) solution
119+ do n <- getWord8
86− && allGood (_pkg_deps info) solution
120+ case n of
87−
121+ 0 -> liftM3 App get get get
88−
122+ 1 -> liftM2 Pkg get get
89−allGood :: Map Name Con.Constraint -> Map Name Version -> Bool
123+ _ -> error "binary encoding of ProjectDeps was corrupted"
90−allGood cons vsns =
91− let
92− bools =
93− Map.intersectionWith Con.satisfies cons vsns
94− in
95− Map.size cons == Map.size bools
96− && Map.foldr (&&) True bools