git.iko.soy/streamly
on 8ec2ebe help sign in
streamly/benchmark/Common.hs
82 lines 2.5 kB history raw
1-- |
2-- Module : Main
3-- Copyright : (c) 2019 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
8module Common (parseCLIOpts) where
10import Control.Exception (evaluate)
11import Control.Monad (when)
12import Data.List (scanl')
13import Data.Maybe (catMaybes)
14import System.Console.GetOpt
15 (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
16import System.Environment (getArgs)
17import Text.Read (readMaybe)
19import Gauge
21-------------------------------------------------------------------------------
22-- Parse custom CLI options
23-------------------------------------------------------------------------------
25data BenchOpts = StreamSize Int deriving Show
27options :: [OptDescr BenchOpts]
28options =
29 [
30 Option [] ["stream-size"] (ReqArg getSize "COUNT") "Stream element count"
31 ]
33 where
35 getSize :: String -> BenchOpts
36 getSize size =
37 case (readMaybe size :: Maybe Int) of
38 Just x -> StreamSize x
39 Nothing -> error "Stream size must be numeric"
41deleteOptArgs
42 :: (Maybe String, Maybe String) -- (prev, yielded)
43 -> String
44 -> (Maybe String, Maybe String)
45deleteOptArgs (Nothing, _) opt =
46 if opt == "--stream-size"
47 then (Just opt, Nothing)
48 else (Just opt, Just opt)
50deleteOptArgs (Just prev, _) opt =
51 if opt == "--stream-size" || prev == "--stream-size"
52 then (Just opt, Nothing)
53 else (Just opt, Just opt)
55parseCLIOpts :: Int -> IO (Int, Config, [String])
56parseCLIOpts defaultStreamSize = do
57 args <- getArgs
59 -- Parse custom options
60 let (opts, _, _, errs) = getOpt' Permute options args
61 when (not $ null errs) $ error $ concat errs
62 (streamSize, args') <- evaluate $
63 case opts of
64 StreamSize x : _ ->
65 -- Hack! remove the option and its argument from args
66 -- getOpt should have a way to return the unconsumed args in
67 -- correct order.
68 let newArgs =
69 catMaybes
70 $ map snd
71 $ scanl' deleteOptArgs (Nothing, Nothing) args
72 in (x, newArgs)
73 _ -> (defaultStreamSize, args)
75 -- Parse gauge options
76 let config = defaultConfig
77 { timeLimit = Just 1
78 , minDuration = 0
79 , includeFirstIter = streamSize > defaultStreamSize
80 }
81 let (cfg, benches) = parseWith config args'
82 return (streamSize, cfg, benches)