git.iko.soy/elk
on 6a96e21 help sign in
elk/builder/src/Deps/Solver.hs
103 lines 2.6 kB history raw
1module Deps.Solver
2 ( Solver
3 , run
4 , solve
5 )
6 where
9import Control.Monad (foldM, guard, mzero, msum)
10import Control.Monad.Logic (LogicT, runLogicT, lift)
11import qualified Data.List as List
12import qualified Data.Map as Map
13import Data.Map (Map)
15import Elm.Package (Name, Version)
17import Deps.Explorer (Explorer)
18import qualified Deps.Explorer as Explorer
19import Elm.Project.Constraint (Constraint)
20import qualified Elm.Project.Constraint as Con
24-- SOLVE
27solve :: Map Name Constraint -> Solver (Map Name Version)
28solve cons =
29 mkSolver (State Map.empty cons)
32type Solver a =
33 LogicT Explorer a
36run :: Solver a -> Explorer (Maybe a)
37run solver =
38 runLogicT solver (const . return . Just) (return Nothing)
42-- SOLVER
45data State =
46 State
47 { _solution :: Map Name Version
48 , _unsolved :: Map Name Constraint
49 }
52mkSolver :: State -> Solver (Map Name Version)
53mkSolver (State solution unsolved) =
54 case Map.minViewWithKey unsolved of
55 Nothing ->
56 return solution
58 Just ((name, constraint), otherUnsolved) ->
59 do allVersions <- lift $ Explorer.getVersions name
60 let versions =
61 reverse $ List.sort $
62 filter (Con.satisfies constraint) allVersions
64 let state1 = State solution otherUnsolved
65 state2 <- msum (map (addVersion state1 name) versions)
66 mkSolver state2
69addVersion :: State -> Name -> Version -> Solver State
70addVersion (State solution unsolved) name version =
71 do (Explorer.Info elm cons) <-
72 lift $ Explorer.getConstraints name version
74 guard (Con.goodElm elm)
75 newUnsolved <- foldM (addConstraint solution) unsolved (Map.toList cons)
76 return (State (Map.insert name version solution) newUnsolved)
79addConstraint :: Map Name Version -> Map Name Constraint -> (Name, Constraint) -> Solver (Map Name Constraint)
80addConstraint solution unsolved (name, newConstraint) =
81 case Map.lookup name solution of
82 Just version ->
83 if Con.satisfies newConstraint version then
84 return unsolved
85 else
86 mzero
88 Nothing ->
89 case Map.lookup name unsolved of
90 Nothing ->
91 return $ Map.insert name newConstraint unsolved
93 Just oldConstraint ->
94 case Con.intersect oldConstraint newConstraint of
95 Nothing ->
96 mzero
98 Just mergedConstraint ->
99 if oldConstraint == mergedConstraint then
100 return unsolved
101 else
102 return (Map.insert name mergedConstraint unsolved)