git.iko.soy/elk
on master help sign in
Update "elm install" prompts for new elm.json format
60c99cfEvan Czaplicki
builder/src/Elm/Install.hs+101−62
compare with master
unifiedsplit
@@ -5,7 +5,7 @@ module Elm.Install
5 where
5 where
6
6
7
7
8−import Control.Monad (filterM, forM, msum, void)
8+import Control.Monad (filterM, foldM, forM, msum, void)
9import Control.Monad.Except (catchError, lift, liftIO)
9import Control.Monad.Except (catchError, lift, liftIO)
10import Data.Map ((!))
10import Data.Map ((!))
11import qualified Data.Map as Map
11import qualified Data.Map as Map
@@ -69,11 +69,31 @@ attemptElmJsonChange root oldProject toString changes =
69 AlreadyInstalled ->
69 AlreadyInstalled ->
70 do liftIO $ putStrLn "It is already installed!"
70 do liftIO $ putStrLn "It is already installed!"
71
71
72− PromoteTest newProject ->
73− attempt newProject $ requestPromotion "\"test-dependencies\""
74−
75 PromoteTrans newProject ->
72 PromoteTrans newProject ->
76− attempt newProject $ requestPromotion "\"transitive-dependencies\""
73+ attempt newProject $
74+ D.vcat
75+ [ D.fillSep
76+ ["I","found","it","in","your","elm.json","file,"
77+ ,"but","in","the",D.dullyellow "\"indirect\"","dependencies."
78+ ]
79+ , D.fillSep
80+ ["Should","I","move","it","into",D.green "\"direct\""
81+ ,"dependencies","for","more","general","use?","[Y/n]: "
82+ ]
83+ ]
84+
85+ PromoteTest newProject ->
86+ attempt newProject $
87+ D.vcat
88+ [ D.fillSep
89+ ["I","found","it","in","your","elm.json","file,"
90+ ,"but","in","the",D.dullyellow "\"test-dependencies\"","field."
91+ ]
92+ , D.fillSep
93+ ["Should","I","move","it","into",D.green "\"dependencies\""
94+ ,"for","more","general","use?","[Y/n]: "
95+ ]
96+ ]
77
97
78 Changes changeDict newProject ->
98 Changes changeDict newProject ->
79 let
99 let
@@ -88,20 +108,6 @@ attemptElmJsonChange root oldProject toString changes =
88 ]
108 ]
89
109
90
110
91−requestPromotion :: D.Doc -> D.Doc
92−requestPromotion theWrongPlace =
93− D.vcat
94− [ D.fillSep
95− ["I","found","it","in","your","elm.json","file!"
96− ,"In",D.dullyellow theWrongPlace,"though."
97− ]
98− , D.fillSep
99− ["Should","I","move","it","into",D.green "\"dependencies\""
100− ,"for","more","general","use?","[Y/n]: "
101− ]
102− ]
103−
104−
105
111
106-- MAKE PLANS
112-- MAKE PLANS
107
113
@@ -114,31 +120,21 @@ data Changes vsn
114
120
115
121
116makeAppPlan :: Cache.PackageRegistry -> Pkg.Name -> Project.AppInfo -> Task.Task (Changes Pkg.Version)
122makeAppPlan :: Cache.PackageRegistry -> Pkg.Name -> Project.AppInfo -> Task.Task (Changes Pkg.Version)
117−makeAppPlan registry pkg info@(Project.AppInfo elm srcDirs deps test trans) =
123+makeAppPlan registry pkg info@(Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
118− if Map.member pkg deps then
124+ if Map.member pkg depsDirect then
119 return AlreadyInstalled
125 return AlreadyInstalled
120 else
126 else
121− case Map.lookup pkg test of
127+ do (AppAnswer old new newInfo) <- toAppAnswer registry pkg info
122− Just vsn ->
123− return $ PromoteTest $ Project.App $
124− Project.AppInfo elm srcDirs (Map.insert pkg vsn deps) (Map.delete pkg test) trans
125
128
126− Nothing ->
129+ return $
127− case Map.lookup pkg trans of
130+ if Map.member pkg depsTrans then
128− Just vsn ->
129− return $ PromoteTrans $ Project.App $
131+ PromoteTrans (Project.App newInfo)
130− Project.AppInfo elm srcDirs (Map.insert pkg vsn deps) test (Map.delete pkg trans)
131−
132− Nothing ->
133− do changes <- addToApp registry pkg info
134
132
135− let news = Map.mapMaybe keepNew changes
133+ else if Map.member pkg testDirect || Map.member pkg testTrans then
136− let newDeps = addNews (Just pkg) news deps
134+ PromoteTest (Project.App newInfo)
137− let newTest = addNews Nothing news test
138− let newTrans = Map.union (Map.difference news (Map.union newDeps newTest)) trans
139
135
136+ else
140− return $ Changes changes $ Project.App $
137+ Changes (detectChanges old new) (Project.App newInfo)
141− Project.AppInfo elm srcDirs newDeps newTest newTrans
142
138
143
139
144makePkgPlan :: Cache.PackageRegistry -> Pkg.Name -> Project.PkgInfo -> Task.Task (Changes Constraint)
140makePkgPlan :: Cache.PackageRegistry -> Pkg.Name -> Project.PkgInfo -> Task.Task (Changes Constraint)
@@ -219,40 +215,83 @@ keepNew change =
219-- ADD TO APP
215-- ADD TO APP
220
216
221
217
218+data AppAnswer =
219+ AppAnswer
220+ { _old :: Map.Map Pkg.Name Pkg.Version
221+ , _new :: Map.Map Pkg.Name Pkg.Version
222+ , _info :: Project.AppInfo
223+ }
224+
225+
222−addToApp :: Cache.PackageRegistry -> Pkg.Name -> Project.AppInfo -> Task.Task (Map.Map Pkg.Name (Change Pkg.Version))
226+toAppAnswer :: Cache.PackageRegistry -> Pkg.Name -> Project.AppInfo -> Task.Task AppAnswer
223−addToApp registry pkg info@(Project.AppInfo _ _ deps tests trans) =
227+toAppAnswer registry pkg info@(Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
224 Explorer.run registry $
228 Explorer.run registry $
225 do Explorer.exists pkg
229 do Explorer.exists pkg
226− let old = Map.unions [ deps, tests, trans ]
227− result <- Solver.run (addToAppHelp pkg info)
230+ result <- Solver.run (toAppAnswerHelp pkg info)
228 case result of
231 case result of
229− Just new ->
232+ Just answer ->
230− return $ detectChanges old new
233+ return answer
231
234
232 Nothing ->
235 Nothing ->
236+ do badNames <-
233− do badNames <- filterM isBadElm (pkg : Map.keys old)
237+ filterM isBadElm $
238+ pkg : Map.keys depsDirect
239+ ++ Map.keys depsTrans
240+ ++ Map.keys testDirect
241+ ++ Map.keys testTrans
234 lift $ Task.throw (Exit.Install (E.NoSolution badNames))
242 lift $ Task.throw (Exit.Install (E.NoSolution badNames))
235
243
236
244
237−addToAppHelp :: Pkg.Name -> Project.AppInfo -> Solver.Solver (Map.Map Pkg.Name Pkg.Version)
245+toAppAnswerHelp :: Pkg.Name -> Project.AppInfo -> Solver.Solver AppAnswer
238−addToAppHelp pkg (Project.AppInfo _ _ deps tests trans) =
246+toAppAnswerHelp pkg (Project.AppInfo elm srcDirs depsDirect depsTrans testDirect testTrans) =
239 let
247 let
240 directs =
248 directs =
241− Map.union deps tests
249+ Map.union depsDirect testDirect
250+
251+ directAndTrans =
252+ Map.union directs (Map.union depsTrans testTrans)
253+
254+ try toConstraint deps =
255+ do solution <- Solver.solve $ Map.insert pkg Con.anything (Map.map toConstraint deps)
256+ let newDepsDirect = Map.intersection solution (Map.insert pkg Pkg.dummyVersion depsDirect)
257+ newDeps <- lift $ foldM (collectTransitive solution) Map.empty (Map.keys newDepsDirect)
258+ return $
259+ AppAnswer
260+ { _old = directAndTrans
261+ , _new = solution
262+ , _info =
263+ Project.AppInfo
264+ elm
265+ srcDirs
266+ newDepsDirect
267+ (Map.difference newDeps newDepsDirect)
268+ (Map.intersection solution testDirect)
269+ (Map.difference (Map.difference solution newDeps) testDirect)
270+ }
271+ in
272+ msum
273+ [ try Con.exactly directAndTrans
274+ , try Con.exactly directs
275+ , try Con.untilNextMinor directs
276+ , try Con.untilNextMajor directs
277+ , try (\_ -> Con.anything) directs
278+ ]
279+
280+
281+collectTransitive
282+ :: Map.Map Pkg.Name Pkg.Version
283+ -> Map.Map Pkg.Name Pkg.Version
284+ -> Pkg.Name
285+ -> Explorer (Map.Map Pkg.Name Pkg.Version)
286+collectTransitive solution state name =
287+ do let version = solution ! name
288+ (Explorer.Info _ trans) <- Explorer.getConstraints name version
289+ foldM
290+ (collectTransitive solution)
291+ (Map.insert name version state)
292+ (Map.keys trans)
242
293
243− everything =
244− Map.union directs trans
245
294
246− try constraints =
247− Solver.solve $ Map.insert pkg Con.anything constraints
248− in
249− msum $ map try $
250− [ Map.map Con.exactly everything
251− , Map.map Con.exactly directs
252− , Map.map Con.untilNextMinor directs
253− , Map.map Con.untilNextMajor directs
254− , Map.map (\_ -> Con.anything) directs
255− ]
256
295
257
296
258
297
@@ -326,7 +365,7 @@ viewNonZero title entries =
326 else
365 else
327 [ ""
366 [ ""
328 , D.fromString title
367 , D.fromString title
329− , D.indent 2 (D.vcat (reverse entries))
368+ , D.indent 2 (D.vcat entries)
330 ]
369 ]
331
370
332
371