{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Internal.Test.QuickCheck.Quid
    where

import Control.DeepSeq
    ( NFData )
import Data.Data
    ( Data )
import Data.Hashable
    ( Hashable (..) )
import GHC.Generics
    ( Generic )
import Numeric.Natural
    ( Natural )
import Test.QuickCheck
    ( Arbitrary (..)
    , CoArbitrary (..)
    , Function (..)
    , Gen
    , chooseInteger
    , coarbitraryShow
    , functionMap
    , shrinkMapBy
    , sized
    )
import Test.QuickCheck.Function
    ( (:->) )

import qualified Data.List as L

--------------------------------------------------------------------------------
-- Quids
--------------------------------------------------------------------------------

newtype Quid = Quid
    { Quid -> Natural
unQuid :: Natural }
    deriving (Typeable Quid
Quid -> DataType
Quid -> Constr
(forall b. Data b => b -> b) -> Quid -> Quid
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Quid -> u
forall u. (forall d. Data d => d -> u) -> Quid -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quid
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quid -> c Quid
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quid)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quid)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Quid -> m Quid
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quid -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Quid -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Quid -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Quid -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Quid -> r
gmapT :: (forall b. Data b => b -> b) -> Quid -> Quid
$cgmapT :: (forall b. Data b => b -> b) -> Quid -> Quid
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quid)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Quid)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quid)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Quid)
dataTypeOf :: Quid -> DataType
$cdataTypeOf :: Quid -> DataType
toConstr :: Quid -> Constr
$ctoConstr :: Quid -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quid
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Quid
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quid -> c Quid
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Quid -> c Quid
Data, Quid -> Quid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quid -> Quid -> Bool
$c/= :: Quid -> Quid -> Bool
== :: Quid -> Quid -> Bool
$c== :: Quid -> Quid -> Bool
Eq, forall x. Rep Quid x -> Quid
forall x. Quid -> Rep Quid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Quid x -> Quid
$cfrom :: forall x. Quid -> Rep Quid x
Generic, Eq Quid
Quid -> Quid -> Bool
Quid -> Quid -> Ordering
Quid -> Quid -> Quid
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 :: Quid -> Quid -> Quid
$cmin :: Quid -> Quid -> Quid
max :: Quid -> Quid -> Quid
$cmax :: Quid -> Quid -> Quid
>= :: Quid -> Quid -> Bool
$c>= :: Quid -> Quid -> Bool
> :: Quid -> Quid -> Bool
$c> :: Quid -> Quid -> Bool
<= :: Quid -> Quid -> Bool
$c<= :: Quid -> Quid -> Bool
< :: Quid -> Quid -> Bool
$c< :: Quid -> Quid -> Bool
compare :: Quid -> Quid -> Ordering
$ccompare :: Quid -> Quid -> Ordering
Ord)
    deriving newtype (Eq Quid
Int -> Quid -> Int
Quid -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Quid -> Int
$chash :: Quid -> Int
hashWithSalt :: Int -> Quid -> Int
$chashWithSalt :: Int -> Quid -> Int
Hashable, Quid -> ()
forall a. (a -> ()) -> NFData a
rnf :: Quid -> ()
$crnf :: Quid -> ()
NFData, Integer -> Quid
Quid -> Quid
Quid -> Quid -> Quid
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Quid
$cfromInteger :: Integer -> Quid
signum :: Quid -> Quid
$csignum :: Quid -> Quid
abs :: Quid -> Quid
$cabs :: Quid -> Quid
negate :: Quid -> Quid
$cnegate :: Quid -> Quid
* :: Quid -> Quid -> Quid
$c* :: Quid -> Quid -> Quid
- :: Quid -> Quid -> Quid
$c- :: Quid -> Quid -> Quid
+ :: Quid -> Quid -> Quid
$c+ :: Quid -> Quid -> Quid
Num)

instance Arbitrary Quid where
    arbitrary :: Gen Quid
arbitrary = Gen Quid
arbitraryQuid
    shrink :: Quid -> [Quid]
shrink = Quid -> [Quid]
shrinkQuid

instance CoArbitrary Quid where
    coarbitrary :: forall b. Quid -> Gen b -> Gen b
coarbitrary = forall b. Quid -> Gen b -> Gen b
coarbitraryQuid

instance Function Quid where
    function :: forall b. (Quid -> b) -> Quid :-> b
function = forall b. (Quid -> b) -> Quid :-> b
functionQuid

--------------------------------------------------------------------------------
-- Generation and shrinking of arbitrary quids
--------------------------------------------------------------------------------

arbitraryQuid :: Gen Quid
arbitraryQuid :: Gen Quid
arbitraryQuid = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
i -> (Quid, Quid) -> Gen Quid
chooseQuid (Natural -> Quid
Quid Natural
0, Natural -> Quid
Quid forall a b. (a -> b) -> a -> b
$ (Natural
2 forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Ord a => a -> a -> a
max Int
0 Int
i) forall a. Num a => a -> a -> a
- Natural
1)

chooseQuid :: (Quid, Quid) -> Gen Quid
chooseQuid :: (Quid, Quid) -> Gen Quid
chooseQuid (Quid Natural
n1, Quid Natural
n2) = Natural -> Quid
Quid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural, Natural) -> Gen Natural
chooseNatural (Natural
n1, Natural
n2)

coarbitraryQuid :: Quid -> Gen a -> Gen a
coarbitraryQuid :: forall b. Quid -> Gen b -> Gen b
coarbitraryQuid = forall a b. Show a => a -> Gen b -> Gen b
coarbitraryShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quid -> Natural
unQuid

functionQuid :: (Quid -> a) -> Quid :-> a
functionQuid :: forall b. (Quid -> b) -> Quid :-> b
functionQuid = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quid -> Natural
unQuid) (Natural -> Quid
Quid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read)

shrinkQuid :: Quid -> [Quid]
shrinkQuid :: Quid -> [Quid]
shrinkQuid = forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy Natural -> Quid
Quid Quid -> Natural
unQuid Natural -> [Natural]
shrinkNatural

--------------------------------------------------------------------------------
-- Conversion between quids and natural numbers
--------------------------------------------------------------------------------

naturalToQuid :: Natural -> Quid
naturalToQuid :: Natural -> Quid
naturalToQuid = Natural -> Quid
Quid

quidToNatural :: Quid -> Natural
quidToNatural :: Quid -> Natural
quidToNatural = Quid -> Natural
unQuid

--------------------------------------------------------------------------------
-- Natural number support
--------------------------------------------------------------------------------

chooseNatural :: (Natural, Natural) -> Gen Natural
chooseNatural :: (Natural, Natural) -> Gen Natural
chooseNatural (Natural
p, Natural
q) = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Natural forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Integer, Integer) -> Gen Integer
chooseInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
q)

shrinkNatural :: Natural -> [Natural]
shrinkNatural :: Natural -> [Natural]
shrinkNatural Natural
n
    | Natural
n forall a. Eq a => a -> a -> Bool
== Natural
0 = []
    | Bool
otherwise = forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ Natural
0 forall a. a -> [a] -> [a]
: [Natural]
as forall a. Semigroup a => a -> a -> a
<> [Natural]
bs
  where
    as :: [Natural]
as = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<= Natural
n forall a. Integral a => a -> a -> a
`div` Natural
2) (forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
* Natural
2) Natural
1)
    bs :: [Natural]
bs = (Natural
n forall a. Num a => a -> a -> a
-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
reverse [Natural]
as