@@ -1,9 +1,8 @@
11{-# LANGUAGE OverloadedStrings, Rank2Types #-}
22module Deps.Solver
3− ( Solver
3+ ( online
4+ , offline
45 , Details(..)
5− , Connection(..)
6− , solve
76 )
87 where
98
@@ -11,6 +10,7 @@ module Deps.Solver
1110import Control.Monad (foldM)
1211import qualified Data.Map as Map
1312import qualified System.Directory as Dir
13+import System.FilePath ((</>))
1414
1515import qualified Deps.Registry as Registry
1616import qualified Deps.Website as Website
@@ -25,6 +25,48 @@ import qualified Stuff
2525
2626
2727
28+-- ONLINE / OFFLINE
29+
30+
31+online :: Stuff.PackageCache -> Http.Manager -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Either [Problem] (Map.Map Pkg.Name Details))
32+online cache manager registry constraints =
33+ solve cache (Online manager) registry constraints
34+
35+
36+offline :: Stuff.PackageCache -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Either [Problem] (Map.Map Pkg.Name Details))
37+offline cache registry constraints =
38+ solve cache Offline registry constraints
39+
40+
41+
42+-- SOLVE
43+
44+
45+data Details =
46+ Details V.Version (Map.Map Pkg.Name C.Constraint)
47+
48+
49+solve :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Either [Problem] (Map.Map Pkg.Name Details))
50+solve cache connection registry constraints =
51+ let
52+ (Solver solver) = exploreGoals (Goals constraints Map.empty)
53+ in
54+ solver (State cache connection registry Map.empty [])
55+ (\(State _ _ _ cs _) vs _ -> return $ Right $ Map.mapWithKey (toDetails cs) vs)
56+ (\(State _ _ _ _ ps) -> return $ Left ps)
57+
58+
59+toDetails :: Map.Map (Pkg.Name, V.Version) Constraints -> Pkg.Name -> V.Version -> Details
60+toDetails constraints name vsn =
61+ case Map.lookup (name, vsn) constraints of
62+ Just (Constraints _ deps) ->
63+ Details vsn deps
64+
65+ Nothing ->
66+ error "compiler bug in Deps.Solver manifesting in toDetails"
67+
68+
69+
2870-- SOLVER
2971
3072
@@ -39,6 +81,10 @@ newtype Solver a =
3981 )
4082
4183
84+
85+-- STATE
86+
87+
4288data State =
4389 State
4490 { _cache :: Stuff.PackageCache
@@ -71,39 +117,6 @@ data Problem
71117
72118
73119
74−-- SOLVE
75−
76−
77−data Details =
78− Details V.Version [Pkg.Name]
79−
80−
81−solve :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Either [Problem] (Map.Map Pkg.Name Details))
82−solve cache connection registry constraints =
83− let
84− (Solver solver) = exploreGoals (Goals constraints Map.empty)
85− in
86− solver (State cache connection registry Map.empty [])
87− (\(State _ _ _ cs _) vs _ -> return $ Right $ getDetails vs cs)
88− (\(State _ _ _ _ ps) -> return $ Left ps)
89−
90−
91−getDetails :: Map.Map Pkg.Name V.Version -> Map.Map (Pkg.Name, V.Version) Constraints -> Map.Map Pkg.Name Details
92−getDetails solution constraints =
93− Map.mapWithKey (getDetailsHelp constraints) solution
94−
95−
96−getDetailsHelp :: Map.Map (Pkg.Name, V.Version) Constraints -> Pkg.Name -> V.Version -> Details
97−getDetailsHelp constraints name vsn =
98− case Map.lookup (name, vsn) constraints of
99− Just (Constraints _ deps) ->
100− Details vsn (Map.keys deps)
101−
102− Nothing ->
103− error "compiler bug in Deps.Solver manifesting in getDetailsHelp"
104−
105−
106−
107120-- EXPLORE GOALS
108121
109122
@@ -207,7 +220,7 @@ getConstraints name version =
207220
208221getConstraintsHelp :: Stuff.PackageCache -> Connection -> Pkg.Name -> V.Version -> IO (Either Problem Constraints)
209222getConstraintsHelp cache connection name version =
210− do let path = Stuff.metadata cache name version "elm.json"
223+ do let path = Stuff.package cache name version </> "elm.json"
211224 outlineExists <- File.exists path
212225 if outlineExists
213226 then
@@ -219,7 +232,7 @@ getConstraintsHelp cache connection name version =
219232 return $ Right cs
220233
221234 Offline ->
222− do srcExists <- Dir.doesDirectoryExist (Stuff.metadata cache name version "src")
235+ do srcExists <- Dir.doesDirectoryExist (Stuff.package cache name version </> "src")
223236 if srcExists
224237 then return $ Right cs
225238 else return $ Left (UnavailableOffline name version)