-- | Marked elements
--
-- Intended for unqualified import.
module Data.Falsify.Marked (
    Mark(..)
  , Marked(..)
    -- * Generation
  , selectAllKept
    -- * Queries
  , countKept
  , shouldKeep
  ) where

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

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

data Mark = Keep | Drop
  deriving stock (Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mark] -> ShowS
$cshowList :: [Mark] -> ShowS
show :: Mark -> String
$cshow :: Mark -> String
showsPrec :: Int -> Mark -> ShowS
$cshowsPrec :: Int -> Mark -> ShowS
Show, Mark -> Mark -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c== :: Mark -> Mark -> Bool
Eq, Eq 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
min :: Mark -> Mark -> Mark
$cmin :: Mark -> Mark -> Mark
max :: Mark -> Mark -> Mark
$cmax :: Mark -> Mark -> Mark
>= :: Mark -> Mark -> Bool
$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
compare :: Mark -> Mark -> Ordering
$ccompare :: Mark -> Mark -> Ordering
Ord)

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
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
showList :: [Marked f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Marked f a] -> ShowS
show :: Marked f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => Marked f a -> String
showsPrec :: Int -> Marked f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Marked f a -> ShowS
Show, Marked f a -> Marked f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
Marked f a -> Marked f a -> Bool
Eq, Marked f a -> Marked f a -> Bool
Marked f a -> Marked f a -> Ordering
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
min :: 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
max :: Marked f a -> Marked f a -> Marked f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Marked f a
>= :: 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
$c< :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Bool
compare :: Marked f a -> Marked f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
Marked f a -> Marked f a -> Ordering
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) =
    forall (f :: * -> *) a. Selective f => f Bool -> f a -> f a -> f a
ifS (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Mark
mark forall a. Eq a => a -> a -> Bool
== Mark
Keep)
        (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
gen)
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (f :: * -> *) a. Selective f => Marked f a -> f (Maybe a)
selectKept

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

countKept :: Foldable t => t (Marked f a) -> Word
countKept :: forall (t :: * -> *) (f :: * -> *) a.
Foldable t =>
t (Marked f a) -> Word
countKept = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (f :: * -> *) a. Marked f a -> Maybe (f a)
shouldKeep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

shouldKeep :: Marked f a -> Maybe (f a)
shouldKeep :: forall (f :: * -> *) a. Marked f a -> Maybe (f a)
shouldKeep (Marked Mark
Keep f a
x) = forall a. a -> Maybe a
Just f a
x
shouldKeep (Marked Mark
Drop f a
_) = forall a. Maybe a
Nothing