{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}

-- | Fine-grained package dependencies
--
-- Like many others, this module is meant to be "double-imported":
--
-- > import Distribution.Solver.Types.ComponentDeps (
-- >     Component
-- >   , ComponentDep
-- >   , ComponentDeps
-- >   )
-- > import qualified Distribution.Solver.Types.ComponentDeps as CD
module Distribution.Solver.Types.ComponentDeps (
    -- * Fine-grained package dependencies
    Component(..)
  , componentNameToComponent
  , ComponentDep
  , ComponentDeps -- opaque
    -- ** Constructing ComponentDeps
  , empty
  , fromList
  , singleton
  , insert
  , zip
  , filterDeps
  , fromLibraryDeps
  , fromSetupDeps
  , fromInstalled
    -- ** Deconstructing ComponentDeps
  , toList
  , flatDeps
  , nonSetupDeps
  , libraryDeps
  , setupDeps
  , select
  , components
  ) where

import Prelude ()
import Distribution.Types.UnqualComponentName
import Distribution.Solver.Compat.Prelude hiding (empty,toList,zip)

import qualified Data.Map as Map
import Data.Foldable (fold)

import Distribution.Pretty (Pretty (..))
import qualified Distribution.Types.ComponentName as CN
import qualified Distribution.Types.LibraryName as LN
import qualified Text.PrettyPrint as PP


{-------------------------------------------------------------------------------
  Types
-------------------------------------------------------------------------------}

-- | Component of a package.
data Component =
    ComponentLib
  | ComponentSubLib UnqualComponentName
  | ComponentFLib   UnqualComponentName
  | ComponentExe    UnqualComponentName
  | ComponentTest   UnqualComponentName
  | ComponentBench  UnqualComponentName
  | ComponentSetup
  deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show, Component -> Component -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Eq Component
Component -> Component -> Bool
Component -> Component -> Ordering
Component -> Component -> Component
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Component -> Component -> Component
$cmin :: Component -> Component -> Component
max :: Component -> Component -> Component
$cmax :: Component -> Component -> Component
>= :: Component -> Component -> Bool
$c>= :: Component -> Component -> Bool
> :: Component -> Component -> Bool
$c> :: Component -> Component -> Bool
<= :: Component -> Component -> Bool
$c<= :: Component -> Component -> Bool
< :: Component -> Component -> Bool
$c< :: Component -> Component -> Bool
compare :: Component -> Component -> Ordering
$ccompare :: Component -> Component -> Ordering
Ord, forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Component x -> Component
$cfrom :: forall x. Component -> Rep Component x
Generic)

instance Binary Component
instance Structured Component

instance Pretty Component where
    pretty :: Component -> Doc
pretty Component
ComponentLib        = String -> Doc
PP.text String
"lib"
    pretty (ComponentSubLib UnqualComponentName
n) = String -> Doc
PP.text String
"lib:" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
    pretty (ComponentFLib UnqualComponentName
n)   = String -> Doc
PP.text String
"flib:" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
    pretty (ComponentExe UnqualComponentName
n)    = String -> Doc
PP.text String
"exe:" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
    pretty (ComponentTest UnqualComponentName
n)   = String -> Doc
PP.text String
"test:" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
    pretty (ComponentBench UnqualComponentName
n)  = String -> Doc
PP.text String
"bench:" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
    pretty Component
ComponentSetup      = String -> Doc
PP.text String
"setup"

-- | Dependency for a single component.
type ComponentDep a = (Component, a)

