{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.Component (
    Component(..),
    foldComponent,
    componentBuildInfo,
    componentBuildable,
    componentName,
    partitionComponents,
) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.Library
import Distribution.Types.ForeignLib
import Distribution.Types.Executable
import Distribution.Types.TestSuite
import Distribution.Types.Benchmark

import Distribution.Types.ComponentName
import Distribution.Types.BuildInfo

import qualified Distribution.Types.BuildInfo.Lens as L

data Component = CLib   Library
               | CFLib  ForeignLib
               | CExe   Executable
               | CTest  TestSuite
               | CBench Benchmark
               deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
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
External instance of the constraint type Show Benchmark
External instance of the constraint type Show TestSuite
External instance of the constraint type Show Executable
External instance of the constraint type Show ForeignLib
External instance of the constraint type Show Library
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show, Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
External instance of the constraint type Eq Benchmark
External instance of the constraint type Eq TestSuite
External instance of the constraint type Eq Executable
External instance of the constraint type Eq ForeignLib
External instance of the constraint type Eq Library
Eq, ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [Component]
(Int -> ReadS Component)
-> ReadS [Component]
-> ReadPrec Component
-> ReadPrec [Component]
-> Read Component
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Component]
$creadListPrec :: ReadPrec [Component]
readPrec :: ReadPrec Component
$creadPrec :: ReadPrec Component
readList :: ReadS [Component]
$creadList :: ReadS [Component]
readsPrec :: Int -> ReadS Component
$creadsPrec :: Int -> ReadS Component
External instance of the constraint type Read Benchmark
External instance of the constraint type Read TestSuite
External instance of the constraint type Read Executable
External instance of the constraint type Read ForeignLib
External instance of the constraint type Read Library
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read Component
Read)

instance Semigroup Component where
    CLib   Library
