dependency 0.1.0.7 → 0.1.0.8

raw patch · 7 files changed

+108/−43 lines, 7 filesdep +tardisdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tardis, transformers

API changes (from Hackage documentation)

Files

• bench/Bench.hs +7/−5
• dependency.cabal +3/−1
• src/Data/Dependency.hs +37/−16
• src/Data/Dependency/Error.hs +2/−0
• src/Data/Dependency/Sort.hs +1/−1
• src/Data/Dependency/Type.hs +48/−15
• test/Spec.hs +10/−5

@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ module Main where  import           Control.Arrow@@ -7,22 +9,22 @@ import qualified Data.Set        as S  free :: Dependency-free = Dependency "free" mempty mempty defV+free = Dependency "free" mempty defV  comonad :: Dependency-comonad = Dependency "comonad" mempty mempty defV+comonad = Dependency "comonad" mempty defV  lens :: Dependency-lens = Dependency "lens" mempty ["free", "comonad"] defV+lens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) defV  defV :: Version defV = Version [0,1,0]  microlens :: Dependency-microlens = Dependency "microlens" mempty mempty defV+microlens = Dependency "microlens" mempty defV  bifunctors :: Dependency-bifunctors = Dependency "bifunctors" mempty ["comonad"] defV+bifunctors = Dependency "bifunctors" ((,mempty) <$> ["comonad"]) defV  deps :: [Dependency] deps = [free, lens, comonad]

@@ -1,5 +1,5 @@ name:                dependency-version:             0.1.0.7+version:             0.1.0.8 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@@ -29,9 +29,11 @@                      , containers                      , recursion-schemes                      , microlens+                     , transformers                      , deepseq                      , binary                      , deepseq+                     , tardis   default-language:    Haskell2010   if flag(development)     ghc-options:       -Werror

