{-# LANGUAGE OverloadedStrings #-}
module Foundation.Check.Config
    ( Config(..)
    , Seed
    , DisplayOption(..)
    , defaultConfig
    , parseArgs
    , configHelp
    ) where

import           Basement.Imports
import           Basement.IntegralConv
import           Foundation.String.Read
import           Foundation.Check.Gen

type Seed = Word64

data DisplayOption =
      DisplayTerminalErrorOnly
    | DisplayGroupOnly
    | DisplayTerminalVerbose
    deriving (DisplayOption -> DisplayOption -> Bool
(DisplayOption -> DisplayOption -> Bool)
-> (DisplayOption -> DisplayOption -> Bool) -> Eq DisplayOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayOption -> DisplayOption -> Bool
$c/= :: DisplayOption -> DisplayOption -> Bool
== :: DisplayOption -> DisplayOption -> Bool
$c== :: DisplayOption -> DisplayOption -> Bool
Eq, Eq DisplayOption
Eq DisplayOption
-> (DisplayOption -> DisplayOption -> Ordering)
-> (DisplayOption -> DisplayOption -> Bool)
-> (DisplayOption -> DisplayOption -> Bool)
-> (DisplayOption -> DisplayOption -> Bool)
-> (DisplayOption -> DisplayOption -> Bool)
-> (DisplayOption -> DisplayOption -> DisplayOption)
-> (DisplayOption -> DisplayOption -> DisplayOption)
-> Ord DisplayOption
DisplayOption -> DisplayOption -> Bool
DisplayOption -> DisplayOption -> Ordering
DisplayOption -> DisplayOption -> DisplayOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DisplayOption -> DisplayOption -> DisplayOption
$cmin :: DisplayOption -> DisplayOption -> DisplayOption
max :: DisplayOption -> DisplayOption -> DisplayOption
$cmax :: DisplayOption -> DisplayOption -> DisplayOption
>= :: DisplayOption -> DisplayOption -> Bool
$c>= :: DisplayOption -> DisplayOption -> Bool
> :: DisplayOption -> DisplayOption -> Bool
$c> :: DisplayOption -> DisplayOption -> Bool
<= :: DisplayOption -> DisplayOption -> Bool
$c<= :: DisplayOption -> DisplayOption -> Bool
< :: DisplayOption -> DisplayOption -> Bool
$c< :: DisplayOption -> DisplayOption -> Bool
compare :: DisplayOption -> DisplayOption -> Ordering
$ccompare :: DisplayOption -> DisplayOption -> Ordering
$cp1Ord :: Eq DisplayOption
Ord, Int -> DisplayOption
DisplayOption -> Int
DisplayOption -> [DisplayOption]
DisplayOption -> DisplayOption
DisplayOption -> DisplayOption -> [DisplayOption]
DisplayOption -> DisplayOption -> DisplayOption -> [DisplayOption]
(DisplayOption -> DisplayOption)
-> (DisplayOption -> DisplayOption)
-> (Int -> DisplayOption)
-> (DisplayOption -> Int)
-> (DisplayOption -> [DisplayOption])
-> (DisplayOption -> DisplayOption -> [DisplayOption])
-> (DisplayOption -> DisplayOption -> [DisplayOption])
-> (DisplayOption
    -> DisplayOption -> DisplayOption -> [DisplayOption])
-> Enum DisplayOption
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DisplayOption -> DisplayOption -> DisplayOption -> [DisplayOption]
$cenumFromThenTo :: DisplayOption -> DisplayOption -> DisplayOption -> [DisplayOption]
enumFromTo :: DisplayOption -> DisplayOption -> [DisplayOption]
$cenumFromTo :: DisplayOption -> DisplayOption -> [DisplayOption]
enumFromThen :: DisplayOption -> DisplayOption -> [DisplayOption]
$cenumFromThen :: DisplayOption -> DisplayOption -> [DisplayOption]
enumFrom :: DisplayOption -> [DisplayOption]
$cenumFrom :: DisplayOption -> [DisplayOption]
fromEnum :: DisplayOption -> Int
$cfromEnum :: DisplayOption -> Int
toEnum :: Int -> DisplayOption
$ctoEnum :: Int -> DisplayOption
pred :: DisplayOption -> DisplayOption
$cpred :: DisplayOption -> DisplayOption
succ :: DisplayOption -> DisplayOption
$csucc :: DisplayOption -> DisplayOption
Enum, DisplayOption
DisplayOption -> DisplayOption -> Bounded DisplayOption
forall a. a -> a -> Bounded a
maxBound :: DisplayOption
$cmaxBound :: DisplayOption
minBound :: DisplayOption
$cminBound :: DisplayOption
Bounded, Int -> DisplayOption -> ShowS
[DisplayOption] -> ShowS
DisplayOption -> String
(Int -> DisplayOption -> ShowS)
-> (DisplayOption -> String)
-> ([DisplayOption] -> ShowS)
-> Show DisplayOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayOption] -> ShowS
$cshowList :: [DisplayOption] -> ShowS
show :: DisplayOption -> String
$cshow :: DisplayOption -> String
showsPrec :: Int -> DisplayOption -> ShowS
$cshowsPrec :: Int -> DisplayOption -> ShowS
Show)

