Cabal/src/Distribution/Simple/Setup/Benchmark.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE DeriveDataTypeable #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE FlexibleContexts #-}
   6 {-# LANGUAGE PatternSynonyms #-}
   7 {-# LANGUAGE RankNTypes #-}
   8 {-# LANGUAGE ViewPatterns #-}
   9
  10 -----------------------------------------------------------------------------
  11
  12 -- |
  13 -- Module      :  Distribution.Simple.Benchmark
  14 -- Copyright   :  Isaac Jones 2003-2004
  15 --                Duncan Coutts 2007
  16 -- License     :  BSD3
  17 --
  18 -- Maintainer  :  cabal-devel@haskell.org
  19 -- Portability :  portable
  20 --
  21 -- Definition of the benchmarking command-line options.
  22 -- See: @Distribution.Simple.Setup@
  23 module Distribution.Simple.Setup.Benchmark
  24   ( BenchmarkFlags
  25       ( BenchmarkCommonFlags
  26       , benchmarkVerbosity
  27       , benchmarkDistPref
  28       , benchmarkCabalFilePath
  29       , benchmarkWorkingDir
  30       , benchmarkTargets
  31       , ..
  32       )
  33   , emptyBenchmarkFlags
  34   , defaultBenchmarkFlags
  35   , benchmarkCommand
  36   , benchmarkOptions'
  37   ) where
  38
  39 import Distribution.Compat.Prelude hiding (get)
  40 import Prelude ()
  41
  42 import Distribution.Simple.Command hiding (boolOpt, boolOpt')
  43 import Distribution.Simple.InstallDirs
  44 import Distribution.Simple.Setup.Common
  45 import Distribution.Simple.Utils
  46 import Distribution.Utils.Path
  47 import Distribution.Verbosity
  48
  49 -- ------------------------------------------------------------
  50
  51 -- * Benchmark flags
  52
  53 -- ------------------------------------------------------------
  54
  55 data BenchmarkFlags = BenchmarkFlags
  56   { benchmarkCommonFlags :: !CommonSetupFlags
  57   , benchmarkOptions :: [PathTemplate]
  58   }
  59   deriving (Show, Generic, Typeable)
  60
  61 pattern BenchmarkCommonFlags
  62   :: Flag Verbosity
  63   -> Flag (SymbolicPath Pkg (Dir Dist))
  64   -> Flag (SymbolicPath CWD (Dir Pkg))
  65   -> Flag (SymbolicPath Pkg File)
  66   -> [String]
  67   -> BenchmarkFlags
  68 pattern BenchmarkCommonFlags
  69   { benchmarkVerbosity
  70   , benchmarkDistPref
  71   , benchmarkWorkingDir
  72   , benchmarkCabalFilePath
  73   , benchmarkTargets
  74   } <-
  75   ( benchmarkCommonFlags ->
  76       CommonSetupFlags
  77         { setupVerbosity = benchmarkVerbosity
  78         , setupDistPref = benchmarkDistPref
  79         , setupWorkingDir = benchmarkWorkingDir
  80         , setupCabalFilePath = benchmarkCabalFilePath
  81         , setupTargets = benchmarkTargets
  82         }
  83     )
  84
  85 instance Binary BenchmarkFlags
  86 instance Structured BenchmarkFlags
  87
  88 defaultBenchmarkFlags :: BenchmarkFlags
  89 defaultBenchmarkFlags =
  90   BenchmarkFlags
  91     { benchmarkCommonFlags = defaultCommonSetupFlags
  92     , benchmarkOptions = []
  93     }
  94
  95 benchmarkCommand :: CommandUI BenchmarkFlags
  96 benchmarkCommand =
  97   CommandUI
  98     { commandName = "bench"
  99     , commandSynopsis =
 100         "Run all/specific benchmarks."
 101     , commandDescription = Just $ \_pname ->
 102         wrapText $
 103           testOrBenchmarkHelpText "benchmark"
 104     , commandNotes = Nothing
 105     , commandUsage =
 106         usageAlternatives
 107           "bench"
 108           [ "[FLAGS]"
 109           , "BENCHCOMPONENTS [FLAGS]"
 110           ]
 111     , commandDefaultFlags = defaultBenchmarkFlags
 112     , commandOptions = benchmarkOptions'
 113     }
 114
 115 benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
 116 benchmarkOptions' showOrParseArgs =
 117   withCommonSetupOptions
 118     benchmarkCommonFlags
 119     (\c f -> f{benchmarkCommonFlags = c})
 120     showOrParseArgs
 121     [ option
 122         []
 123         ["benchmark-options"]
 124         ( "give extra options to benchmark executables "
 125             ++ "(name templates can use $pkgid, $compiler, "
 126             ++ "$os, $arch, $benchmark)"
 127         )
 128         benchmarkOptions
 129         (\v flags -> flags{benchmarkOptions = v})
 130         ( reqArg'
 131             "TEMPLATES"
 132             (map toPathTemplate . splitArgs)
 133             (const [])
 134         )
 135     , option
 136         []
 137         ["benchmark-option"]
 138         ( "give extra option to benchmark executables "
 139             ++ "(no need to quote options containing spaces, "
 140             ++ "name template can use $pkgid, $compiler, "
 141             ++ "$os, $arch, $benchmark)"
 142         )
 143         benchmarkOptions
 144         (\v flags -> flags{benchmarkOptions = v})
 145         ( reqArg'
 146             "TEMPLATE"
 147             (\x -> [toPathTemplate x])
 148             (map fromPathTemplate)
 149         )
 150     ]
 151
 152 emptyBenchmarkFlags :: BenchmarkFlags
 153 emptyBenchmarkFlags = mempty
 154
 155 instance Monoid BenchmarkFlags where
 156   mempty = gmempty
 157   mappend = (<>)
 158
 159 instance Semigroup BenchmarkFlags where
 160   (<>) = gmappend