    {-# 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 = $WConfig :: 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     = 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 = 32   -- 256 bits maximum numbers
            , genMaxSizeArray :: Word
    genMaxSizeArray    = 512  -- 512 elements
            , genMaxSizeString :: Word
    genMaxSizeString   = 8192 -- 8K string
            }

    type ParamError = String

    getInteger :: String -> String -> Either ParamError Integer
    getInteger :: String -> String -> Either String Integer
    getInteger optionName :: String
    optionName s :: 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 = "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
    <> " 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 []                cfg :: Config
    cfg   = Config -> Either String Config
    forall a b. b -> Either a b
    Right Config
    cfg
    parseArgs ["--seed"]       _      = String -> Either String Config
    forall a b. a -> Either a b
    Left "option `--seed' is missing a parameter"
    parseArgs ("--seed":x :: String
    x:xs :: [String]
    xs)  cfg :: Config
    cfg    = String -> String -> Either String Integer
    getInteger "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
    >>= \i :: 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 ["--tests"]      _      = String -> Either String Config
    forall a b. a -> Either a b
    Left "option `--tests' is missing a parameter"
    parseArgs ("--tests":x :: String
    x:xs :: [String]
    xs) cfg :: Config
    cfg    = String -> String -> Either String Integer
    getInteger "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
    >>= \i :: 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 ("--quiet":xs :: [String]
    xs)   cfg :: 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 ("--list-tests":xs :: [String]
    xs) cfg :: 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 ("--verbose":xs :: [String]
    xs) cfg :: 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 ("--help":xs :: [String]
    xs)    cfg :: 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 (x :: String
    x:xs :: [String]
    xs)           cfg :: 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 =
        [ "Usage: <program-name> [options] [test-name-match]\n"
        , "\n"
        , "Known options:\n"
        , "\n"
        , "  --seed <seed>: a 64bit positive number to use as seed to generate arbitrary value.\n"
        , "  --tests <tests>: the number of tests to perform for every property tests.\n"
        , "  --quiet: print only the errors to the standard output\n"
        , "  --verbose: print every property tests to the stand output.\n"
        , "  --list-tests: print all test names.\n"
        ]