data Config = Config
    { Config -> Maybe Seed
udfSeed      :: Maybe Seed -- ^ optional user specified seed
    , Config -> GenParams
getGenParams :: !GenParams
        -- ^ Parameters for the generator
        --
        -- default:
        --   * 32bits long numbers;
        --   * array of 512 elements max;
        --   * string of 8192 bytes max.
        --
    , Config -> Seed
numTests     :: !Word64
        -- ^ the number of tests to perform on every property.
        --
        -- default: 100
    , Config -> Bool
listTests      :: Bool
    , Config -> [String]
testNameMatch  :: [String]
    , Config -> DisplayOption
displayOptions :: !DisplayOption
    , Config -> Bool
helpRequested  :: Bool
    }

-- | create the default configuration
--
-- see @Config@ for details
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Maybe Seed
-> GenParams
-> Seed
-> Bool
-> [String]
-> DisplayOption
-> Bool
-> Config
Config
    { udfSeed :: Maybe Seed
udfSeed      = Maybe Seed
forall a. Maybe a
Nothing
    , getGenParams :: GenParams
getGenParams = GenParams
params
    , numTests :: Seed
numTests     = Seed
100
    , listTests :: Bool
listTests    = Bool
False
    , testNameMatch :: [String]
testNameMatch  = []
    , displayOptions :: DisplayOption
displayOptions = DisplayOption
DisplayGroupOnly
    , helpRequested :: Bool
helpRequested  = Bool
False
    }
  where
    params :: GenParams
params = GenParams :: Word -> Word -> Word -> GenParams
GenParams
        { genMaxSizeIntegral :: Word
genMaxSizeIntegral = Word
32   -- 256 bits maximum numbers
        , genMaxSizeArray :: Word
genMaxSizeArray    = Word
512  -- 512 elements
        , genMaxSizeString :: Word
genMaxSizeString   = Word
8192 -- 8K string
        }

type ParamError = String

getInteger :: String -> String -> Either ParamError Integer
getInteger :: String -> String -> Either String Integer
getInteger String
optionName String
s =
    Either String Integer
-> (Integer -> Either String Integer)
-> Maybe Integer
-> Either String Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Integer
forall a b. a -> Either a b
Left String
errMsg) Integer -> Either String Integer
forall a b. b -> Either a b
Right (Maybe Integer -> Either String Integer)
-> Maybe Integer -> Either String Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
forall i.
(HasNegation i, IntegralUpsize Word8 i, Additive i,
 Multiplicative i, IsIntegral i) =>
String -> Maybe i
readIntegral String
s
  where
    errMsg :: String
errMsg = String
"argument error for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
optionName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expecting a number but got : " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s

parseArgs :: [String] -> Config -> Either ParamError Config
parseArgs :: [String] -> Config -> Either String Config
parseArgs []                Config
cfg   = Config -> Either String Config
forall a b. b -> Either a b
Right Config
cfg
parseArgs [String
"--seed"]       Config
_      = String -> Either String Config
forall a b. a -> Either a b
Left String
"option `--seed' is missing a parameter"
parseArgs (String
"--seed":String
x:[String]
xs)  Config
cfg    = String -> String -> Either String Integer
getInteger String
"seed" String
x Either String Integer
-> (Integer -> Either String Config) -> Either String Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { udfSeed :: Maybe Seed
udfSeed = Seed -> Maybe Seed
forall a. a -> Maybe a
Just (Seed -> Maybe Seed) -> Seed -> Maybe Seed
forall a b. (a -> b) -> a -> b
$ Integer -> Seed
forall a b. IntegralDownsize a b => a -> b
integralDownsize Integer
i }
parseArgs [String
"--tests"]      Config
_      = String -> Either String Config
forall a b. a -> Either a b
Left String
"option `--tests' is missing a parameter"
parseArgs (String
"--tests":String
x:[String]
xs) Config
cfg    = String -> String -> Either String Integer
getInteger String
"tests" String
x Either String Integer
-> (Integer -> Either String Config) -> Either String Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { numTests :: Seed
numTests = Integer -> Seed
forall a b. IntegralDownsize a b => a -> b
integralDownsize Integer
i }
parseArgs (String
"--quiet":[String]
xs)   Config
cfg    = [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { displayOptions :: DisplayOption
displayOptions = DisplayOption
DisplayTerminalErrorOnly }
parseArgs (String
"--list-tests":[String]
xs) Config
cfg = [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { listTests :: Bool
listTests = Bool
True }
parseArgs (String
"--verbose":[String]
xs) Config
cfg    = [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { displayOptions :: DisplayOption
displayOptions = DisplayOption
DisplayTerminalVerbose }
parseArgs (String
"--help":[String]
xs)    Config
cfg    = [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { helpRequested :: Bool
helpRequested = Bool
True }
parseArgs (String
x:[String]
xs)           Config
cfg    = [String] -> Config -> Either String Config
parseArgs [String]
xs (Config -> Either String Config) -> Config -> Either String Config
forall a b. (a -> b) -> a -> b
$ Config
cfg { testNameMatch :: [String]
testNameMatch = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Config -> [String]
testNameMatch Config
cfg }

configHelp :: [String]
configHelp :: [String]
configHelp =
    [ String
"Usage: <program-name> [options] [test-name-match]\n"
    , String
"\n"
    , String
"Known options:\n"
    , String
"\n"
    , String
"  --seed <seed>: a 64bit positive number to use as seed to generate arbitrary value.\n"
    , String
"  --tests <tests>: the number of tests to perform for every property tests.\n"
    , String
"  --quiet: print only the errors to the standard output\n"
    , String
"  --verbose: print every property tests to the stand output.\n"
    , String
"  --list-tests: print all test names.\n"
    ]