module Data.Dependency ( -- * Functions resolveDependencies , buildSequence , satisfies -- * Types , Dependency (..) , PackageSet (..) , Version (..) , DepM , ResolveError (..) , Constraint (..) ) where import Control.Composition import Data.Dependency.Error import Data.Dependency.Sort import Data.Dependency.Type import Data.Foldable (toList) import Data.List (groupBy) import qualified Data.Map as M import qualified Data.Set as S lookupMap :: String -> M.Map String a -> DepM a lookupMap k ps = case M.lookup k ps of Just x -> Right x Nothing -> Left (NotPresent k) lookupSet :: S.Set a -> DepM a lookupSet s = case S.lookupMax s of Just x -> Right x Nothing -> Left InternalError latest :: (Ord a) => PackageSet a -> Dependency -> DepM (String, a) latest (PackageSet ps) (Dependency ln _ _ _) = do s <- lookupMap ln ps (,) ln <$> lookupSet s buildSequence :: [Dependency] -> [[Dependency]] buildSequence = reverse . groupBy independent . sortDeps where independent (Dependency ln _ ls _) (Dependency ln' _ ls' _) = ln' `notElem` ls && ln `notElem` ls' dock :: (Eq a, Ord a) => [S.Set a] -> S.Set a dock [x] = x dock [] = S.fromList [] dock (x:ys@(y:_)) | x == y = y | otherwise = dock ys iterateM :: (Monad m) => Int -> (a -> m a) -> a -> m [a] iterateM 0 _ _ = pure [] iterateM n f x = (x:) <$> (iterateM (n-1) f =<< f x) -- FIXME saturate everything at once. saturateDeps :: PackageSet Dependency -> Dependency -> DepM [Dependency] saturateDeps ps = fmap toList . resolve <=< saturateDeps' ps where resolve :: S.Set Dependency -> DepM (S.Set Dependency) resolve set = dock <$> iterateM n next set next :: S.Set Dependency -> DepM (S.Set Dependency) next depSet = S.unions <$> sequence (saturateDeps' ps <$> toList depSet) n :: Int n = length (toList ps) saturateDeps' :: PackageSet Dependency -> Dependency -> DepM (S.Set Dependency) saturateDeps' (PackageSet ps) dep = do let libDeps = _libDependencies dep deps <- sequence [ lookupMap lib ps | lib <- libDeps ] list <- (:) dep <$> traverse lookupSet deps pure $ S.fromList list -- | Heuristics: -- -- 1. Always use a newer version when possible -- -- 2. Obey constraints -- -- 3. Specify an error for circular dependencies -- -- 4. Specify an error for overconstrained builds -- -- 5. Specify an error if a package is not present. -- -- This doesn't do any package resolution beyond versioning. resolveDependencies :: PackageSet Dependency -> [Dependency] -> DepM [[Dependency]] resolveDependencies ps = select . getLatest <=< fmap buildSequence . saturated where select = fmap (fmap (fmap snd)) saturated dep = join <$> traverse (saturateDeps ps) dep getLatest = traverse (traverse (latest ps))