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

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