dependency 0.1.0.11 → 1.0.0.0
raw patch · 4 files changed
+52/−77 lines, 4 filesdep +semigroupsdep −tardisdep ~basedep ~containers
Dependencies added: semigroups
Dependencies removed: tardis
Dependency ranges changed: base, containers
Files
- dependency.cabal +15/−6
- src/Data/Dependency.hs +17/−23
- src/Data/Dependency/Type.hs +16/−46
- test/Spec.hs +4/−2
dependency.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: dependency-version: 0.1.0.11+version: 1.0.0.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale@@ -26,25 +26,32 @@ library exposed-modules: Data.Dependency+ build-tools: cpphs -any hs-source-dirs: src other-modules: Data.Dependency.Type Data.Dependency.Error Data.Dependency.Sort default-language: Haskell2010+ other-extensions: DeriveAnyClass DeriveGeneric OverloadedStrings+ DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable+ OverloadedStrings TemplateHaskell TypeFamilies ghc-options: -Wall build-depends:- base >=4.11 && <5,+ base >=4.8 && <5, ansi-wl-pprint -any,- containers -any,+ containers >=0.5.9, recursion-schemes -any, lens -any, transformers -any, binary -any,- deepseq -any,- tardis -any+ deepseq -any - if flag(development)+ if impl(ghc <8.0)+ build-depends:+ semigroups -any+ + if (flag(development) && impl(ghc <8.4)) ghc-options: -Werror if impl(ghc >=8.0)@@ -56,6 +63,7 @@ main-is: Spec.hs hs-source-dirs: test default-language: Haskell2010+ other-extensions: TupleSections ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: base -any,@@ -75,6 +83,7 @@ main-is: Bench.hs hs-source-dirs: bench default-language: Haskell2010+ other-extensions: TupleSections ghc-options: -Wall build-depends: base -any,
src/Data/Dependency.hs view
@@ -10,21 +10,17 @@ , DepM , ResolveError (..) , Constraint (..)- , ResolveStateM (..)- , ResolveState- , ResMap ) where +import Control.Arrow 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@@ -56,22 +52,22 @@ -- 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) d@(Dependency ln _ _) = do- st <- getPast- s <- lift $ lookupMap ln ps- finish ln (lookupSet (Just d) (toList st) s)+latest :: PackageSet Dependency -> [Dependency] -> Dependency -> DepM (String, Dependency)+latest (PackageSet ps) ds d@(Dependency ln _ _) = do+ s <- lookupMap ln ps+ finish ln (lookupSet (Just d) ds s) -finish :: String -> DepM Dependency -> ResolveState (String, Dependency)+finish :: String -> DepM Dependency -> DepM (String, Dependency) finish ln dep' = case dep' of Right dep ->- modifyForwards (M.insert ln dep) >> pure (ln, dep) - Left err -> lift (Left err)+ Left err ->+ Left err +-- | This splits dependencies into phases buildSequence :: [Dependency] -> [[Dependency]] buildSequence = reverse . groupBy independent . sortDeps where independent (Dependency ln ls _) (Dependency ln' ls' _) =@@ -89,11 +85,9 @@ saturateDeps' :: PackageSet Dependency -> Dependency -> DepM (S.Set Dependency) saturateDeps' (PackageSet ps) dep = S.fromList <$> list- where list = (:) dep <$> (traverse (lookupSet Nothing mempty) =<< deps)+ where list = (:) dep <$> (traverse (lookupSet Nothing (crunch ps)) =<< deps) deps = sequence [ lookupMap lib ps | lib <- fst <$> _libDependencies dep ]--run :: ResolveState a -> DepM a-run = flip evalTardisT (id, mempty) . unResolve+ crunch = mconcat . fmap toList . toList -- | Dependency resolution is guided by the following: --@@ -111,7 +105,7 @@ -- -- This doesn't do any package resolution beyond versioning. resolveDependencies :: PackageSet Dependency -> [Dependency] -> DepM [[Dependency]]-resolveDependencies ps = select . getLatest <=< fmap (buildSequence . toList) . saturate+resolveDependencies ps = select . getLatest <=< fmap ((buildSequence &&& id) . toList) . saturate where select = fmap (fmap (fmap snd)) saturate = fmap S.unions . traverse (saturateDeps ps)- getLatest = run . traverse (traverse (latest ps))+ getLatest (p, q) = traverse (traverse (latest ps q)) p
src/Data/Dependency/Type.hs view
@@ -1,77 +1,47 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} module Data.Dependency.Type ( Dependency (..) , Version (..) , Constraint (..) , PackageSet (..)- , ResMap- , ResolveStateM (..)- , ResolveState -- * Helper functions , 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) import qualified Data.Map as M+import Data.Semigroup import qualified Data.Set as S 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)---- | 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)--instance MonadTrans ResolveStateM where- lift = ResolveStateM . lift- -- | 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+ deriving (Eq, Ord, Foldable, Generic, Binary) newtype Version = Version [Integer]- deriving (Eq, Generic)- deriving newtype (NFData, Binary)--{-# COMPLETE V #-}--pattern V :: [Integer] -> Version-pattern V is = Version is+ deriving (Eq, Generic, NFData, Binary) instance Show Version where show (Version is) = intercalate "." (show <$> is) instance Ord Version where- (V []) <= (V []) = True- (V []) <= _ = True- _ <= (V []) = False- (V (x:xs)) <= (V (y:ys))+ (Version []) <= (Version []) = True+ (Version []) <= _ = True+ _ <= (Version []) = False+ (Version (x:xs)) <= (Version (y:ys)) | x == y = Version xs <= Version ys | otherwise = x <= y
test/Spec.hs view
@@ -31,7 +31,9 @@ mapSingles = fmap (second S.singleton) set :: PackageSet Dependency-set = PackageSet $ M.fromList (("lens", S.fromList [lens, newLens]) : mapSingles [("ghc-mod", ghcMod), ("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@@ -42,4 +44,4 @@ it "correctly resolves dependencies in a package set" $ 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]]+ resolveDependencies set [ghcMod] `shouldBe` Right [[free, comonad], [lens], [ghcMod]]