-- | Marked elements
--
-- Intended for qualified import.
--
-- > import Test.Falsify
-- > import qualified Test.Falsify.Marked as Marked
module Test.Falsify.Marked (
    Mark(..)
  , Marked(..)
    -- * Generation
  , selectAllKept
    -- * Queries
  , countKept
  , shouldKeep
  ) where

import Control.Selective
import Data.Foldable (toList)
import Data.Maybe (mapMaybe)

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Should an element in a container be kept or dropped?
--
-- See also t'Marked'.
data Mark = Keep | Drop
  deriving stock (Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
(Int -> Mark -> ShowS)
-> (Mark -> String) -> ([Mark] -> ShowS) -> Show Mark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mark -> ShowS
showsPrec :: Int -> Mark -> ShowS
$cshow :: Mark -> String
show :: Mark -> String
$cshowList :: [Mark] -> ShowS
showList :: [Mark] -> ShowS
Show, Mark -> Mark -> Bool
(Mark -> Mark -> Bool) -> (Mark -> Mark -> Bool) -> Eq Mark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
/= :: Mark -> Mark -> Bool
Eq, Eq Mark
Eq Mark =>
(Mark -> Mark -> Ordering)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Mark)
-> (Mark -> Mark -> Mark)
-> Ord Mark
Mark -> Mark -> Bool
Mark -> Mark -> Ordering
Mark -> Mark -> Mark
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
$ccompare :: Mark -> Mark -> Ordering
compare :: Mark -> Mark -> Ordering
$c< :: Mark -> Mark -> Bool
< :: Mark -> Mark -> Bool
$c<= :: Mark -> Mark -> Bool
<= :: Mark -> Mark -> Bool
$c> :: Mark -> Mark -> Bool
> :: Mark -> Mark -> Bool
$c>= :: Mark -> Mark -> Bool
>= :: Mark -> Mark -> Bool
$cmax :: Mark -> Mark -> Mark
max :: Mark -> Mark -> Mark
$cmin :: Mark -> Mark -> Mark
min :: Mark -> Mark -> Mark
Ord)