l <> :: Component -> Component -> Component
<> CLib   Library
l' = Library -> Component
CLib   (Library
l Library -> Library -> Library
forall a. Semigroup a => a -> a -> a
External instance of the constraint type Semigroup Library
<> Library
l')
    CFLib  ForeignLib
l <> CFLib  ForeignLib
l' = ForeignLib -> Component
CFLib  (ForeignLib
l ForeignLib -> ForeignLib -> ForeignLib
forall a. Semigroup a => a -> a -> a
External instance of the constraint type Semigroup ForeignLib
<> ForeignLib
l')
    CExe   Executable
e <> CExe   Executable
e' = Executable -> Component
CExe   (Executable
e Executable -> Executable -> Executable
forall a. Semigroup a => a -> a -> a
External instance of the constraint type Semigroup Executable
<> Executable
e')
    CTest  TestSuite
t <> CTest  TestSuite
t' = TestSuite -> Component
CTest  (TestSuite
t TestSuite -> TestSuite -> TestSuite
forall a. Semigroup a => a -> a -> a
External instance of the constraint type Semigroup TestSuite
<> TestSuite
t')
    CBench Benchmark
b <> CBench Benchmark
b' = Benchmark -> Component
CBench (Benchmark
b Benchmark -> Benchmark -> Benchmark
forall a. Semigroup a => a -> a -> a
External instance of the constraint type Semigroup Benchmark
<> Benchmark
b')
    Component
_        <> Component
_         = String -> Component
forall a. HasCallStack => String -> a
error String
"Cannot merge Component"

instance L.HasBuildInfo Component where
    buildInfo :: LensLike f Component Component BuildInfo BuildInfo
buildInfo BuildInfo -> f BuildInfo
f (CLib Library
l)   = Library -> Component
CLib (Library -> Component) -> f Library -> f Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> LensLike f Library Library BuildInfo BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Evidence bound by a type signature of the constraint type Functor f
External instance of the constraint type HasBuildInfo Library
L.buildInfo BuildInfo -> f BuildInfo
f Library
l
    buildInfo BuildInfo -> f BuildInfo
f (CFLib ForeignLib
l)  = ForeignLib -> Component
CFLib (ForeignLib -> Component) -> f ForeignLib -> f Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> LensLike f ForeignLib ForeignLib BuildInfo BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Evidence bound by a type signature of the constraint type Functor f
External instance of the constraint type HasBuildInfo ForeignLib
L.buildInfo BuildInfo -> f BuildInfo
f ForeignLib
l
    buildInfo BuildInfo -> f BuildInfo
f (CExe Executable
e)   = Executable -> Component
CExe (Executable -> Component) -> f Executable -> f Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> LensLike f Executable Executable BuildInfo BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Evidence bound by a type signature of the constraint type Functor f
External instance of the constraint type HasBuildInfo Executable
L.buildInfo BuildInfo -> f BuildInfo
f Executable
e
    buildInfo BuildInfo -> f BuildInfo
f (CTest TestSuite
t)  = TestSuite -> Component
CTest (TestSuite -> Component) -> f TestSuite -> f Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> LensLike f TestSuite TestSuite BuildInfo BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Evidence bound by a type signature of the constraint type Functor f
External instance of the constraint type HasBuildInfo TestSuite
L.buildInfo BuildInfo -> f BuildInfo
f TestSuite
t
    buildInfo BuildInfo -> f BuildInfo
f (CBench Benchmark
b) = Benchmark -> Component
CBench (Benchmark -> Component) -> f Benchmark -> f Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> LensLike f Benchmark Benchmark BuildInfo BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Evidence bound by a type signature of the constraint type Functor f
External instance of the constraint type HasBuildInfo Benchmark
L.buildInfo BuildInfo -> f BuildInfo
f Benchmark
b

foldComponent :: (Library -> a)
              -> (ForeignLib -> a)
              -> (Executable -> a)
              -> (TestSuite -> a)
              -> (Benchmark -> a)
              -> Component
              -> a
foldComponent :: (Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent Library -> a
f ForeignLib -> a
_ Executable -> a
_ TestSuite -> a
_ Benchmark -> a
_ (CLib   Library
lib) = Library -> a
f Library
lib
foldComponent Library -> a
_ ForeignLib -> a
f Executable -> a
_ TestSuite -> a
_ Benchmark -> a
_ (CFLib  ForeignLib
flib)= ForeignLib -> a
f ForeignLib
flib
foldComponent Library -> a
_ ForeignLib -> a
_ Executable -> a
f TestSuite -> a
_ Benchmark -> a
_ (CExe   Executable
exe) = Executable -> a
f Executable
exe
foldComponent Library -> a
_ ForeignLib -> a
_ Executable -> a
_ TestSuite -> a
f Benchmark -> a
_ (CTest  TestSuite
tst) = TestSuite -> a
f TestSuite
tst
foldComponent Library -> a
_ ForeignLib -> a
_ Executable -> a
_ TestSuite -> a
_ Benchmark -> a
f (CBench Benchmark
bch) = Benchmark -> a
f Benchmark
bch

componentBuildInfo :: Component -> BuildInfo
componentBuildInfo :: Component -> BuildInfo
componentBuildInfo =
  (Library -> BuildInfo)
-> (ForeignLib -> BuildInfo)
-> (Executable -> BuildInfo)
-> (TestSuite -> BuildInfo)
-> (Benchmark -> BuildInfo)
-> Component
-> BuildInfo
forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent Library -> BuildInfo
libBuildInfo ForeignLib -> BuildInfo
foreignLibBuildInfo Executable -> BuildInfo
buildInfo TestSuite -> BuildInfo
testBuildInfo Benchmark -> BuildInfo
benchmarkBuildInfo

-- | Is a component buildable (i.e., not marked with @buildable: False@)?
-- See also this note in
-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components".
--
-- @since 2.0.0.2
--
componentBuildable :: Component -> Bool
componentBuildable :: Component -> Bool
componentBuildable = BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (Component -> BuildInfo) -> Component -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> BuildInfo
componentBuildInfo

componentName :: Component -> ComponentName
componentName :: Component -> ComponentName
componentName =
  (Library -> ComponentName)
-> (ForeignLib -> ComponentName)
-> (Executable -> ComponentName)
-> (TestSuite -> ComponentName)
-> (Benchmark -> ComponentName)
-> Component
-> ComponentName
forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent (LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName)
-> (Library -> LibraryName) -> Library -> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
                (UnqualComponentName -> ComponentName
CFLibName  (UnqualComponentName -> ComponentName)
-> (ForeignLib -> UnqualComponentName)
-> ForeignLib
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
                (UnqualComponentName -> ComponentName
CExeName   (UnqualComponentName -> ComponentName)
-> (Executable -> UnqualComponentName)
-> Executable
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName)
                (UnqualComponentName -> ComponentName
CTestName  (UnqualComponentName -> ComponentName)
-> (TestSuite -> UnqualComponentName) -> TestSuite -> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> UnqualComponentName
testName)
                (UnqualComponentName -> ComponentName
CBenchName (UnqualComponentName -> ComponentName)
-> (Benchmark -> UnqualComponentName) -> Benchmark -> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> UnqualComponentName
benchmarkName)

partitionComponents
    :: [Component]
    -> ([Library], [ForeignLib], [Executable], [TestSuite], [Benchmark])
partitionComponents :: [Component]
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
partitionComponents = (Component
 -> ([Library], [ForeignLib], [Executable], [TestSuite],
     [Benchmark])
 -> ([Library], [ForeignLib], [Executable], [TestSuite],
     [Benchmark]))
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> [Component]
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr ((Library
 -> ([Library], [ForeignLib], [Executable], [TestSuite],
     [Benchmark])
 -> ([Library], [ForeignLib], [Executable], [TestSuite],
     [Benchmark]))
-> (ForeignLib
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark])
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark]))
-> (Executable
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark])
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark]))
-> (TestSuite
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark])
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark]))
-> (Benchmark
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark])
    -> ([Library], [ForeignLib], [Executable], [TestSuite],
        [Benchmark]))
