git.iko.soy/elk
on master help sign in
Have slightly different API for Deps.Solver
0885d8aEvan Czaplicki
builder/src/Deps/Solver.hs+51−38
compare with master
unifiedsplit
@@ -1,9 +1,8 @@
1{-# LANGUAGE OverloadedStrings, Rank2Types #-}
1{-# LANGUAGE OverloadedStrings, Rank2Types #-}
2module Deps.Solver
2module Deps.Solver
3− ( Solver
3+ ( online
4+ , offline
4 , Details(..)
5 , Details(..)
5− , Connection(..)
6− , solve
7 )
6 )
8 where
7 where
9
8
@@ -11,6 +10,7 @@ module Deps.Solver
11import Control.Monad (foldM)
10import Control.Monad (foldM)
12import qualified Data.Map as Map
11import qualified Data.Map as Map
13import qualified System.Directory as Dir
12import qualified System.Directory as Dir
13+import System.FilePath ((</>))
14
14
15import qualified Deps.Registry as Registry
15import qualified Deps.Registry as Registry
16import qualified Deps.Website as Website
16import qualified Deps.Website as Website
@@ -25,6 +25,48 @@ import qualified Stuff
25
25
26
26
27
27
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+
28-- SOLVER
70-- SOLVER
29
71
30
72
@@ -39,6 +81,10 @@ newtype Solver a =
39 )
81 )
40
82
41
83
84+
85+-- STATE
86+
87+
42data State =
88data State =
43 State
89 State
44 { _cache :: Stuff.PackageCache
90 { _cache :: Stuff.PackageCache
@@ -71,39 +117,6 @@ data Problem
71
117
72
118
73
119
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−
107-- EXPLORE GOALS
120-- EXPLORE GOALS
108
121
109
122
@@ -207,7 +220,7 @@ getConstraints name version =
207
220
208getConstraintsHelp :: Stuff.PackageCache -> Connection -> Pkg.Name -> V.Version -> IO (Either Problem Constraints)
221getConstraintsHelp :: Stuff.PackageCache -> Connection -> Pkg.Name -> V.Version -> IO (Either Problem Constraints)
209getConstraintsHelp cache connection name version =
222getConstraintsHelp 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"
211 outlineExists <- File.exists path
224 outlineExists <- File.exists path
212 if outlineExists
225 if outlineExists
213 then
226 then
@@ -219,7 +232,7 @@ getConstraintsHelp cache connection name version =
219 return $ Right cs
232 return $ Right cs
220
233
221 Offline ->
234 Offline ->
222− do srcExists <- Dir.doesDirectoryExist (Stuff.metadata cache name version "src")
235+ do srcExists <- Dir.doesDirectoryExist (Stuff.package cache name version </> "src")
223 if srcExists
236 if srcExists
224 then return $ Right cs
237 then return $ Right cs
225 else return $ Left (UnavailableOffline name version)
238 else return $ Left (UnavailableOffline name version)