-- | Marked element in a container
--
-- Marking elements can be a useful technique for dropping elements from a
-- container.
--
-- * Locally marking elements to 'Drop' makes it possible to enforce some global
--   constraints about minimum number of required elements before /actually/
--   dropping them (see 'selectAllKept').
--   Example: 'Test.Falsify.Generator.list'.
--
-- * For containers where we cannot remove random elements, the marks can be
--   used for \"outwards propagation\": if /this/ element is dropped, then
--   /those/ elements must also be dropped.
--   Example: 'Test.Falsify.Generator.tree'.
data Marked f a = Marked {
      forall (f :: * -> *) a. Marked f a -> Mark
getMark :: Mark
    , forall (f :: * -> *) a. Marked f a -> f a
unmark  :: f a
    }
  deriving stock (Int -> Marked f a -> ShowS
[Marked f a] -> ShowS
Marked f a -> String
(Int -> Marked f a -> ShowS)
-> (Marked f a -> String)
-> ([Marked f a] -> ShowS)
-> Show (Marked f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> Marked f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [Marked f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => Marked f a -> String
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Marked f a -> ShowS
showsPrec :: Int -> Marked f a -> ShowS
$cshow :: forall (f :: * -> *) a. Show (f a) => Marked f a -> String
show :: Marked f a -> String
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Marked f a] -> ShowS
showList :: [Marked f a] -> ShowS
Show, Marked f a -> Marked f a -> Bool
(Marked f a -> Marked f a -> Bool)
-> (Marked f a -> Marked f a -> Bool) -> Eq (Marked f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
Eq (f a) =>
Marked f a -> Marked f a -> Bool
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
Marked f a -> Marked f a -> Bool
== :: Marked f a -> Marked f a -> Bool
$c/= :: forall (f :: * -> *) a.
Eq (f a) =>
Marked f a -> Marked f a -> Bool
/= :: Marked f a -> Marked f a -> Bool
Eq, Eq (Marked f a)
Eq (Marked f a) =>
(Marked f a -> Marked f a -> Ordering)
-> (Marked f a -> Marked f a -> Bool)
-> (Marked f a -> Marked f a -> Bool)
-> (Marked f a -> Marked f a -> Bool)
-> (Marked f a -> Marked f a -> Bool)
-> (Marked f a -> Marked f a -> Marked f a)
-> (Marked f a -> Marked f a -> Marked f a)
-> Ord (Marked f a)
Marked f a -> Marked f a -> Bool
Marked f a -> Marked f a -> Ordering
Marked f a -> Marked f a -> Marked f a
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
forall (f :: * -> *) a. Ord (f a) => Eq (Marked f a)
forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Marked f a
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Ordering
compare :: Marked f a -> Marked f a -> Ordering
$c< :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
< :: Marked f a -> Marked f a -> Bool
$c<= :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
<= :: Marked f a -> Marked f a -> Bool
$c> :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
> :: Marked f a -> Marked f a -> Bool
$c>= :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
>= :: Marked f a -> Marked f a -> Bool
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Marked f a
max :: Marked f a -> Marked f a -> Marked f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Marked f a
min :: Marked f a -> Marked f a -> Marked f a
Ord)

{-------------------------------------------------------------------------------
  Generation
-------------------------------------------------------------------------------}

selectKept :: Selective f => Marked f a -> f (Maybe a)
selectKept :: forall (f :: * -> *) a. Selective f => Marked f a -> f (Maybe a)
selectKept (Marked Mark
mark f a
gen) =
    f Bool -> f (Maybe a) -> f (Maybe a) -> f (Maybe a)
forall (f :: * -> *) a. Selective f => f Bool -> f a -> f a -> f a
ifS (Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool) -> Bool -> f Bool
forall a b. (a -> b) -> a -> b
$ Mark
mark Mark -> Mark -> Bool
forall a. Eq a => a -> a -> Bool
== Mark
Keep)
        (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
gen)
        (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

-- | Traverse the argument, generating all values marked 'Keep', and replacing
-- all values marked 'Drop' by 'Nothing'
selectAllKept ::
     (Traversable t, Selective f)
  => t (Marked f a) -> f (t (Maybe a))
selectAllKept :: forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Selective f) =>
t (Marked f a) -> f (t (Maybe a))
selectAllKept = (Marked f a -> f (Maybe a)) -> t (Marked f a) -> f (t (Maybe a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse Marked f a -> f (Maybe a)
forall (f :: * -> *) a. Selective f => Marked f a -> f (Maybe a)
selectKept

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

-- | Count how many elements will be kept
countKept :: Foldable t => t (Marked f a) -> Word
countKept :: forall (t :: * -> *) (f :: * -> *) a.
Foldable t =>
t (Marked f a) -> Word
countKept = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (t (Marked f a) -> Int) -> t (Marked f a) -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [f a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([f a] -> Int)
-> (t (Marked f a) -> [f a]) -> t (Marked f a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Marked f a -> Maybe (f a)) -> [Marked f a] -> [f a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Marked f a -> Maybe (f a)
forall (f :: * -> *) a. Marked f a -> Maybe (f a)
shouldKeep ([Marked f a] -> [f a])
-> (t (Marked f a) -> [Marked f a]) -> t (Marked f a) -> [f a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Marked f a) -> [Marked f a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | The element /if/ it should be kept
shouldKeep :: Marked f a -> Maybe (f a)
shouldKeep :: forall (f :: * -> *) a. Marked f a -> Maybe (f a)
shouldKeep (Marked Mark
Keep f a
x) = f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
x
shouldKeep (Marked Mark
Drop f a
_) = Maybe (f a)
forall a. Maybe a
Nothing