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

module Distribution.Types.BenchmarkType (
    BenchmarkType(..),
    knownBenchmarkTypes,
) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Version
import Text.PrettyPrint          (char, text)

-- | The \"benchmark-type\" field in the benchmark stanza.
--
data BenchmarkType = BenchmarkTypeExe Version
                     -- ^ \"type: exitcode-stdio-x.y\"
                   | BenchmarkTypeUnknown String Version
                     -- ^ Some unknown benchmark type e.g. \"type: foo\"
    deriving ((forall x. BenchmarkType -> Rep BenchmarkType x)
-> (forall x. Rep BenchmarkType x -> BenchmarkType)
-> Generic BenchmarkType
forall x. Rep BenchmarkType x -> BenchmarkType
forall x. BenchmarkType -> Rep BenchmarkType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BenchmarkType x -> BenchmarkType
$cfrom :: forall x. BenchmarkType -> Rep BenchmarkType x
Generic, Int -> BenchmarkType -> ShowS
[BenchmarkType] -> ShowS
BenchmarkType -> String
(Int -> BenchmarkType -> ShowS)
-> (BenchmarkType -> String)
-> ([BenchmarkType] -> ShowS)
-> Show BenchmarkType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BenchmarkType] -> ShowS
$cshowList :: [BenchmarkType] -> ShowS
show :: BenchmarkType -> String
$cshow :: BenchmarkType -> String
showsPrec :: Int -> BenchmarkType -> ShowS
$cshowsPrec :: Int -> BenchmarkType -> ShowS
External instance of the constraint type Show Char
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 Show Version
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show, ReadPrec [BenchmarkType]
ReadPrec BenchmarkType
Int -> ReadS BenchmarkType
ReadS [BenchmarkType]
(Int -> ReadS BenchmarkType)
-> ReadS [BenchmarkType]
-> ReadPrec BenchmarkType
-> ReadPrec [BenchmarkType]
-> Read BenchmarkType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BenchmarkType]
$creadListPrec :: ReadPrec [BenchmarkType]
readPrec :: ReadPrec BenchmarkType
$creadPrec :: ReadPrec BenchmarkType
readList :: ReadS [BenchmarkType]
$creadList :: ReadS [BenchmarkType]
readsPrec :: Int -> ReadS BenchmarkType
$creadsPrec :: Int -> ReadS BenchmarkType
External instance of the constraint type Read Char
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 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 BenchmarkType
Read, BenchmarkType -> BenchmarkType -> Bool
(BenchmarkType -> BenchmarkType -> Bool)
-> (BenchmarkType -> BenchmarkType -> Bool) -> Eq BenchmarkType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BenchmarkType -> BenchmarkType -> Bool
$c/= :: BenchmarkType -> BenchmarkType -> Bool
== :: BenchmarkType -> BenchmarkType -> Bool
$c== :: BenchmarkType -> BenchmarkType -> Bool
External instance of the constraint type Eq Char
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
External instance of the constraint type Eq Version
Eq, Typeable, Typeable BenchmarkType
DataType
Constr
Typeable BenchmarkType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BenchmarkType -> c BenchmarkType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BenchmarkType)
-> (BenchmarkType -> Constr)
-> (BenchmarkType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BenchmarkType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BenchmarkType))
-> ((forall b. Data b => b -> b) -> BenchmarkType -> BenchmarkType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r)
-> (forall u. (forall d. Data d => d -> u) -> BenchmarkType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BenchmarkType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType)
-> Data BenchmarkType
BenchmarkType -> DataType
BenchmarkType -> Constr
(forall b. Data b => b -> b) -> BenchmarkType -> BenchmarkType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BenchmarkType -> c BenchmarkType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkType
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) -> BenchmarkType -> u
forall u. (forall d. Data d => d -> u) -> BenchmarkType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BenchmarkType -> c BenchmarkType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BenchmarkType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkType)
$cBenchmarkTypeUnknown :: Constr
$cBenchmarkTypeExe :: Constr
$tBenchmarkType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
gmapMp :: (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
gmapM :: (forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BenchmarkType -> m BenchmarkType
gmapQi :: Int -> (forall d. Data d => d -> u) -> BenchmarkType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BenchmarkType -> u
gmapQ :: (forall d. Data d => d -> u) -> BenchmarkType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BenchmarkType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BenchmarkType -> r
gmapT :: (forall b. Data b => b -> b) -> BenchmarkType -> BenchmarkType
$cgmapT :: (forall b. Data b => b -> b) -> BenchmarkType -> BenchmarkType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BenchmarkType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BenchmarkType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BenchmarkType)
dataTypeOf :: BenchmarkType -> DataType
$cdataTypeOf :: BenchmarkType -> DataType
toConstr :: BenchmarkType -> Constr
$ctoConstr :: BenchmarkType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BenchmarkType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BenchmarkType -> c BenchmarkType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BenchmarkType -> c BenchmarkType
External instance of the constraint type Data Char
External instance of the constraint type Data Char
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]
External instance of the constraint type Data Version
External instance of the constraint type Data Version
Data)

instance Binary BenchmarkType
instance Structured BenchmarkType
instance NFData BenchmarkType where rnf :: BenchmarkType -> ()
rnf = BenchmarkType -> ()
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 :: * -> *) 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 :: * -> *) (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 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. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData Version
Instance of class: Generic of the constraint type Generic BenchmarkType
genericRnf

knownBenchmarkTypes :: [BenchmarkType]
knownBenchmarkTypes :: [BenchmarkType]
knownBenchmarkTypes = [ Version -> BenchmarkType
BenchmarkTypeExe ([Int] -> Version
mkVersion [Int
1,Int
0]) ]

instance Pretty BenchmarkType where
  pretty :: BenchmarkType -> Doc
pretty (BenchmarkTypeExe Version
ver)          = String -> Doc
text String
"exitcode-stdio-" Doc -> Doc -> Doc
<<>> Version -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty Version
pretty Version
ver
  pretty (BenchmarkTypeUnknown String
name Version
ver) = String -> Doc
text String
name Doc -> Doc -> Doc
<<>> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<<>> Version -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty Version
pretty Version
ver

instance Parsec BenchmarkType where
    parsec :: m BenchmarkType
parsec = (Version -> String -> BenchmarkType) -> m BenchmarkType
forall (m :: * -> *) ver a.
(CabalParsing m, Parsec ver) =>
(ver -> String -> a) -> m a
External instance of the constraint type Parsec Version
Evidence bound by a type signature of the constraint type CabalParsing m
parsecStandard ((Version -> String -> BenchmarkType) -> m BenchmarkType)
-> (Version -> String -> BenchmarkType) -> m BenchmarkType
forall a b. (a -> b) -> a -> b
$ \Version
ver String
name -> case String
name of
       String
"exitcode-stdio" -> Version -> BenchmarkType
BenchmarkTypeExe Version
ver
       String
_                -> String -> Version -> BenchmarkType
BenchmarkTypeUnknown String
name Version
ver