dependency 0.1.0.3 → 0.1.0.5

raw patch · 6 files changed

+71/−30 lines, 6 filesdep +composition-preludePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: composition-prelude

API changes (from Hackage documentation)

Files

• dependency.cabal +3/−1
• src/Data/Dependency.hs +49/−18
• src/Data/Dependency/Error.hs +16/−5
• src/Data/Dependency/Sort.hs +0/−1
• src/Data/Dependency/Type.hs +2/−4
• test/Spec.hs +1/−1

@@ -1,5 +1,5 @@ name:                dependency-version:             0.1.0.3+version:             0.1.0.5 synopsis:            Dependency resolution for package management description:         A library for resolving dependencies; uses a topological sort to construct a build plan and then allows choice between all compatible plans. license:             BSD3@@ -30,7 +30,9 @@                      , recursion-schemes                      , microlens                      , deepseq+                     , composition-prelude                      , binary+                     , deepseq   default-language:    Haskell2010   if flag(development)     ghc-options:       -Werror

@@ -1,41 +1,72 @@ module Data.Dependency     ( -- * Functions       resolveDependencies-    , isPresent     , buildSequence-    , asGraph+    , satisfies     -- * Types     , Dependency (..)     , PackageSet (..)     , Version (..)+    , DepM+    , ResolveError (..)+    , Constraint (..)     ) where -import           Control.Monad+import           Control.Composition+import           Data.Dependency.Error import           Data.Dependency.Sort import           Data.Dependency.Type-import           Data.List            (groupBy)-import qualified Data.Map             as M-import qualified Data.Set             as S+import           Data.Foldable         (toList)+import           Data.List             (groupBy)+import qualified Data.Map              as M+import qualified Data.Set              as S -isPresent :: PackageSet Version -> Dependency -> Bool-isPresent (PackageSet ps) (Dependency ln _ _ _) = g (M.lookup ln ps)-    where g (Just x) = not (S.null x)-          g Nothing  = False+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) -latest :: (Ord a) => PackageSet a -> Dependency -> Maybe (String, a)+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 <- M.lookup ln ps-    (,) ln <$> S.lookupMax s+    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' -saturateDeps :: PackageSet Dependency -> Dependency -> Maybe [Dependency]-saturateDeps (PackageSet ps) dep = do+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 [ M.lookup lib ps | lib <- libDeps ]-    (:) dep <$> traverse S.lookupMax deps+    deps <- sequence [ lookupMap lib ps | lib <- libDeps ]+    list <- (:) dep <$> traverse lookupSet deps+    pure $ S.fromList list  -- | Heuristics: --@@ -50,7 +81,7 @@ -- 5. Specify an error if a package is not present. -- -- This doesn't do any package resolution beyond versioning.-resolveDependencies :: PackageSet Dependency -> [Dependency] -> Maybe [[Dependency]]+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

@@ -1,13 +1,24 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+ module Data.Dependency.Error ( ResolveError (..)                              , DepM                              ) where -import           Data.Dependency.Type+import           Control.DeepSeq+import           GHC.Generics                 (Generic)+import           Text.PrettyPrint.ANSI.Leijen  type DepM = Either ResolveError  -- | An error that can occur during package resolution.-data ResolveError = NoSolution-                  | CircularDependencies String String-                  | NotPresent [String]-                  | Conflict String String (Constraint Version) (Constraint Version)+data ResolveError = InternalError+                  | NotPresent String+                  deriving (Show, Eq, NFData, Generic)+                  -- CircularDependencies String String+                  -- Conflict String String (Constraint Version) (Constraint Version)++instance Pretty ResolveError where+    pretty InternalError = red "Error:" <+> "the" <+> squotes "dependency" <+> "package enountered an internal error. Please report this as a bug:\n" <> hang 2 "https://hub.darcs.net/vmchale/ats/issues"+    pretty (NotPresent s) = red "Error:" <+> "the package" <+> squotes (text s) <+> "could not be found.\n"

@@ -1,5 +1,4 @@ module Data.Dependency.Sort ( sortDeps-                            , asGraph                             ) where  import           Data.Dependency.Type

@@ -15,7 +15,6 @@                             , Version (..)                             , Constraint (..)                             , PackageSet (..)-                            , BuildTarget (..)                             -- * Helper functions                             , satisfies                             ) where@@ -32,7 +31,7 @@ import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))  newtype PackageSet a = PackageSet (M.Map String (S.Set a))-    deriving (Eq, Ord, Generic)+    deriving (Eq, Ord, Foldable, Generic)     deriving newtype Binary  newtype Version = Version [Integer]@@ -90,11 +89,10 @@ satisfies (Bounded x y) z     = satisfies x z && satisfies y z satisfies None _              = True +-- FIXME make version first data Dependency = Dependency { _libName         :: String                              , _libConstraint   :: Constraint Version                              , _libDependencies :: [String]                              , _libVersion      :: Version                              }                              deriving (Show, Eq, Ord, Generic, NFData)--newtype BuildTarget a = BuildTarget { targetFunction :: (String, Version) -> a }

@@ -32,4 +32,4 @@             buildSequence deps `shouldBe` [[free, comonad], [lens]]     describe "resolveDependencies" $         it "correctly resolves dependencies in a package set" $-            resolveDependencies set [lens] `shouldBe` Just [[free, comonad], [lens]]+            resolveDependencies set [lens] `shouldBe` Right [[free, comonad], [lens]]