@@ -3,6 +3,7 @@       resolveDependencies     , buildSequence     , satisfies+    , compatible     -- * Types     , Dependency (..)     , PackageSet (..)@@ -10,35 +11,52 @@     , DepM     , ResolveError (..)     , Constraint (..)+    , ResolveStateM (..)+    , ResolveState+    , ResMap     ) where  import           Control.Monad+import           Control.Monad.Tardis+import           Control.Monad.Trans.Class 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+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+checkWith :: Dependency -> [Dependency] -> S.Set Dependency -> DepM Dependency+checkWith x ds s+    | check x ds = Right x+    | otherwise = lookupSet ds (S.deleteMax s) -latest :: (Ord a) => PackageSet a -> Dependency -> DepM (String, a)-latest (PackageSet ps) (Dependency ln _ _ _) = do-    s <- lookupMap ln ps-    (,) ln <$> lookupSet s+lookupSet :: [Dependency] -- ^ Dependencies already added+          -> S.Set Dependency -- ^ Set of dependencies+          -> DepM Dependency+lookupSet ds s = case S.lookupMax s of+    Just x  -> checkWith x ds s+    Nothing -> g s +    where g s'+            | S.size s' > 0 = Left (Conflict (_libName <$> ds) (_libName . head . toList $ s'))+            | otherwise = Left InternalError++latest :: PackageSet Dependency -> Dependency -> ResolveState (String, Dependency)+latest (PackageSet ps) (Dependency ln _ _) = do+    st <- getPast+    s <- lift $ lookupMap ln ps+    (,) ln <$> lift (lookupSet (toList st) s)+ buildSequence :: [Dependency] -> [[Dependency]] buildSequence = reverse . groupBy independent . sortDeps-    where independent (Dependency ln _ ls _) (Dependency ln' _ ls' _) = ln' `notElem` ls && ln `notElem` ls'+    where independent (Dependency ln ls _) (Dependency ln' ls' _) = ln' `notElem` (fst <$> ls) && ln `notElem` (fst <$> ls')  iterateM :: (Monad m) => Int -> (a -> m a) -> a -> m [a] iterateM 0 _ _ = pure []@@ -52,10 +70,13 @@  saturateDeps' :: PackageSet Dependency -> Dependency -> DepM (S.Set Dependency) saturateDeps' (PackageSet ps) dep = do-    deps <- sequence [ lookupMap lib ps | lib <- _libDependencies dep ]-    list <- (:) dep <$> traverse lookupSet deps+    deps <- sequence [ lookupMap lib ps | lib <- fst <$> _libDependencies dep ]+    list <- (:) dep <$> traverse (lookupSet mempty) deps     pure $ S.fromList list +run :: ResolveState a -> DepM a+run = flip evalTardisT (id, mempty) . unResolve+ -- | Heuristics: -- -- 1. Always use a newer version when possible@@ -73,4 +94,4 @@ resolveDependencies ps = select . getLatest <=< fmap (buildSequence . toList) . saturated     where select = fmap (fmap (fmap snd))           saturated dep = S.unions <$> traverse (saturateDeps ps) dep-          getLatest = traverse (traverse (latest ps))+          getLatest = run . traverse (traverse (latest ps))

@@ -15,6 +15,7 @@ -- | An error that can occur during package resolution. data ResolveError = InternalError                   | NotPresent String+                  | Conflict [String] String                   deriving (Show, Eq, NFData, Generic)                   -- CircularDependencies String String                   -- Conflict String String (Constraint Version) (Constraint Version)@@ -22,3 +23,4 @@ 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"+    pretty (Conflict ss s) = red "Error:" <+> "the package" <+> squotes (text s) <+> "conflicts with already in-scope packages: " <+> pretty ss

@@ -8,7 +8,7 @@  asGraph :: [Dependency] -> (Graph, Vertex -> Dependency) asGraph ds = (f triple, keys)-    where triple = graphFromEdges (zip3 ds (_libName <$> ds) (_libDependencies <$> ds))+    where triple = graphFromEdges (zip3 ds (_libName <$> ds) (fmap fst . _libDependencies <$> ds))           f = view _1           s = view _2           keys = view _1 . s triple

@@ -5,6 +5,7 @@ {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures             #-} {-# LANGUAGE OverloadedStrings          #-}@@ -16,12 +17,21 @@                             , Version (..)                             , Constraint (..)                             , PackageSet (..)+                            , ResMap+                            , ResolveStateM (..)+                            , ResolveState                             -- * Helper functions                             , satisfies+                            , compatible+                            , check                             ) where  import           Control.DeepSeq              (NFData)+import           Control.Monad.Fix+import           Control.Monad.Tardis+import           Control.Monad.Trans.Class import           Data.Binary+import           Data.Dependency.Error import           Data.Functor.Foldable import           Data.Functor.Foldable.TH import           Data.List                    (intercalate)@@ -33,6 +43,17 @@ import           GHC.Generics                 (Generic) import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) +type Mod = ResMap -> ResMap+type ResMap = M.Map String Dependency+type ResolveState = ResolveStateM (Either ResolveError)++newtype ResolveStateM m a = ResolveStateM { unResolve :: TardisT Mod ResMap m a }+    deriving (Functor)+    deriving newtype (Applicative, Monad, MonadFix, MonadTardis Mod ResMap)++instance MonadTrans ResolveStateM where+    lift = ResolveStateM . lift+ newtype PackageSet a = PackageSet (M.Map String (S.Set a))     deriving (Eq, Ord, Foldable, Generic)     deriving newtype Binary@@ -75,15 +96,15 @@     mempty = None     mappend = (<>) -makeBaseFunctor ''Constraint+data Dependency = Dependency { _libName         :: String+                             , _libDependencies :: [(String, Constraint Version)]+                             , _libVersion      :: Version+                             }+                             deriving (Show, Eq, Ord, Generic, NFData) -instance Pretty a => Pretty (Constraint a) where-    pretty = cata a where-        a (LessThanEqF v)    = "≤" <+> pretty v-        a (GreaterThanEqF v) = "≥" <+> pretty v-        a (EqF v)            = "≡" <+> pretty v-        a (BoundedF c c')    = c <+> "∧" <+> c'-        a NoneF              = mempty+check :: Dependency -> [Dependency] -> Bool+check (Dependency ln _ v) ds = and [ g v ds' | (Dependency _ ds' _) <- ds ]+    where g v' = all (`satisfies` v') . fmap snd . filter ((== ln) . fst)  satisfies :: (Ord a) => Constraint a -> a -> Bool satisfies (LessThanEq x) y    = x <= y@@ -92,10 +113,22 @@ 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)+compatible :: (Ord a) => Constraint a -> Constraint a -> Bool+compatible LessThanEq{} LessThanEq{}        = True+compatible (LessThanEq x) (GreaterThanEq y) = y <= x+compatible (Eq x) (Eq y)                    = x == y+compatible (Bounded x y) z                  = compatible x z && compatible y z+compatible GreaterThanEq{} GreaterThanEq{}  = True+compatible (LessThanEq x) (Eq y)            = y <= x+compatible None _                           = True+compatible x y                              = compatible y x++makeBaseFunctor ''Constraint++instance Pretty a => Pretty (Constraint a) where+    pretty = cata a where+        a (LessThanEqF v)    = "≤" <+> pretty v+        a (GreaterThanEqF v) = "≥" <+> pretty v+        a (EqF v)            = "≡" <+> pretty v+        a (BoundedF c c')    = c <+> "∧" <+> c'+        a NoneF              = mempty

@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ import           Control.Arrow import           Data.Dependency import qualified Data.Map        as M@@ -5,13 +7,16 @@ import           Test.Hspec  free :: Dependency-free = Dependency "free" mempty mempty defV+free = Dependency "free" mempty defV  comonad :: Dependency-comonad = Dependency "comonad" mempty mempty defV+comonad = Dependency "comonad" mempty defV +newLens :: Dependency+newLens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) (Version [0,2,0])+ lens :: Dependency-lens = Dependency "lens" mempty ["free", "comonad"] defV+lens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) defV  defV :: Version defV = Version [0,1,0]@@ -23,7 +28,7 @@ mapSingles = fmap (second S.singleton)  set :: PackageSet Dependency-set = PackageSet $ M.fromList (mapSingles [("lens", lens), ("comonad", comonad), ("free", free)])+set = PackageSet $ M.fromList (("lens", S.fromList [lens, newLens]) : mapSingles [("comonad", comonad), ("free", free)])  main :: IO () main = hspec $ parallel $ do@@ -32,4 +37,4 @@             buildSequence deps `shouldBe` [[free, comonad], [lens]]     describe "resolveDependencies" $         it "correctly resolves dependencies in a package set" $-            resolveDependencies set [lens] `shouldBe` Right [[free, comonad], [lens]]+            resolveDependencies set [lens] `shouldBe` Right [[free, comonad], [newLens]]