git.iko.soy/elk
on master help sign in
Check for duplicate packages when verifying deps
069250bEvan Czaplicki
builder/src/Deps/Verify.hs+37−3
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ import Control.Monad (filterM, void)
10import Control.Monad.Trans (liftIO)
10import Control.Monad.Trans (liftIO)
11import qualified Data.Map as Map
11import qualified Data.Map as Map
12import qualified Data.Set as Set
12import qualified Data.Set as Set
13+import qualified Data.Map.Merge.Strict as Map
13import Data.Map (Map)
14import Data.Map (Map)
14import Data.Set (Set)
15import Data.Set (Set)
15import System.Directory (doesDirectoryExist)
16import System.Directory (doesDirectoryExist)
@@ -65,7 +66,7 @@ throw exit =
65
66
66
67
67
68
68−-- VERIFY SOLUTION
69+-- VERIFY APP
69
70
70
71
71verifyApp :: AppInfo -> Task.Task (Map Name Version)
72verifyApp :: AppInfo -> Task.Task (Map Name Version)
@@ -74,7 +75,7 @@ verifyApp info =
74 throw (E.AppBadElm (_app_elm_version info))
75 throw (E.AppBadElm (_app_elm_version info))
75
76
76 else
77 else
77− do let oldSolution = Project.appSolution info
78+ do oldSolution <- appToSolution info
78 let solver = Solver.solve (Map.map Con.exactly oldSolution)
79 let solver = Solver.solve (Map.map Con.exactly oldSolution)
79 registry <- Cache.optionalUpdate
80 registry <- Cache.optionalUpdate
80 maybeSolution <- Explorer.run registry (Solver.run solver)
81 maybeSolution <- Explorer.run registry (Solver.run solver)
@@ -89,13 +90,17 @@ verifyApp info =
89 throw (E.AppMissingTrans (Map.toList (Map.difference newSolution oldSolution)))
90 throw (E.AppMissingTrans (Map.toList (Map.difference newSolution oldSolution)))
90
91
91
92
93+
94+-- VERIFY PKG
95+
96+
92verifyPkg :: PkgInfo -> Task.Task (Map Name Version)
97verifyPkg :: PkgInfo -> Task.Task (Map Name Version)
93verifyPkg info =
98verifyPkg info =
94 if not (Con.goodElm (_pkg_elm_version info)) then
99 if not (Con.goodElm (_pkg_elm_version info)) then
95 throw (E.PkgBadElm (_pkg_elm_version info))
100 throw (E.PkgBadElm (_pkg_elm_version info))
96
101
97 else
102 else
98− do let deps = Map.union (_pkg_deps info) (_pkg_test_deps info)
103+ do deps <- union noDups (_pkg_deps info) (_pkg_test_deps info)
99 let solver = Solver.solve deps
104 let solver = Solver.solve deps
100 registry <- Cache.optionalUpdate
105 registry <- Cache.optionalUpdate
101 maybeSolution <- Explorer.run registry (Solver.run solver)
106 maybeSolution <- Explorer.run registry (Solver.run solver)
@@ -108,6 +113,35 @@ verifyPkg info =
108
113
109
114
110
115
116+-- APP TO SOLUTION
117+
118+
119+appToSolution :: Project.AppInfo -> Task.Task (Map Name Version)
120+appToSolution (Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
121+ do a <- union allowEqualDups depsTrans testDirect
122+ b <- union noDups depsDirect testTrans
123+ union noDups a b
124+
125+
126+noDups :: Name -> a -> a -> Task.Task a
127+noDups _ _ _ =
128+ throw E.BadDeps
129+
130+
131+allowEqualDups :: Name -> Version -> Version -> Task.Task Version
132+allowEqualDups _ v1 v2 =
133+ if v1 == v2 then
134+ return v1
135+ else
136+ throw E.BadDeps
137+
138+
139+union :: (Name -> a -> a -> Task.Task a) -> Map Name a -> Map Name a -> Task.Task (Map Name a)
140+union tieBreaker deps1 deps2 =
141+ Map.mergeA Map.preserveMissing Map.preserveMissing (Map.zipWithAMatched tieBreaker) deps1 deps2
142+
143+
144+
111-- VERIFY ARTIFACTS
145-- VERIFY ARTIFACTS
112
146
113
147