-- | Fine-grained dependencies for a package.
--
-- Typically used as @ComponentDeps [Dependency]@, to represent the list of
-- dependencies for each named component within a package.
--
newtype ComponentDeps a = ComponentDeps { forall a. ComponentDeps a -> Map Component a
unComponentDeps :: Map Component a }
  deriving (Int -> ComponentDeps a -> ShowS
forall a. Show a => Int -> ComponentDeps a -> ShowS
forall a. Show a => [ComponentDeps a] -> ShowS
forall a. Show a => ComponentDeps a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentDeps a] -> ShowS
$cshowList :: forall a. Show a => [ComponentDeps a] -> ShowS
show :: ComponentDeps a -> String
$cshow :: forall a. Show a => ComponentDeps a -> String
showsPrec :: Int -> ComponentDeps a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ComponentDeps a -> ShowS
Show, forall a b. a -> ComponentDeps b -> ComponentDeps a
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ComponentDeps b -> ComponentDeps a
$c<$ :: forall a b. a -> ComponentDeps b -> ComponentDeps a
fmap :: forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
$cfmap :: forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
Functor, ComponentDeps a -> ComponentDeps a -> Bool
forall a. Eq a => ComponentDeps a -> ComponentDeps a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentDeps a -> ComponentDeps a -> Bool
$c/= :: forall a. Eq a => ComponentDeps a -> ComponentDeps a -> Bool
== :: ComponentDeps a -> ComponentDeps a -> Bool
$c== :: forall a. Eq a => ComponentDeps a -> ComponentDeps a -> Bool
Eq, ComponentDeps a -> ComponentDeps a -> Bool
ComponentDeps a -> ComponentDeps a -> Ordering
ComponentDeps a -> ComponentDeps a -> ComponentDeps a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ComponentDeps a)
forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Bool
forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Ordering
forall a.
Ord a =>
ComponentDeps a -> ComponentDeps a -> ComponentDeps a
min :: ComponentDeps a -> ComponentDeps a -> ComponentDeps a
$cmin :: forall a.
Ord a =>
ComponentDeps a -> ComponentDeps a -> ComponentDeps a
max :: ComponentDeps a -> ComponentDeps a -> ComponentDeps a
$cmax :: forall a.
Ord a =>
ComponentDeps a -> ComponentDeps a -> ComponentDeps a
>= :: ComponentDeps a -> ComponentDeps a -> Bool
$c>= :: forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Bool
> :: ComponentDeps a -> ComponentDeps a -> Bool
$c> :: forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Bool
<= :: ComponentDeps a -> ComponentDeps a -> Bool
$c<= :: forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Bool
< :: ComponentDeps a -> ComponentDeps a -> Bool
$c< :: forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Bool
compare :: ComponentDeps a -> ComponentDeps a -> Ordering
$ccompare :: forall a. Ord a => ComponentDeps a -> ComponentDeps a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ComponentDeps a) x -> ComponentDeps a
forall a x. ComponentDeps a -> Rep (ComponentDeps a) x
$cto :: forall a x. Rep (ComponentDeps a) x -> ComponentDeps a
$cfrom :: forall a x. ComponentDeps a -> Rep (ComponentDeps a) x
Generic)

instance Semigroup a => Monoid (ComponentDeps a) where
  mempty :: ComponentDeps a
mempty = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall k a. Map k a
Map.empty
  mappend :: ComponentDeps a -> ComponentDeps a -> ComponentDeps a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup a => Semigroup (ComponentDeps a) where
  ComponentDeps Map Component a
d <> :: ComponentDeps a -> ComponentDeps a -> ComponentDeps a
<> ComponentDeps Map Component a
d' =
      forall a. Map Component a -> ComponentDeps a
ComponentDeps (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map Component a
d Map Component a
d')

instance Foldable ComponentDeps where
  foldMap :: forall m a. Monoid m => (a -> m) -> ComponentDeps a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
unComponentDeps

instance Traversable ComponentDeps where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ComponentDeps a -> f (ComponentDeps b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Map Component a -> ComponentDeps a
ComponentDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
unComponentDeps

instance Binary a => Binary (ComponentDeps a)
instance Structured a => Structured (ComponentDeps a)

componentNameToComponent :: CN.ComponentName -> Component
componentNameToComponent :: ComponentName -> Component
componentNameToComponent (CN.CLibName  LibraryName
LN.LMainLibName)   = Component
ComponentLib
componentNameToComponent (CN.CLibName (LN.LSubLibName UnqualComponentName
s)) = UnqualComponentName -> Component
ComponentSubLib UnqualComponentName
s
componentNameToComponent (CN.CFLibName                UnqualComponentName
s)  = UnqualComponentName -> Component
ComponentFLib   UnqualComponentName
s
componentNameToComponent (CN.CExeName                 UnqualComponentName
s)  = UnqualComponentName -> Component
ComponentExe    UnqualComponentName
s
componentNameToComponent (CN.CTestName                UnqualComponentName
s)  = UnqualComponentName -> Component
ComponentTest   UnqualComponentName
s
componentNameToComponent (CN.CBenchName               UnqualComponentName
s)  = UnqualComponentName -> Component
ComponentBench  UnqualComponentName
s

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

empty :: ComponentDeps a
empty :: forall a. ComponentDeps a
empty = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall a b. (a -> b) -> a -> b
$ forall k a. Map k a
Map.empty

fromList :: Monoid a => [ComponentDep a] -> ComponentDeps a
fromList :: forall a. Monoid a => [ComponentDep a] -> ComponentDeps a
fromList = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Monoid a => a -> a -> a
mappend

singleton :: Component -> a -> ComponentDeps a
singleton :: forall a. Component -> a -> ComponentDeps a
singleton Component
comp = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
Map.singleton Component
comp

insert :: Monoid a => Component -> a -> ComponentDeps a -> ComponentDeps a
insert :: forall a.
Monoid a =>
Component -> a -> ComponentDeps a -> ComponentDeps a
insert Component
comp a
a = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe a -> Maybe a
aux Component
comp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
unComponentDeps
  where
    aux :: Maybe a -> Maybe a
aux Maybe a
Nothing   = forall a. a -> Maybe a
Just a
a
    aux (Just a
a') = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
a forall a. Monoid a => a -> a -> a
`mappend` a
a'

-- | Zip two 'ComponentDeps' together by 'Component', using 'mempty'
-- as the neutral element when a 'Component' is present only in one.
zip
  :: (Monoid a, Monoid b)
  => ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b)
zip :: forall a b.
(Monoid a, Monoid b) =>
ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b)
zip (ComponentDeps Map Component a
d1) (ComponentDeps Map Component b
d2) =
    forall a. Map Component a -> ComponentDeps a
ComponentDeps forall a b. (a -> b) -> a -> b
$
      forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
        (\Component
_ a
a b
b -> forall a. a -> Maybe a
Just (a
a,b
b))
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, forall a. Monoid a => a
mempty)))
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
b -> (forall a. Monoid a => a
mempty, b
b)))
        Map Component a