-> Component
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent Library
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall {a} {b} {c} {d} {e}.
a -> ([a], b, c, d, e) -> ([a], b, c, d, e)
fa ForeignLib
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall {a} {a} {c} {d} {e}.
a -> (a, [a], c, d, e) -> (a, [a], c, d, e)
fb Executable
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall {a} {a} {b} {d} {e}.
a -> (a, b, [a], d, e) -> (a, b, [a], d, e)
fc TestSuite
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall {a} {a} {b} {c} {e}.
a -> (a, b, c, [a], e) -> (a, b, c, [a], e)
fd Benchmark
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
-> ([Library], [ForeignLib], [Executable], [TestSuite],
    [Benchmark])
forall {a} {a} {b} {c} {d}.
a -> (a, b, c, d, [a]) -> (a, b, c, d, [a])
fe) ([],[],[],[],[])
  where
    fa :: a -> ([a], b, c, d, e) -> ([a], b, c, d, e)
fa a
x ~([a]
a,b
b,c
c,d
d,e
e) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a,b
b,c
c,d
d,e
e)
    fb :: a -> (a, [a], c, d, e) -> (a, [a], c, d, e)
fb a
x ~(a
a,[a]
b,c
c,d
d,e
e) = (a
a,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
b,c
c,d
d,e
e)
    fc :: a -> (a, b, [a], d, e) -> (a, b, [a], d, e)
fc a
x ~(a
a,b
b,[a]
c,d
d,e
e) = (a
a,b
b,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
c,d
d,e
e)
    fd :: a -> (a, b, c, [a], e) -> (a, b, c, [a], e)
fd a
x ~(a
a,b
b,c
c,[a]
d,e
e) = (a
a,b
b,c
c,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
d,e
e)
    fe :: a -> (a, b, c, d, [a]) -> (a, b, c, d, [a])
fe a
x ~(a
a,b
b,c
c,d
d,[a]
e) = (a
a,b
b,c
c,d
d,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
e)