{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Wallet.Primitive.Types.UTxOSelection.Gen
    ( genUTxOSelection
    , genUTxOSelectionNonEmpty
    , shrinkUTxOSelection
    , shrinkUTxOSelectionNonEmpty
    )
    where

import Prelude

import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
    ( genUTxOIndex, shrinkUTxOIndex )
import Cardano.Wallet.Primitive.Types.UTxOSelection
    ( UTxOSelection, UTxOSelectionNonEmpty )
import Data.Maybe
    ( mapMaybe )
import Test.QuickCheck
    ( Gen, arbitrary, coarbitrary, liftShrink2, shrinkMapBy, suchThatMap )
import Test.QuickCheck.Extra
    ( genFunction )

import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection

--------------------------------------------------------------------------------
-- Selections that may be empty
--------------------------------------------------------------------------------

coarbitraryUTxO :: Show u => u -> Gen a -> Gen a
coarbitraryUTxO :: u -> Gen a -> Gen a
coarbitraryUTxO = String -> Gen a -> Gen a
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (String -> Gen a -> Gen a) -> (u -> String) -> u -> Gen a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> String
forall a. Show a => a -> String
show

genUTxOFunction :: Show u => Gen a -> Gen (u -> a)
genUTxOFunction :: Gen a -> Gen (u -> a)
genUTxOFunction = (u -> Gen a -> Gen a) -> Gen a -> Gen (u -> a)
forall a b. (a -> Gen b -> Gen b) -> Gen b -> Gen (a -> b)
genFunction u -> Gen a -> Gen a
forall u a. Show u => u -> Gen a -> Gen a
coarbitraryUTxO

genUTxOSelection :: forall u. (Ord u, Show u) => Gen u -> Gen (UTxOSelection u)
genUTxOSelection :: Gen u -> Gen (UTxOSelection u)
genUTxOSelection Gen u
genUTxO = (u -> Bool) -> UTxOIndex u -> UTxOSelection u
forall u. Ord u => (u -> Bool) -> UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndexFiltered
    ((u -> Bool) -> UTxOIndex u -> UTxOSelection u)
-> Gen (u -> Bool) -> Gen (UTxOIndex u -> UTxOSelection u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (u -> Bool)
genUTxOFilter
    Gen (UTxOIndex u -> UTxOSelection u)
-> Gen (UTxOIndex u) -> Gen (UTxOSelection u)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen u -> Gen (UTxOIndex u)
forall u. Ord u => Gen u -> Gen (UTxOIndex u)
genUTxOIndex Gen u
genUTxO
  where
    genUTxOFilter :: Gen (u -> Bool)
    genUTxOFilter :: Gen (u -> Bool)
genUTxOFilter = Gen Bool -> Gen (u -> Bool)
forall u a. Show u => Gen a -> Gen (u -> a)
genUTxOFunction (Arbitrary Bool => Gen Bool
forall a. Arbitrary a => Gen a
arbitrary @Bool)

shrinkUTxOSelection
    :: Ord u => (u -> [u]) -> (UTxOSelection u -> [UTxOSelection u])
shrinkUTxOSelection :: (u -> [u]) -> UTxOSelection u -> [UTxOSelection u]
shrinkUTxOSelection u -> [u]
shrinkUTxO =
    ((UTxOIndex u, UTxOIndex u) -> UTxOSelection u)
-> (UTxOSelection u -> (UTxOIndex u, UTxOIndex u))
-> ((UTxOIndex u, UTxOIndex u) -> [(UTxOIndex u, UTxOIndex u)])
-> UTxOSelection u
-> [UTxOSelection u]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy (UTxOIndex u, UTxOIndex u) -> UTxOSelection u
forall u. Ord u => (UTxOIndex u, UTxOIndex u) -> UTxOSelection u
UTxOSelection.fromIndexPair UTxOSelection u -> (UTxOIndex u, UTxOIndex u)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> (UTxOIndex u, UTxOIndex u)
UTxOSelection.toIndexPair (((UTxOIndex u, UTxOIndex u) -> [(UTxOIndex u, UTxOIndex u)])
 -> UTxOSelection u -> [UTxOSelection u])
-> ((UTxOIndex u, UTxOIndex u) -> [(UTxOIndex u, UTxOIndex u)])
-> UTxOSelection u
-> [UTxOSelection u]
forall a b. (a -> b) -> a -> b
$
        (UTxOIndex u -> [UTxOIndex u])
-> (UTxOIndex u -> [UTxOIndex u])
-> (UTxOIndex u, UTxOIndex u)
-> [(UTxOIndex u, UTxOIndex u)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2
            ((u -> [u]) -> UTxOIndex u -> [UTxOIndex u]
forall u. Ord u => (u -> [u]) -> UTxOIndex u -> [UTxOIndex u]
shrinkUTxOIndex u -> [u]
shrinkUTxO)
            ((u -> [u]) -> UTxOIndex u -> [UTxOIndex u]
forall u. Ord u => (u -> [u]) -> UTxOIndex u -> [UTxOIndex u]
shrinkUTxOIndex u -> [u]
shrinkUTxO)

--------------------------------------------------------------------------------
-- Selections that are non-empty
--------------------------------------------------------------------------------

genUTxOSelectionNonEmpty
    :: (Ord u, Show u) => Gen u -> Gen (UTxOSelectionNonEmpty u)
genUTxOSelectionNonEmpty :: Gen u -> Gen (UTxOSelectionNonEmpty u)
genUTxOSelectionNonEmpty Gen u
genUTxO =
    Gen u -> Gen (UTxOSelection u)
forall u. (Ord u, Show u) => Gen u -> Gen (UTxOSelection u)
genUTxOSelection Gen u
genUTxO Gen (UTxOSelection u)
-> (UTxOSelection u -> Maybe (UTxOSelectionNonEmpty u))
-> Gen (UTxOSelectionNonEmpty u)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` UTxOSelection u -> Maybe (UTxOSelectionNonEmpty u)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Maybe (UTxOSelectionNonEmpty u)
UTxOSelection.toNonEmpty

shrinkUTxOSelectionNonEmpty
    :: Ord u => (u -> [u]) -> (UTxOSelectionNonEmpty u -> [UTxOSelectionNonEmpty u])
shrinkUTxOSelectionNonEmpty :: (u -> [u]) -> UTxOSelectionNonEmpty u -> [UTxOSelectionNonEmpty u]
shrinkUTxOSelectionNonEmpty u -> [u]
shrinkUTxO
    = (UTxOSelection u -> Maybe (UTxOSelectionNonEmpty u))
-> [UTxOSelection u] -> [UTxOSelectionNonEmpty u]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UTxOSelection u -> Maybe (UTxOSelectionNonEmpty u)
forall (s :: * -> *) u.
IsUTxOSelection s u =>
s u -> Maybe (UTxOSelectionNonEmpty u)
UTxOSelection.toNonEmpty
    ([UTxOSelection u] -> [UTxOSelectionNonEmpty u])
-> (UTxOSelectionNonEmpty u -> [UTxOSelection u])
-> UTxOSelectionNonEmpty u
-> [UTxOSelectionNonEmpty u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u -> [u]) -> UTxOSelection u -> [UTxOSelection u]
forall u.
Ord u =>
(u -> [u]) -> UTxOSelection u -> [UTxOSelection u]
shrinkUTxOSelection u -> [u]
shrinkUTxO
    (UTxOSelection u -> [UTxOSelection u])
-> (UTxOSelectionNonEmpty u -> UTxOSelection u)
-> UTxOSelectionNonEmpty u
-> [UTxOSelection u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOSelectionNonEmpty u -> UTxOSelection u
forall u. UTxOSelectionNonEmpty u -> UTxOSelection u
UTxOSelection.fromNonEmpty