{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Types.GenericPackageDescription (
GenericPackageDescription(..),
emptyGenericPackageDescription,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Lens as L
import qualified Distribution.Types.BuildInfo.Lens as L
import Distribution.Types.PackageDescription
import Distribution.Types.Benchmark
import Distribution.Types.CondTree
import Distribution.Types.ConfVar
import Distribution.Types.Dependency
import Distribution.Types.Executable
import Distribution.Types.Flag
import Distribution.Types.ForeignLib
import Distribution.Types.Library
import Distribution.Types.TestSuite
import Distribution.Types.UnqualComponentName
import Distribution.Package
import Distribution.Version
data GenericPackageDescription =
GenericPackageDescription
{ GenericPackageDescription -> PackageDescription
packageDescription :: PackageDescription
, GenericPackageDescription -> Maybe Version
gpdScannedVersion :: Maybe Version
, GenericPackageDescription -> [PackageFlag]
genPackageFlags :: [PackageFlag]
, GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
, GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries :: [( UnqualComponentName
, CondTree ConfVar [Dependency] Library )]
, GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs :: [( UnqualComponentName
, CondTree ConfVar [Dependency] ForeignLib )]
, GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condExecutables :: [( UnqualComponentName
, CondTree ConfVar [Dependency] Executable )]
, GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites :: [( UnqualComponentName
, CondTree ConfVar [Dependency] TestSuite )]
, GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks :: [( UnqualComponentName
, CondTree ConfVar [Dependency] Benchmark )]
}
deriving (Int -> GenericPackageDescription -> ShowS
[GenericPackageDescription] -> ShowS
GenericPackageDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericPackageDescription] -> ShowS
$cshowList :: [GenericPackageDescription] -> ShowS
show :: GenericPackageDescription -> String
$cshow :: GenericPackageDescription -> String
showsPrec :: Int -> GenericPackageDescription -> ShowS
$cshowsPrec :: Int -> GenericPackageDescription -> ShowS
Show, GenericPackageDescription -> GenericPackageDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericPackageDescription -> GenericPackageDescription -> Bool
$c/= :: GenericPackageDescription -> GenericPackageDescription -> Bool
== :: GenericPackageDescription -> GenericPackageDescription -> Bool
$c== :: GenericPackageDescription -> GenericPackageDescription -> Bool
Eq, Typeable, Typeable GenericPackageDescription
GenericPackageDescription -> DataType
GenericPackageDescription -> Constr
(forall b. Data b => b -> b)
-> GenericPackageDescription -> GenericPackageDescription
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> GenericPackageDescription -> u
forall u.
(forall d. Data d => d -> u) -> GenericPackageDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericPackageDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericPackageDescription
-> c GenericPackageDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c GenericPackageDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericPackageDescription)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericPackageDescription -> m GenericPackageDescription
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> GenericPackageDescription -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> GenericPackageDescription -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> GenericPackageDescription -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> GenericPackageDescription -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> GenericPackageDescription
-> r
gmapT :: (forall b. Data b => b -> b)
-> GenericPackageDescription -> GenericPackageDescription
$cgmapT :: (forall b. Data b => b -> b)
-> GenericPackageDescription -> GenericPackageDescription
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericPackageDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericPackageDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c GenericPackageDescription)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c GenericPackageDescription)
dataTypeOf :: GenericPackageDescription -> DataType
$cdataTypeOf :: GenericPackageDescription -> DataType
toConstr :: GenericPackageDescription -> Constr
$ctoConstr :: GenericPackageDescription -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericPackageDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericPackageDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericPackageDescription
-> c GenericPackageDescription
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericPackageDescription
-> c GenericPackageDescription
Data, forall x.
Rep GenericPackageDescription x -> GenericPackageDescription
forall x.
GenericPackageDescription -> Rep GenericPackageDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GenericPackageDescription x -> GenericPackageDescription
$cfrom :: forall x.
GenericPackageDescription -> Rep GenericPackageDescription x
Generic)
instance Package GenericPackageDescription where
packageId :: GenericPackageDescription -> PackageIdentifier
packageId = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
instance Binary GenericPackageDescription
instance Structured GenericPackageDescription
instance NFData GenericPackageDescription where rnf :: GenericPackageDescription -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
emptyGenericPackageDescription :: GenericPackageDescription
emptyGenericPackageDescription :: GenericPackageDescription
emptyGenericPackageDescription = PackageDescription
-> Maybe Version
-> [PackageFlag]
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> GenericPackageDescription
GenericPackageDescription PackageDescription
emptyPackageDescription forall a. Maybe a
Nothing [] forall a. Maybe a
Nothing [] [] [] [] []
instance L.HasBuildInfos GenericPackageDescription where
traverseBuildInfos :: Traversal' GenericPackageDescription BuildInfo
traverseBuildInfos BuildInfo -> f BuildInfo
f (GenericPackageDescription PackageDescription
p Maybe Version
v [PackageFlag]
a1 Maybe (CondTree ConfVar [Dependency] Library)
x1 [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
x2 [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
x3 [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
x4 [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
x5 [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
x6) =
PackageDescription
-> Maybe Version
-> [PackageFlag]
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> GenericPackageDescription
GenericPackageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos BuildInfo -> f BuildInfo
f PackageDescription
p
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [PackageFlag]
a1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f Maybe (CondTree ConfVar [Dependency] Library)
x1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
L._2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
x2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
L._2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
x3
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
L._2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
x4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
L._2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
x5
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a b. Lens (c, a) (c, b) a b
L._2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo) BuildInfo -> f BuildInfo
f [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
x6
where
traverseCondTreeBuildInfo
:: forall f comp v. (Applicative f, L.HasBuildInfo comp)
=> LensLike' f (CondTree v [Dependency] comp) L.BuildInfo
traverseCondTreeBuildInfo :: forall (f :: * -> *) comp v.
(Applicative f, HasBuildInfo comp) =>
LensLike' f (CondTree v [Dependency] comp) BuildInfo
traverseCondTreeBuildInfo BuildInfo -> f BuildInfo
g = forall {c}. CondTree v c comp -> f (CondTree v [Dependency] comp)
node where
mkCondNode :: comp -> [CondBranch v [Dependency] comp] -> CondTree v [Dependency] comp
mkCondNode :: comp
-> [CondBranch v [Dependency] comp] -> CondTree v [Dependency] comp
mkCondNode comp
comp [CondBranch v [Dependency] comp]
branches = forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode comp
comp (forall a s. Getting a s a -> s -> a
view forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends comp
comp) [CondBranch v [Dependency] comp]
branches
node :: CondTree v c comp -> f (CondTree v [Dependency] comp)
node (CondNode comp
comp c
_ [CondBranch v c comp]
branches) = comp
-> [CondBranch v [Dependency] comp] -> CondTree v [Dependency] comp
mkCondNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
g comp
comp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CondBranch v c comp -> f (CondBranch v [Dependency] comp)
branch [CondBranch v c comp]
branches
branch :: CondBranch v c comp -> f (CondBranch v [Dependency] comp)
branch (CondBranch Condition v
v CondTree v c comp
x Maybe (CondTree v c comp)
y) = forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition v
v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CondTree v c comp -> f (CondTree v [Dependency] comp)
node CondTree v c comp
x
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CondTree v c comp -> f (CondTree v [Dependency] comp)
node Maybe (CondTree v c comp)
y