d1 Map Component b
d2

-- | Keep only selected components (and their associated deps info).
filterDeps :: (Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
filterDeps :: forall a.
(Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a
filterDeps Component -> a -> Bool
p = forall a. Map Component a -> ComponentDeps a
ComponentDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Component -> a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
unComponentDeps

-- | ComponentDeps containing library dependencies only
fromLibraryDeps :: a -> ComponentDeps a
fromLibraryDeps :: forall a. a -> ComponentDeps a
fromLibraryDeps = forall a. Component -> a -> ComponentDeps a
singleton Component
ComponentLib

-- | ComponentDeps containing setup dependencies only.
fromSetupDeps :: a -> ComponentDeps a
fromSetupDeps :: forall a. a -> ComponentDeps a
fromSetupDeps = forall a. Component -> a -> ComponentDeps a
singleton Component
ComponentSetup

-- | ComponentDeps for installed packages.
--
-- We assume that installed packages only record their library dependencies.
fromInstalled :: a -> ComponentDeps a
fromInstalled :: forall a. a -> ComponentDeps a
fromInstalled = forall a. a -> ComponentDeps a
fromLibraryDeps

{-------------------------------------------------------------------------------
  Deconstruction
-------------------------------------------------------------------------------}

toList :: ComponentDeps a -> [ComponentDep a]
toList :: forall a. ComponentDeps a -> [ComponentDep a]
toList = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
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 :: forall m. Monoid m => ComponentDeps m -> m
flatDeps = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | All dependencies except the setup dependencies.
--
-- Prior to the introduction of setup dependencies in version 1.24 this
-- would have been _all_ dependencies.
nonSetupDeps :: Monoid a => ComponentDeps a -> a
nonSetupDeps :: forall m. Monoid m => ComponentDeps m -> m
nonSetupDeps = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
select (forall a. Eq a => a -> a -> Bool
/= Component
ComponentSetup)

-- | Library dependencies proper only.  (Includes dependencies
-- of internal libraries.)
libraryDeps :: Monoid a => ComponentDeps a -> a
libraryDeps :: forall m. Monoid m => ComponentDeps m -> m
libraryDeps = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
select (\Component
c -> case Component
c of ComponentSubLib UnqualComponentName
_ -> Bool
True
                                      Component
ComponentLib -> Bool
True
                                      Component
_ -> Bool
False)

-- | List components
components :: ComponentDeps a -> Set Component
components :: forall a. ComponentDeps a -> Set Component
components = forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> Map Component a
unComponentDeps

-- | Setup dependencies.
setupDeps :: Monoid a => ComponentDeps a -> a
setupDeps :: forall m. Monoid m => ComponentDeps m -> m
setupDeps = forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
select (forall a. Eq a => a -> a -> Bool
== Component
ComponentSetup)

-- | Select dependencies satisfying a given predicate.
select :: Monoid a => (Component -> Bool) -> ComponentDeps a -> a
select :: forall a. Monoid a => (Component -> Bool) -> ComponentDeps a -> a
select Component -> Bool
p = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Component -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ComponentDeps a -> [ComponentDep a]
toList