packages feed

dependency 0.1.0.9 → 0.1.0.10

raw patch · 6 files changed

+146/−101 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.Dependency: Conflict :: [String] -> String -> ResolveError
- Data.Dependency: compatible :: (Ord a) => Constraint a -> Constraint a -> Bool
- Data.Dependency: satisfies :: (Ord a) => Constraint a -> a -> Bool
+ Data.Dependency: Conflicts :: [String] -> String -> ResolveError
+ Data.Dependency: [_packageSet] :: PackageSet a -> Map String (Set a)
+ Data.Dependency: check :: Dependency -> [Dependency] -> Bool
- Data.Dependency: PackageSet :: (Map String (Set a)) -> PackageSet a
+ Data.Dependency: PackageSet :: Map String (Set a) -> PackageSet a

Files

dependency.cabal view
@@ -1,76 +1,90 @@-name:                dependency-version:             0.1.0.9-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-license-file:        LICENSE-author:              Vanessa McHale-maintainer:          vamchale@gmail.com-copyright:           Copyright: (c) 2018 Vanessa McHale-category:            Development, Build-build-type:          Simple-extra-doc-files:     README.md-cabal-version:       1.18+cabal-version: 1.18+name: dependency+version: 0.1.0.10+license: BSD3+license-file: LICENSE+copyright: Copyright: (c) 2018 Vanessa McHale+maintainer: vamchale@gmail.com+author: Vanessa McHale+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.+category: Development, Build+build-type: Simple+extra-doc-files: README.md -Flag development {-  Description: Enable `-Werror`-  manual: True-  default: False-}+source-repository head+    type: darcs+    location: https://hub.darcs.net/vmchale/ats +flag development+    description:+        Enable `-Werror`+    default: False+    manual: True+ library-  hs-source-dirs:      src-  exposed-modules:     Data.Dependency-  other-modules:       Data.Dependency.Type-                     , Data.Dependency.Error-                     , Data.Dependency.Sort-  build-depends:       base >= 4.10 && < 5-                     , ansi-wl-pprint-                     , containers-                     , recursion-schemes-                     , microlens-                     , transformers-                     , deepseq-                     , binary-                     , deepseq-                     , tardis-  default-language:    Haskell2010-  if flag(development)-    ghc-options:       -Werror-  if impl(ghc >= 8.0)-    ghc-options:       -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat-  ghc-options:         -Wall+    exposed-modules:+        Data.Dependency+    hs-source-dirs: src+    other-modules:+        Data.Dependency.Type+        Data.Dependency.Error+        Data.Dependency.Sort+    default-language: Haskell2010+    ghc-options: -Wall+    build-depends:+        base >=4.10 && <5,+        ansi-wl-pprint -any,+        containers -any,+        recursion-schemes -any,+        microlens -any,+        transformers -any,+        binary -any,+        deepseq -any,+        tardis -any+    +    if flag(development)+        ghc-options: -Werror+    +    if impl(ghc >=8.0)+        ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates+                     -Wcompat  test-suite dependency-test-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs-  build-depends:       base-                     , dependency-                     , hspec-                     , containers-  if flag(development)-    ghc-options:       -Werror-  if impl(ghc >= 8.0)-    ghc-options:       -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:    Haskell2010+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs: test+    default-language: Haskell2010+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+    build-depends:+        base -any,+        dependency -any,+        hspec -any,+        containers -any+    +    if flag(development)+        ghc-options: -Werror+    +    if impl(ghc >=8.0)+        ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates+                     -Wcompat  benchmark dependency-bench-  type:                exitcode-stdio-1.0-  hs-source-dirs:      bench-  main-is:             Bench.hs-  build-depends:       base-                     , dependency-                     , containers-                     , criterion-  if flag(development)-    ghc-options:       -Werror-  if impl(ghc >= 8.0)-    ghc-options:       -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat-  ghc-options:         -Wall-  default-language:    Haskell2010--source-repository head-  type:     darcs-  location: https://hub.darcs.net/vmchale/ats+    type: exitcode-stdio-1.0+    main-is: Bench.hs+    hs-source-dirs: bench+    default-language: Haskell2010+    ghc-options: -Wall+    build-depends:+        base -any,+        dependency -any,+        containers -any,+        criterion -any+    +    if flag(development)+        ghc-options: -Werror+    +    if impl(ghc >=8.0)+        ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates+                     -Wcompat
src/Data/Dependency.hs view
@@ -2,8 +2,7 @@     ( -- * Functions       resolveDependencies     , buildSequence-    , satisfies-    , compatible+    , check     -- * Types     , Dependency (..)     , PackageSet (..)@@ -32,28 +31,47 @@     Just x  -> Right x     Nothing -> Left (NotPresent k) -checkWith :: Dependency -> [Dependency] -> S.Set Dependency -> DepM Dependency+-- | This function checks a package against currently in-scope packages,+-- downgrading versions as necessary until we reach something amenable or run out+-- of options.+checkWith :: Dependency -- ^ Dependency we want+          -> [Dependency] -- ^ Dependencies already in scope.+          -> S.Set Dependency -- ^ Set of available versions+          -> DepM Dependency checkWith x ds s     | check x ds = Right x-    | otherwise = lookupSet ds (S.deleteMax s)+    | otherwise = lookupSet (Just x) ds (S.deleteMax s) -lookupSet :: [Dependency] -- ^ Dependencies already added-          -> S.Set Dependency -- ^ Set of dependencies+lookupSet :: Maybe Dependency -- ^ Optional dependency we are looking for.+          -> [Dependency] -- ^ Dependencies already added+          -> S.Set Dependency -- ^ Set of available versions of given dependency           -> DepM Dependency-lookupSet ds s = case S.lookupMax s of-    Just x  -> checkWith x ds s-    Nothing -> g s+lookupSet x ds s = case S.lookupMax s of+    Just x' -> checkWith x' ds s+    Nothing -> g x -    where g s'-            | S.size s' > 0 = Left (Conflict (_libName <$> ds) (_libName . head . toList $ s'))-            | otherwise = Left InternalError+    where g Nothing   = Left InternalError+          g (Just x') = Left (Conflicts (_libName <$> ds') (_libName x'))+            where ds' = filter (\d -> not (check x' [d])) ds +-- This does check for compatibility with past packages, but doesn't do the+-- fancy tardis shenanigans it's supposed to when package resolution fails. latest :: PackageSet Dependency -> Dependency -> ResolveState (String, Dependency)-latest (PackageSet ps) (Dependency ln _ _) = do+latest (PackageSet ps) d@(Dependency ln _ _) = do     st <- getPast     s <- lift $ lookupMap ln ps-    (,) ln <$> lift (lookupSet (toList st) s)+    finish ln (lookupSet (Just d) (toList st) s) +finish :: String -> DepM Dependency -> ResolveState (String, Dependency)+finish ln dep' =+    case dep' of++        Right dep ->+            modifyForwards (M.insert ln dep) >>+            pure (ln, dep)++        Left err -> lift (Left err)+ buildSequence :: [Dependency] -> [[Dependency]] buildSequence = reverse . groupBy independent . sortDeps     where independent (Dependency ln ls _) (Dependency ln' ls' _) = ln' `notElem` (fst <$> ls) && ln `notElem` (fst <$> ls')@@ -71,7 +89,7 @@ saturateDeps' :: PackageSet Dependency -> Dependency -> DepM (S.Set Dependency) saturateDeps' (PackageSet ps) dep = do     deps <- sequence [ lookupMap lib ps | lib <- fst <$> _libDependencies dep ]-    list <- (:) dep <$> traverse (lookupSet mempty) deps+    list <- (:) dep <$> traverse (lookupSet Nothing mempty) deps     pure $ S.fromList list  run :: ResolveState a -> DepM a
src/Data/Dependency/Error.hs view
@@ -15,7 +15,7 @@ -- | An error that can occur during package resolution. data ResolveError = InternalError                   | NotPresent String-                  | Conflict [String] String+                  | Conflicts [String] String                   deriving (Show, Eq, NFData, Generic)                   -- CircularDependencies String String                   -- Conflict String String (Constraint Version) (Constraint Version)@@ -23,4 +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+    pretty (Conflicts ss s) = red "Error:" <+> "the package" <+> squotes (text s) <+> "conflicts with already in-scope packages: " <+> mconcat (punctuate ", " (fmap (squotes . text) ss))
src/Data/Dependency/Sort.hs view
@@ -13,6 +13,7 @@           s = view _2           keys = view _1 . s triple +-- | Topologically sort dependencies sortDeps :: [Dependency] -> [Dependency] sortDeps ds = fmap find . topSort $ g     where (g, find) = asGraph ds
src/Data/Dependency/Type.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveAnyClass             #-} {-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE DeriveFunctor              #-}@@ -21,8 +20,6 @@                             , ResolveStateM (..)                             , ResolveState                             -- * Helper functions-                            , satisfies-                            , compatible                             , check                             ) where @@ -36,9 +33,7 @@ import           Data.Functor.Foldable.TH import           Data.List                    (intercalate) import qualified Data.Map                     as M-#if __GLASGOW_HASKELL__ < 804 import           Data.Semigroup-#endif import qualified Data.Set                     as S import           GHC.Generics                 (Generic) import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))@@ -47,6 +42,8 @@ type ResMap = M.Map String Dependency type ResolveState = ResolveStateM (Either ResolveError) +-- | We use a tardis monad here to give ourselves greater flexibility during+-- dependency solving. newtype ResolveStateM m a = ResolveStateM { unResolve :: TardisT Mod ResMap m a }     deriving (Functor)     deriving newtype (Applicative, Monad, MonadFix, MonadTardis Mod ResMap)@@ -54,7 +51,8 @@ instance MonadTrans ResolveStateM where     lift = ResolveStateM . lift -newtype PackageSet a = PackageSet (M.Map String (S.Set a))+-- | A package set is simply a map between package names and a set of packages.+newtype PackageSet a = PackageSet { _packageSet :: M.Map String (S.Set a) }     deriving (Eq, Ord, Foldable, Generic)     deriving newtype Binary @@ -78,7 +76,7 @@         | x == y = Version xs <= Version ys         | otherwise = x <= y --- TODO comonad??+-- | Monoid/functor for representing constraints. data Constraint a = LessThanEq a                   | GreaterThanEq a                   | Eq a@@ -86,7 +84,6 @@                   | None                   deriving (Show, Eq, Ord, Functor, Generic, NFData) --- free moinoid but "pokey" because it has extra constructors instance Semigroup (Constraint a) where     (<>) None x = x     (<>) x None = x@@ -96,19 +93,29 @@     mempty = None     mappend = (<>) +-- | A generic dependency, consisting of a package name and version, as well as+-- dependency names and their constraints. data Dependency = Dependency { _libName         :: String                              , _libDependencies :: [(String, Constraint Version)]                              , _libVersion      :: Version                              }                              deriving (Show, Eq, Ord, Generic, NFData) +check' :: Dependency -> [Dependency] -> Bool+check' (Dependency _ lds _) ds =+    and [ compatible (Eq v') c | (Dependency ln _ v') <- ds, (str, c) <- lds, ln == str ]++-- | Check a given dependency is compatible with in-scope dependencies. 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)+check d = (&&) <$> check' d <*> check'' d +check'' :: Dependency -> [Dependency] -> Bool+check'' (Dependency ln _ v) ds = and [ g ds' | (Dependency _ ds' _) <- ds ]+    where g = all ((`satisfies` v) . snd) . filter ((== ln) . fst)+ satisfies :: (Ord a) => Constraint a -> a -> Bool-satisfies (LessThanEq x) y    = x <= y-satisfies (GreaterThanEq x) y = x >= y+satisfies (LessThanEq x) y    = x >= y+satisfies (GreaterThanEq x) y = x <= y satisfies (Eq x) y            = x == y satisfies (Bounded x y) z     = satisfies x z && satisfies y z satisfies None _              = True
test/Spec.hs view
@@ -21,6 +21,9 @@ defV :: Version defV = Version [0,1,0] +ghcMod :: Dependency+ghcMod = Dependency "ghc-mod" [("lens", LessThanEq defV)] defV+ deps :: [Dependency] deps = [free, lens, comonad] @@ -28,13 +31,15 @@ mapSingles = fmap (second S.singleton)  set :: PackageSet Dependency-set = PackageSet $ M.fromList (("lens", S.fromList [lens, newLens]) : mapSingles [("comonad", comonad), ("free", free)])+set = PackageSet $ M.fromList (("lens", S.fromList [lens, newLens]) : mapSingles [("ghc-mod", ghcMod), ("comonad", comonad), ("free", free)])  main :: IO () main = hspec $ parallel $ do     describe "buildSequence" $         it "correctly orders dependencies" $             buildSequence deps `shouldBe` [[free, comonad], [lens]]-    describe "resolveDependencies" $+    describe "resolveDependencies" $ do         it "correctly resolves dependencies in a package set" $-            resolveDependencies set [lens] `shouldBe` Right [[free, comonad], [newLens]]+            resolveDependencies set [newLens] `shouldBe` Right [[free, comonad], [newLens]]+        it "correctly resolves dependencies in a package set" $+            pendingWith "not working yet" -- resolveDependencies set [ghcMod] `shouldBe` Right [[free, comonad], [lens], [ghcMod]]