@@ -10,6 +10,7 @@ import Control.Monad (filterM, void)
1010import Control.Monad.Trans (liftIO)
1111import qualified Data.Map as Map
1212import qualified Data.Set as Set
13+import qualified Data.Map.Merge.Strict as Map
1314import Data.Map (Map)
1415import Data.Set (Set)
1516import System.Directory (doesDirectoryExist)
@@ -65,7 +66,7 @@ throw exit =
6566
6667
6768
68−-- VERIFY SOLUTION
69+-- VERIFY APP
6970
7071
7172verifyApp :: AppInfo -> Task.Task (Map Name Version)
@@ -74,7 +75,7 @@ verifyApp info =
7475 throw (E.AppBadElm (_app_elm_version info))
7576
7677 else
77− do let oldSolution = Project.appSolution info
78+ do oldSolution <- appToSolution info
7879 let solver = Solver.solve (Map.map Con.exactly oldSolution)
7980 registry <- Cache.optionalUpdate
8081 maybeSolution <- Explorer.run registry (Solver.run solver)
@@ -89,13 +90,17 @@ verifyApp info =
8990 throw (E.AppMissingTrans (Map.toList (Map.difference newSolution oldSolution)))
9091
9192
93+
94+-- VERIFY PKG
95+
96+
9297verifyPkg :: PkgInfo -> Task.Task (Map Name Version)
9398verifyPkg info =
9499 if not (Con.goodElm (_pkg_elm_version info)) then
95100 throw (E.PkgBadElm (_pkg_elm_version info))
96101
97102 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)
99104 let solver = Solver.solve deps
100105 registry <- Cache.optionalUpdate
101106 maybeSolution <- Explorer.run registry (Solver.run solver)
@@ -108,6 +113,35 @@ verifyPkg info =
108113
109114
110115
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+
111145-- VERIFY ARTIFACTS
112146
113147