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 +83/−69
- src/Data/Dependency.hs +33/−15
- src/Data/Dependency/Error.hs +2/−2
- src/Data/Dependency/Sort.hs +1/−0
- src/Data/Dependency/Type.hs +19/−12
- test/Spec.hs +8/−3
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]]