    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Foundation.Check.Gen
        ( Gen
        , runGen
        , GenParams(..)
        , GenRng
        , genRng
        , genWithRng
        , genWithParams
        ) where

    import           Basement.Imports
    import           Foundation.Collection
    import           Foundation.Random
    import qualified Foundation.Random.XorShift as XorShift
    import           Foundation.String
    import           Foundation.Numerical
    import           Foundation.Hashing.SipHash
    import           Foundation.Hashing.Hasher

    data GenParams = GenParams
        { GenParams -> Word
    genMaxSizeIntegral :: Word -- maximum number of bytes
        , GenParams -> Word
    genMaxSizeArray    :: Word -- number of elements, as placeholder
        , GenParams -> Word
    genMaxSizeString   :: Word -- maximum number of chars
        }

    newtype GenRng = GenRng XorShift.State

    type GenSeed = Word64

    genRng :: GenSeed -> [String] -> (Word64 -> GenRng)
    genRng :: Word64 -> [String] -> Word64 -> GenRng
    genRng Word64
    seed [String]
    groups = \Word64
    iteration -> State -> GenRng
    GenRng (State -> GenRng) -> State -> GenRng
    forall a b. (a -> b) -> a -> b
    $ Word64 -> Word64 -> State
    XorShift.initialize Word64
    rngSeed (Word64
    rngSeed Word64 -> Word64 -> Word64
    forall a. Multiplicative a => a -> a -> a
    * Word64
    iteration)
      where
        (SipHash Word64
    rngSeed) = Sip1_3 -> HashResult Sip1_3
    forall st. Hasher st => st -> HashResult st
    hashEnd (Sip1_3 -> HashResult Sip1_3) -> Sip1_3 -> HashResult Sip1_3
    forall a b. (a -> b) -> a -> b
    $ UArray Word8 -> Sip1_3 -> Sip1_3
    forall e. PrimType e => UArray e -> Sip1_3 -> Sip1_3
    forall st e. (Hasher st, PrimType e) => UArray e -> st -> st
    hashMixBytes UArray Word8
    hashData Sip1_3
    iHashState
        hashData :: UArray Word8
    hashData = Encoding -> String -> UArray Word8
    toBytes Encoding
    UTF8 (String -> UArray Word8) -> String -> UArray Word8
    forall a b. (a -> b) -> a -> b
    $ Element [String] -> [String] -> Element [String]
    forall c.
    (Sequential c, Monoid (Item c)) =>
    Element c -> c -> Element c
    intercalate String
    Element [String]
    "::" [String]
    groups
        iHashState :: Sip1_3
        iHashState :: Sip1_3
    iHashState = HashInitParam Sip1_3 -> Sip1_3
    forall st. Hasher st => HashInitParam st -> st
    hashNewParam (Word64 -> Word64 -> SipKey
    SipKey Word64
    seed Word64
    0x12345678)

    genGenerator :: GenRng -> (GenRng, GenRng)
    genGenerator :: GenRng -> (GenRng, GenRng)
    genGenerator (GenRng State
    rng) =
        let (Word64
    newSeed1, State
    rngNext) = State -> (Word64, State)
    forall gen. RandomGen gen => gen -> (Word64, gen)
    randomGenerateWord64 State
    rng
            (Word64
    newSeed2, State
    rngNext') = State -> (Word64, State)
    forall gen. RandomGen gen => gen -> (Word64, gen)
    randomGenerateWord64 State
    rngNext
         in (State -> GenRng
    GenRng (State -> GenRng) -> State -> GenRng
    forall a b. (a -> b) -> a -> b
    $ Word64 -> Word64 -> State
    XorShift.initialize Word64
    newSeed1 Word64
    newSeed2, State -> GenRng
    GenRng State
    rngNext')

    -- | Generator monad
    newtype Gen a = Gen { forall a. Gen a -> GenRng -> GenParams -> a
    runGen :: GenRng -> GenParams -> a }

    instance Functor Gen where
        fmap :: forall a b. (a -> b) -> Gen a -> Gen b
    fmap a -> b
    f Gen a
    g = (GenRng -> GenParams -> b) -> Gen b
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen (\GenRng
    rng GenParams
    params -> a -> b
    f (Gen a -> GenRng -> GenParams -> a
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen Gen a
    g GenRng
    rng GenParams
    params))

    instance Applicative Gen where
        pure :: forall a. a -> Gen a
    pure a
    a     = (GenRng -> GenParams -> a) -> Gen a
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen (\GenRng
    _ GenParams
    _ -> a
    a)
        Gen (a -> b)
    fab <*> :: forall a b. Gen (a -> b) -> Gen a -> Gen b
    <*> Gen a
    fa = (GenRng -> GenParams -> b) -> Gen b
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen ((GenRng -> GenParams -> b) -> Gen b)
    -> (GenRng -> GenParams -> b) -> Gen b
    forall a b. (a -> b) -> a -> b
    $ \GenRng
    rng GenParams
    params ->
            let (GenRng
    r1,GenRng
    r2) = GenRng -> (GenRng, GenRng)
    genGenerator GenRng
    rng
                ab :: a -> b
    ab      = Gen (a -> b) -> GenRng -> GenParams -> a -> b
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen Gen (a -> b)
    fab GenRng
    r1 GenParams
    params
                a :: a
    a       = Gen a -> GenRng -> GenParams -> a
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen Gen a
    fa GenRng
    r2 GenParams
    params
             in a -> b
    ab a
    a

    instance Monad Gen where
        return :: forall a. a -> Gen a
    return  = a -> Gen a
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        Gen a
    ma >>= :: forall a b. Gen a -> (a -> Gen b) -> Gen b
    >>= a -> Gen b
    mb = (GenRng -> GenParams -> b) -> Gen b
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen ((GenRng -> GenParams -> b) -> Gen b)
    -> (GenRng -> GenParams -> b) -> Gen b
    forall a b. (a -> b) -> a -> b
    $ \GenRng
    rng GenParams
    params ->
                let (GenRng
    r1,GenRng
    r2) = GenRng -> (GenRng, GenRng)
    genGenerator GenRng
    rng
                    a :: a
    a       = Gen a -> GenRng -> GenParams -> a
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen Gen a
    ma GenRng
    r1 GenParams
    params
                 in Gen b -> GenRng -> GenParams -> b
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen (a -> Gen b
    mb a
    a) GenRng
    r2 GenParams
    params

    genWithRng :: forall a . (forall randomly . MonadRandom randomly => randomly a) -> Gen a
    genWithRng :: forall a.
    (forall (randomly :: * -> *). MonadRandom randomly => randomly a)
    -> Gen a
    genWithRng forall (randomly :: * -> *). MonadRandom randomly => randomly a
    f = (GenRng -> GenParams -> a) -> Gen a
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen ((GenRng -> GenParams -> a) -> Gen a)
    -> (GenRng -> GenParams -> a) -> Gen a
    forall a b. (a -> b) -> a -> b
    $ \(GenRng State
    rng) GenParams
    _ ->
        let (a
    a, State
    _) = State -> MonadRandomState State a -> (a, State)
    forall gen a.
    RandomGen gen =>
    gen -> MonadRandomState gen a -> (a, gen)
    withRandomGenerator State
    rng MonadRandomState State a
    forall (randomly :: * -> *). MonadRandom randomly => randomly a
    f in a
    a

    genWithParams :: (GenParams -> Gen a) -> Gen a
    genWithParams :: forall a. (GenParams -> Gen a) -> Gen a
    genWithParams GenParams -> Gen a
    f = (GenRng -> GenParams -> a) -> Gen a
    forall a. (GenRng -> GenParams -> a) -> Gen a
    Gen ((GenRng -> GenParams -> a) -> Gen a)
    -> (GenRng -> GenParams -> a) -> Gen a
    forall a b. (a -> b) -> a -> b
    $ \GenRng
    rng GenParams
    params -> Gen a -> GenRng -> GenParams -> a
    forall a. Gen a -> GenRng -> GenParams -> a
    runGen (GenParams -> Gen a
    f GenParams
    params) GenRng
    rng GenParams
    params