From 601966737ae0b41c5c1b3d532ae49c7a8be8faa8 Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Tue, 24 Mar 2015 10:36:53 +0000
Subject: [PATCH] Introduce ComponentDeps
The ComponentDeps datatype will give us fine-grained information about the
dependencies of a package's components. This commit just introduces the
datatype, we don't use it anywhere yet.
---
.../Distribution/Client/ComponentDeps.hs | 113 ++++++++++++++++++
cabal-install/cabal-install.cabal | 1 +
2 files changed, 114 insertions(+)
create mode 100644 cabal-install/Distribution/Client/ComponentDeps.hs
diff --git a/cabal-install/Distribution/Client/ComponentDeps.hs b/cabal-install/Distribution/Client/ComponentDeps.hs
new file mode 100644
index 0000000000..f6ee4d9a77
--- /dev/null
+++ b/cabal-install/Distribution/Client/ComponentDeps.hs
@@ -0,0 +1,113 @@
+-- | Fine-grained package dependencies
+--
+-- Like many others, this module is meant to be "double-imported":
+--
+-- > import Distribution.Client.ComponentDeps (
+-- > Component
+-- > , ComponentDep
+-- > , ComponentDeps
+-- > )
+-- > import qualified Distribution.Client.ComponentDeps as CD
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+module Distribution.Client.ComponentDeps (
+ -- * Fine-grained package dependencies
+ Component(..)
+ , ComponentDep
+ , ComponentDeps -- opaque
+ -- ** Constructing ComponentDeps
+ , empty
+ , fromList
+ , singleton
+ , insert
+ , fromLibraryDeps
+ , fromInstalled
+ -- ** Deconstructing ComponentDeps
+ , toList
+ , flatDeps
+ ) where
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Foldable (fold)
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Foldable (Foldable(foldMap))
+import Data.Monoid (Monoid(..))
+import Data.Traversable (Traversable(traverse))
+#endif
+
+{-------------------------------------------------------------------------------
+ Types
+-------------------------------------------------------------------------------}
+
+-- | Component of a package
+data Component =
+ ComponentLib
+ | ComponentExe String
+ | ComponentTest String
+ | ComponentBench String
+ deriving (Show, Eq, Ord)
+
+-- | Dependency for a single component
+type ComponentDep a = (Component, a)
+
+-- | Fine-grained dependencies for a package
+newtype ComponentDeps a = ComponentDeps { unComponentDeps :: Map Component a }
+ deriving (Show, Functor, Eq, Ord)
+
+instance Monoid a => Monoid (ComponentDeps a) where
+ mempty =
+ ComponentDeps Map.empty
+ (ComponentDeps d) `mappend` (ComponentDeps d') =
+ ComponentDeps (Map.unionWith mappend d d')
+
+instance Foldable ComponentDeps where
+ foldMap f = foldMap f . unComponentDeps
+
+instance Traversable ComponentDeps where
+ traverse f = fmap ComponentDeps . traverse f . unComponentDeps
+
+{-------------------------------------------------------------------------------
+ Construction
+-------------------------------------------------------------------------------}
+
+empty :: ComponentDeps a
+empty = ComponentDeps $ Map.empty
+
+fromList :: Monoid a => [ComponentDep a] -> ComponentDeps a
+fromList = ComponentDeps . Map.fromListWith mappend
+
+singleton :: Component -> a -> ComponentDeps a
+singleton comp = ComponentDeps . Map.singleton comp
+
+insert :: Monoid a => Component -> a -> ComponentDeps a -> ComponentDeps a
+insert comp a = ComponentDeps . Map.alter aux comp . unComponentDeps
+ where
+ aux Nothing = Just a
+ aux (Just a') = Just $ a `mappend` a'
+
+-- | ComponentDeps containing library dependencies only
+fromLibraryDeps :: a -> ComponentDeps a
+fromLibraryDeps = singleton ComponentLib
+
+-- | ComponentDeps for installed packages
+--
+-- We assume that installed packages only record their library dependencies
+fromInstalled :: a -> ComponentDeps a
+fromInstalled = fromLibraryDeps
+
+{-------------------------------------------------------------------------------
+ Deconstruction
+-------------------------------------------------------------------------------}
+
+toList :: ComponentDeps a -> [ComponentDep a]
+toList = Map.toList . unComponentDeps
+
+-- | All dependencies of a package
+--
+-- This is just a synonym for 'fold', but perhaps a use of 'flatDeps' is more
+-- obvious than a use of 'fold', and moreover this avoids introducing lots of
+-- @#ifdef@s for 7.10 just for the use of 'fold'.
+flatDeps :: Monoid a => ComponentDeps a -> a
+flatDeps = fold
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 954644b8a0..8e54000c37 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -51,6 +51,7 @@ executable cabal
Distribution.Client.BuildReports.Types
Distribution.Client.BuildReports.Upload
Distribution.Client.Check
+ Distribution.Client.ComponentDeps
Distribution.Client.Config
Distribution.Client.Configure
Distribution.Client.Dependency
--
GitLab