{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.BenchmarkInterface (
    BenchmarkInterface(..),
) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.BenchmarkType
import Distribution.Version

-- | The benchmark interfaces that are currently defined. Each
-- benchmark must specify which interface it supports.
--
-- More interfaces may be defined in future, either new revisions or
-- totally new interfaces.
--
data BenchmarkInterface =

     -- | Benchmark interface \"exitcode-stdio-1.0\". The benchmark
     -- takes the form of an executable. It returns a zero exit code
     -- for success, non-zero for failure. The stdout and stderr
     -- channels may be logged. It takes no command line parameters
     -- and nothing on stdin.
     --
     BenchmarkExeV10 Version FilePath

     -- | A benchmark that does not conform to one of the above
     -- interfaces for the given reason (e.g. unknown benchmark type).
     --
   | BenchmarkUnsupported BenchmarkType
   deriving (BenchmarkInterface -> BenchmarkInterface -> Bool
(BenchmarkInterface -> BenchmarkInterface -> Bool)
-> (BenchmarkInterface -> BenchmarkInterface -> Bool)
-> Eq BenchmarkInterface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BenchmarkInterface -> BenchmarkInterface -> Bool
$c/= :: BenchmarkInterface -> BenchmarkInterface -> Bool
== :: BenchmarkInterface -> BenchmarkInterface -> Bool
$c== :: BenchmarkInterface -> BenchmarkInterface -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq BenchmarkType
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Version
Eq, (forall x. BenchmarkInterface -> Rep BenchmarkInterface x)
-> (forall x. Rep BenchmarkInterface x -> BenchmarkInterface)
-> Generic BenchmarkInterface
forall x. Rep BenchmarkInterface x -> BenchmarkInterface
forall x. BenchmarkInterface -> Rep BenchmarkInterface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BenchmarkInterface x -> BenchmarkInterface
$cfrom :: forall x. BenchmarkInterface -> Rep BenchmarkInterface x
Generic, ReadPrec [BenchmarkInterface]
ReadPrec BenchmarkInterface
Int -> ReadS BenchmarkInterface
ReadS [BenchmarkInterface]
(Int -> ReadS BenchmarkInterface)
-> ReadS [BenchmarkInterface]
-> ReadPrec BenchmarkInterface
-> ReadPrec [BenchmarkInterface]
-> Read BenchmarkInterface
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BenchmarkInterface]
$creadListPrec :: ReadPrec [BenchmarkInterface]
readPrec :: ReadPrec BenchmarkInterface
$creadPrec :: ReadPrec BenchmarkInterface
readList :: ReadS [BenchmarkInterface]
$creadList :: ReadS [BenchmarkInterface]
readsPrec :: Int -> ReadS BenchmarkInterface
$creadsPrec :: Int -> ReadS BenchmarkInterface
External instance of the constraint type Read Char
External instance of the constraint type Read BenchmarkType
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Version
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 BenchmarkInterface
Read, Int -> BenchmarkInterface -> ShowS
[BenchmarkInterface] -> ShowS
BenchmarkInterface -> FilePath
(Int -> BenchmarkInterface -> ShowS)
-> (BenchmarkInterface -> FilePath)
-> ([BenchmarkInterface] -> ShowS)
-> Show BenchmarkInterface
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BenchmarkInterface] -> ShowS
$cshowList :: [BenchmarkInterface] -> ShowS
show :: BenchmarkInterface -> FilePath
$cshow :: BenchmarkInterface -> FilePath
showsPrec :: Int -> BenchmarkInterface -> ShowS
$cshowsPrec :: Int -> BenchmarkInterface -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show BenchmarkType
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Version
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show, Typeable, Typeable BenchmarkInterface
DataType
Constr
Typeable BenchmarkInterface
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> BenchmarkInterface
    -> c BenchmarkInterface)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BenchmarkInterface)
-> (BenchmarkInterface -> Constr)
-> (BenchmarkInterface -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BenchmarkInterface))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BenchmarkInterface))
-> ((forall b. Data b => b -> b)
    -> BenchmarkInterface -> BenchmarkInterface)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> BenchmarkInterface -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BenchmarkInterface -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> BenchmarkInterface -> m BenchmarkInterface)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BenchmarkInterface -> m BenchmarkInterface)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BenchmarkInterface -> m BenchmarkInterface)
-> Data BenchmarkInterface
BenchmarkInterface -> DataType
BenchmarkInterface -> Constr
(forall b. Data b => b -> b)
-> BenchmarkInterface -> BenchmarkInterface
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BenchmarkInterface
-> c BenchmarkInterface
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkInterface
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) -> BenchmarkInterface -> u
forall u. (forall d. Data d => d -> u) -> BenchmarkInterface -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkInterface
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BenchmarkInterface
-> c BenchmarkInterface
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BenchmarkInterface)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkInterface)
$cBenchmarkUnsupported :: Constr
$cBenchmarkExeV10 :: Constr
$tBenchmarkInterface :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
gmapMp :: (forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
gmapM :: (forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BenchmarkInterface -> m BenchmarkInterface
gmapQi :: Int -> (forall d. Data d => d -> u) -> BenchmarkInterface -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BenchmarkInterface -> u
gmapQ :: (forall d. Data d => d -> u) -> BenchmarkInterface -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BenchmarkInterface -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkInterface -> r
gmapT :: (forall b. Data b => b -> b)
-> BenchmarkInterface -> BenchmarkInterface
$cgmapT :: (forall b. Data b => b -> b)
-> BenchmarkInterface -> BenchmarkInterface
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkInterface)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkInterface)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BenchmarkInterface)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BenchmarkInterface)
dataTypeOf :: BenchmarkInterface -> DataType
$cdataTypeOf :: BenchmarkInterface -> DataType
toConstr :: BenchmarkInterface -> Constr
$ctoConstr :: BenchmarkInterface -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkInterface
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkInterface
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BenchmarkInterface
-> c BenchmarkInterface
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BenchmarkInterface
-> c BenchmarkInterface
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data BenchmarkType
External instance of the constraint type Data Version
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
Data)

instance Binary BenchmarkInterface
instance Structured BenchmarkInterface
instance NFData BenchmarkInterface where rnf :: BenchmarkInterface -> ()
rnf = BenchmarkInterface -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :+: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData Version
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData BenchmarkType
Instance of class: Generic of the constraint type Generic BenchmarkInterface
genericRnf

instance Monoid BenchmarkInterface where
    mempty :: BenchmarkInterface
mempty  =  BenchmarkType -> BenchmarkInterface
BenchmarkUnsupported (FilePath -> Version -> BenchmarkType
BenchmarkTypeUnknown FilePath
forall a. Monoid a => a
External instance of the constraint type forall a. Monoid [a]
mempty Version
nullVersion)
    mappend :: BenchmarkInterface -> BenchmarkInterface -> BenchmarkInterface
mappend = BenchmarkInterface -> BenchmarkInterface -> BenchmarkInterface
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup BenchmarkInterface
(<>)

instance Semigroup BenchmarkInterface where
    BenchmarkInterface
a <> :: BenchmarkInterface -> BenchmarkInterface -> BenchmarkInterface
<> (BenchmarkUnsupported BenchmarkType
_) = BenchmarkInterface
a
    BenchmarkInterface
_ <> BenchmarkInterface
b                        = BenchmarkInterface
b