{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module        : Test.QuickCheck.Instances.Sized
-- Copyright     : Gautier DI FOLCO
-- License       : BSD2
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : GHC
--
-- QuickCheck's 'Arbitrary' instance for 'Sized'.
module Test.QuickCheck.Instances.Sized
  ( Arbitrary (..),
    ArbitrarySized (..),
    ArbitraryBuiltSized (..),
  )
where

import Control.Monad
import Data.Maybe (maybeToList)
import Data.Proxy
import Data.Sized
import GHC.TypeLits
import Test.QuickCheck hiding (sized)

instance
  ( Size s,
    SizedFromContainer a,
    Arbitrary a,
    ArbitraryBuiltSized a,
    ArbitrarySized s
  ) =>
  Arbitrary (Sized s a)
  where
  arbitrary :: Gen (Sized s a)
arbitrary = Proxy s -> Gen Int
forall a. ArbitrarySized a => Proxy a -> Gen Int
arbitrarySized (Proxy s
forall k (t :: k). Proxy t
Proxy @s) Gen Int -> (Int -> Gen (Sized s a)) -> Gen (Sized s a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Sized s a) -> Gen a -> Gen (Sized s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sized s a
forall a s. a -> Sized s a
trustedSized (Gen a -> Gen (Sized s a))
-> (Int -> Gen a) -> Int -> Gen (Sized s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen a
forall a. ArbitraryBuiltSized a => Int -> Gen a
buildSized

  shrink :: Sized s a -> [Sized s a]
shrink Sized s a
xs =
    [ Sized s a
xs''
      | a
xs' <- a -> [a]
forall a. Arbitrary a => a -> [a]
shrink (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ Sized s a -> a
forall s a. Sized s a -> a
getSized Sized s a
xs,
        Sized s a
xs'' <- Maybe (Sized s a) -> [Sized s a]
forall a. Maybe a -> [a]
maybeToList (Maybe (Sized s a) -> [Sized s a])
-> Maybe (Sized s a) -> [Sized s a]
forall a b. (a -> b) -> a -> b
$ a -> Maybe (Sized s a)
forall s a.
(Size s, SizedFromContainer a) =>
a -> Maybe (Sized s a)
sized a
xs'
    ]

class ArbitrarySized a where
  arbitrarySized :: Proxy a -> Gen Int

instance ArbitrarySized Unknown where
  arbitrarySized :: Proxy Unknown -> Gen Int
arbitrarySized Proxy Unknown
_ = (Int, Int) -> Gen Int
chooseInt (Int
0, Int
forall a. Bounded a => a
maxBound)

instance KnownNat n => ArbitrarySized (AtLeast n) where
  arbitrarySized :: Proxy (AtLeast n) -> Gen Int
arbitrarySized Proxy (AtLeast n)
_ = (Int, Int) -> Gen Int
chooseInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n, Int
forall a. Bounded a => a
maxBound)

instance KnownNat n => ArbitrarySized (AtMost n) where
  arbitrarySized :: Proxy (AtMost n) -> Gen Int
arbitrarySized Proxy (AtMost n)
_ = (Int, Int) -> Gen Int
chooseInt (Int
0, Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n)

instance KnownNat n => ArbitrarySized (Exactly n) where
  arbitrarySized :: Proxy (Exactly n) -> Gen Int
arbitrarySized Proxy (Exactly n)
_ = Int -> Gen Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Gen Int) -> Int -> Gen Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n

instance (KnownNat n, KnownNat m) => ArbitrarySized (Between n m) where
  arbitrarySized :: Proxy (Between n m) -> Gen Int
arbitrarySized Proxy (Between n m)
_ = (Int, Int) -> Gen Int
chooseInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n, Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy m -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy m -> Integer) -> Proxy m -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy m
forall k (t :: k). Proxy t
Proxy @m)

class ArbitraryBuiltSized a where
  buildSized :: Int -> Gen a

instance Arbitrary a => ArbitraryBuiltSized [a] where
  buildSized :: Int -> Gen [a]
buildSized Int
n = Int -> Gen a -> Gen [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen a
forall a. Arbitrary a => Gen a
arbitrary