{-# 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
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, ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [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
Read)
instance Semigroup Component where
CLib Library
l <> :: Component -> Component -> Component
<> CLib Library
l' = Library -> Component
CLib (Library
l forall a. Semigroup a => a -> a -> a
<> Library
l')
CFLib ForeignLib
l <> CFLib ForeignLib
l' = ForeignLib -> Component
CFLib (ForeignLib
l forall a. Semigroup a => a -> a -> a
<> ForeignLib
l')
CExe Executable
e <> CExe Executable
e' = Executable -> Component
CExe (Executable
e forall a. Semigroup a => a -> a -> a
<> Executable
e')
CTest TestSuite
t <> CTest TestSuite
t' = TestSuite -> Component
CTest (TestSuite
t forall a. Semigroup a => a -> a -> a
<> TestSuite
t')
CBench Benchmark
b <> CBench Benchmark
b' = Benchmark -> Component
CBench (Benchmark
b forall a. Semigroup a => a -> a -> a
<> Benchmark
b')
Component
_ <> Component
_ = forall a. HasCallStack => String -> a
error String
"Cannot merge Component"
instance L.HasBuildInfo Component where
buildInfo :: Lens' Component BuildInfo
buildInfo BuildInfo -> f BuildInfo
f (CLib Library
l) = Library -> Component
CLib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
f Library
l
buildInfo BuildInfo -> f BuildInfo
f (CFLib ForeignLib
l) = ForeignLib -> Component
CFLib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
f ForeignLib
l
buildInfo BuildInfo -> f BuildInfo
f (CExe Executable
e) = Executable -> Component
CExe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
f Executable
e
buildInfo BuildInfo -> f BuildInfo
f (CTest TestSuite
t) = TestSuite -> Component
CTest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
f TestSuite
t
buildInfo BuildInfo -> f BuildInfo
f (CBench Benchmark
b) = Benchmark -> Component
CBench forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasBuildInfo a => Lens' a BuildInfo
L.buildInfo BuildInfo -> f BuildInfo
f Benchmark
b
foldComponent :: (Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent :: forall a.
(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 =
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
componentBuildable :: Component -> Bool
componentBuildable :: Component -> Bool
componentBuildable = BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> BuildInfo
componentBuildInfo
componentName :: Component -> ComponentName
componentName :: Component -> ComponentName
componentName =
forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent (LibraryName -> ComponentName
CLibName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
(UnqualComponentName -> ComponentName
CFLibName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
(UnqualComponentName -> ComponentName
CExeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName)
(UnqualComponentName -> ComponentName
CTestName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> UnqualComponentName
testName)
(UnqualComponentName -> ComponentName
CBenchName 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent forall {a} {b} {c} {d} {e}.
a -> ([a], b, c, d, e) -> ([a], b, c, d, e)
fa forall {a} {a} {c} {d} {e}.
a -> (a, [a], c, d, e) -> (a, [a], c, d, e)
fb forall {a} {a} {b} {d} {e}.
a -> (a, b, [a], d, e) -> (a, b, [a], d, e)
fc forall {a} {a} {b} {c} {e}.
a -> (a, b, c, [a], e) -> (a, b, c, [a], e)
fd 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
xforall 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
xforall 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
xforall 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
xforall 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
xforall a. a -> [a] -> [a]
:[a]
e)