{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Benchmark
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the benchmarking command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Benchmark
  ( BenchmarkFlags
      ( BenchmarkCommonFlags
      , benchmarkVerbosity
      , benchmarkDistPref
      , benchmarkCabalFilePath
      , benchmarkWorkingDir
      , benchmarkTargets
      , ..
      )
  , emptyBenchmarkFlags
  , defaultBenchmarkFlags
  , benchmarkCommand
  , benchmarkOptions'
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.InstallDirs
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Utils.Path
import Distribution.Verbosity

-- ------------------------------------------------------------

-- * Benchmark flags

-- ------------------------------------------------------------

data BenchmarkFlags = BenchmarkFlags
  { BenchmarkFlags -> CommonSetupFlags
benchmarkCommonFlags :: !CommonSetupFlags
  , BenchmarkFlags -> [PathTemplate]
benchmarkOptions :: [PathTemplate]
  }
  deriving (Int -> BenchmarkFlags -> ShowS
[BenchmarkFlags] -> ShowS
BenchmarkFlags -> String
(Int -> BenchmarkFlags -> ShowS)
-> (BenchmarkFlags -> String)
-> ([BenchmarkFlags] -> ShowS)
-> Show BenchmarkFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BenchmarkFlags -> ShowS
showsPrec :: Int -> BenchmarkFlags -> ShowS
$cshow :: BenchmarkFlags -> String
show :: BenchmarkFlags -> String
$cshowList :: [BenchmarkFlags] -> ShowS
showList :: [BenchmarkFlags] -> ShowS
Show, (forall x. BenchmarkFlags -> Rep BenchmarkFlags x)
-> (forall x. Rep BenchmarkFlags x -> BenchmarkFlags)
-> Generic BenchmarkFlags
forall x. Rep BenchmarkFlags x -> BenchmarkFlags
forall x. BenchmarkFlags -> Rep BenchmarkFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BenchmarkFlags -> Rep BenchmarkFlags x
from :: forall x. BenchmarkFlags -> Rep BenchmarkFlags x
$cto :: forall x. Rep BenchmarkFlags x -> BenchmarkFlags
to :: forall x. Rep BenchmarkFlags x -> BenchmarkFlags
Generic, Typeable)

pattern BenchmarkCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> BenchmarkFlags
pattern $mBenchmarkCommonFlags :: forall {r}.
BenchmarkFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [String]
    -> r)
-> ((# #) -> r)
-> r
BenchmarkCommonFlags
  { BenchmarkFlags -> Flag Verbosity
benchmarkVerbosity
  , BenchmarkFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
benchmarkDistPref
  , BenchmarkFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
benchmarkWorkingDir
  , BenchmarkFlags -> Flag (SymbolicPath Pkg 'File)
benchmarkCabalFilePath
  , BenchmarkFlags -> [String]
benchmarkTargets
  } <-
  ( benchmarkCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = benchmarkVerbosity
        , setupDistPref = benchmarkDistPref
        , setupWorkingDir = benchmarkWorkingDir
        , setupCabalFilePath = benchmarkCabalFilePath
        , setupTargets = benchmarkTargets
        }
    )

instance Binary BenchmarkFlags
instance Structured BenchmarkFlags

defaultBenchmarkFlags :: BenchmarkFlags
defaultBenchmarkFlags :: BenchmarkFlags
defaultBenchmarkFlags =
  BenchmarkFlags
    { benchmarkCommonFlags :: CommonSetupFlags
benchmarkCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , benchmarkOptions :: [PathTemplate]
benchmarkOptions = []
    }

benchmarkCommand :: CommandUI BenchmarkFlags
benchmarkCommand :: CommandUI BenchmarkFlags
benchmarkCommand =
  CommandUI
    { commandName :: String
commandName = String
"bench"
    , commandSynopsis :: String
commandSynopsis =
        String
"Run all/specific benchmarks."
    , commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \String
_pname ->
        ShowS
wrapText ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          ShowS
testOrBenchmarkHelpText String
"benchmark"
    , commandNotes :: Maybe ShowS
commandNotes = Maybe ShowS
forall a. Maybe a
Nothing
    , commandUsage :: ShowS
commandUsage =
        String -> [String] -> ShowS
usageAlternatives
          String
"bench"
          [ String
"[FLAGS]"
          , String
"BENCHCOMPONENTS [FLAGS]"
          ]
    , commandDefaultFlags :: BenchmarkFlags
commandDefaultFlags = BenchmarkFlags
defaultBenchmarkFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
commandOptions = ShowOrParseArgs -> [OptionField BenchmarkFlags]
benchmarkOptions'
    }

benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
benchmarkOptions' ShowOrParseArgs
showOrParseArgs =
  (BenchmarkFlags -> CommonSetupFlags)
-> (CommonSetupFlags -> BenchmarkFlags -> BenchmarkFlags)
-> ShowOrParseArgs
-> [OptionField BenchmarkFlags]
-> [OptionField BenchmarkFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
    BenchmarkFlags -> CommonSetupFlags
benchmarkCommonFlags
    (\CommonSetupFlags
c BenchmarkFlags
f -> BenchmarkFlags
f{benchmarkCommonFlags = c})
    ShowOrParseArgs
showOrParseArgs
    [ String
-> [String]
-> String
-> (BenchmarkFlags -> [PathTemplate])
-> ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
-> MkOptDescr
     (BenchmarkFlags -> [PathTemplate])
     ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
     BenchmarkFlags
-> OptionField BenchmarkFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        []
        [String
"benchmark-options"]
        ( String
"give extra options to benchmark executables "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(name templates can use $pkgid, $compiler, "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"$os, $arch, $benchmark)"
        )
        BenchmarkFlags -> [PathTemplate]
benchmarkOptions
        (\[PathTemplate]
v BenchmarkFlags
flags -> BenchmarkFlags
flags{benchmarkOptions = v})
        ( String
-> (String -> [PathTemplate])
-> ([PathTemplate] -> [String])
-> MkOptDescr
     (BenchmarkFlags -> [PathTemplate])
     ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
     BenchmarkFlags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
            String
"TEMPLATES"
            ((String -> PathTemplate) -> [String] -> [PathTemplate]
forall a b. (a -> b) -> [a] -> [b]
map String -> PathTemplate
toPathTemplate ([String] -> [PathTemplate])
-> (String -> [String]) -> String -> [PathTemplate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitArgs)
            ([String] -> [PathTemplate] -> [String]
forall a b. a -> b -> a
const [])
        )
    , String
-> [String]
-> String
-> (BenchmarkFlags -> [PathTemplate])
-> ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
-> MkOptDescr
     (BenchmarkFlags -> [PathTemplate])
     ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
     BenchmarkFlags
-> OptionField BenchmarkFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        []
        [String
"benchmark-option"]
        ( String
"give extra option to benchmark executables "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(no need to quote options containing spaces, "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"name template can use $pkgid, $compiler, "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"$os, $arch, $benchmark)"
        )
        BenchmarkFlags -> [PathTemplate]
benchmarkOptions
        (\[PathTemplate]
v BenchmarkFlags
flags -> BenchmarkFlags
flags{benchmarkOptions = v})
        ( String
-> (String -> [PathTemplate])
-> ([PathTemplate] -> [String])
-> MkOptDescr
     (BenchmarkFlags -> [PathTemplate])
     ([PathTemplate] -> BenchmarkFlags -> BenchmarkFlags)
     BenchmarkFlags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
            String
"TEMPLATE"
            (\String
x -> [String -> PathTemplate
toPathTemplate String
x])
            ((PathTemplate -> String) -> [PathTemplate] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PathTemplate -> String
fromPathTemplate)
        )
    ]

emptyBenchmarkFlags :: BenchmarkFlags
emptyBenchmarkFlags :: BenchmarkFlags
emptyBenchmarkFlags = BenchmarkFlags
forall a. Monoid a => a
mempty

instance Monoid BenchmarkFlags where
  mempty :: BenchmarkFlags
mempty = BenchmarkFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
mappend = BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup BenchmarkFlags where
  <> :: BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
(<>) = BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend