{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Algebra.Lattice.Dropped
-- Copyright   :  (C) 2010-2015 Maximilian Bolingbroke, 2015-2019 Oleg Grenrus
-- License     :  BSD-3-Clause (see the file LICENSE)
--
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
----------------------------------------------------------------------------
module Algebra.Lattice.Dropped (
    Dropped(..)
  , retractDropped
  , foldDropped
  ) where

import Prelude ()
import Prelude.Compat

import Algebra.Lattice
import Algebra.PartialOrd

import Control.DeepSeq       (NFData (..))
import Control.Monad         (ap)
import Data.Data             (Data, Typeable)
import Data.Hashable         (Hashable (..))
import Data.Universe.Class   (Finite (..), Universe (..))
import Data.Universe.Helpers (Natural, Tagged, retag)
import GHC.Generics          (Generic, Generic1)

import qualified Test.QuickCheck as QC

--
-- Dropped
--

-- | Graft a distinct top onto an otherwise unbounded lattice.
-- As a bonus, the top will be an absorbing element for the join.
data Dropped a = Drop a
               | Top
  deriving ( Dropped a -> Dropped a -> Bool
forall a. Eq a => Dropped a -> Dropped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dropped a -> Dropped a -> Bool
$c/= :: forall a. Eq a => Dropped a -> Dropped a -> Bool
== :: Dropped a -> Dropped a -> Bool
$c== :: forall a. Eq a => Dropped a -> Dropped a -> Bool
Eq, Dropped a -> Dropped a -> Bool
Dropped a -> Dropped 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 {a}. Ord a => Eq (Dropped a)
forall a. Ord a => Dropped a -> Dropped a -> Bool
forall a. Ord a => Dropped a -> Dropped a -> Ordering
forall a. Ord a => Dropped a -> Dropped a -> Dropped a
min :: Dropped a -> Dropped a -> Dropped a
$cmin :: forall a. Ord a => Dropped a -> Dropped a -> Dropped a
max :: Dropped a -> Dropped a -> Dropped a
$cmax :: forall a. Ord a => Dropped a -> Dropped a -> Dropped a
>= :: Dropped a -> Dropped a -> Bool
$c>= :: forall a. Ord a => Dropped a -> Dropped a -> Bool
> :: Dropped a -> Dropped a -> Bool
$c> :: forall a. Ord a => Dropped a -> Dropped a -> Bool
<= :: Dropped a -> Dropped a -> Bool
$c<= :: forall a. Ord a => Dropped a -> Dropped a -> Bool
< :: Dropped a -> Dropped a -> Bool
$c< :: forall a. Ord a => Dropped a -> Dropped a -> Bool
compare :: Dropped a -> Dropped a -> Ordering
$ccompare :: forall a. Ord a => Dropped a -> Dropped a -> Ordering
Ord, Int -> Dropped a -> ShowS
forall a. Show a => Int -> Dropped a -> ShowS
forall a. Show a => [Dropped a] -> ShowS
forall a. Show a => Dropped a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dropped a] -> ShowS
$cshowList :: forall a. Show a => [Dropped a] -> ShowS
show :: Dropped a -> String
$cshow :: forall a. Show a => Dropped a -> String
showsPrec :: Int -> Dropped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Dropped a -> ShowS
Show, ReadPrec [Dropped a]
ReadPrec (Dropped a)
ReadS [Dropped a]
forall a. Read a => ReadPrec [Dropped a]
forall a. Read a => ReadPrec (Dropped a)
forall a. Read a => Int -> ReadS (Dropped a)
forall a. Read a => ReadS [Dropped a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dropped a]
$creadListPrec :: forall a. Read a => ReadPrec [Dropped a]
readPrec :: ReadPrec (Dropped a)
$creadPrec :: forall a. Read a => ReadPrec (Dropped a)
readList :: ReadS [Dropped a]
$creadList :: forall a. Read a => ReadS [Dropped a]
readsPrec :: Int -> ReadS (Dropped a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Dropped a)
Read, Dropped a -> DataType
Dropped a -> Constr
forall {a}. Data a => Typeable (Dropped a)
forall a. Data a => Dropped a -> DataType
forall a. Data a => Dropped a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Dropped a -> Dropped a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Dropped a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Dropped a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Dropped a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dropped a -> c (Dropped a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Dropped a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Dropped a))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Dropped a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dropped a -> c (Dropped a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Dropped a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Dropped a -> m (Dropped a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dropped a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Dropped a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Dropped a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Dropped a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dropped a -> r
gmapT :: (forall b. Data b => b -> b) -> Dropped a -> Dropped a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Dropped a -> Dropped a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Dropped a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Dropped a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Dropped a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Dropped a))
dataTypeOf :: Dropped a -> DataType
$cdataTypeOf :: forall a. Data a => Dropped a -> DataType
toConstr :: Dropped a -> Constr
$ctoConstr :: forall a. Data a => Dropped a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Dropped a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Dropped a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dropped a -> c (Dropped a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dropped a -> c (Dropped a)
Data, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Dropped a) x -> Dropped a
forall a x. Dropped a -> Rep (Dropped a) x
$cto :: forall a x. Rep (Dropped a) x -> Dropped a
$cfrom :: forall a x. Dropped a -> Rep (Dropped a) x
Generic, forall a b. a -> Dropped b -> Dropped a
forall a b. (a -> b) -> Dropped a -> Dropped b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Dropped b -> Dropped a
$c<$ :: forall a b. a -> Dropped b -> Dropped a
fmap :: forall a b. (a -> b) -> Dropped a -> Dropped b
$cfmap :: forall a b. (a -> b) -> Dropped a -> Dropped b
Functor, forall a. Eq a => a -> Dropped a -> Bool
forall a. Num a => Dropped a -> a
forall a. Ord a => Dropped a -> a
forall m. Monoid m => Dropped m -> m
forall a. Dropped a -> Bool
forall a. Dropped a -> Int
forall a. Dropped a -> [a]
forall a. (a -> a -> a) -> Dropped a -> a
forall m a. Monoid m => (a -> m) -> Dropped a -> m
forall b a. (b -> a -> b) -> b -> Dropped a -> b
forall a b. (a -> b -> b) -> b -> Dropped a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Dropped a -> a
$cproduct :: forall a. Num a => Dropped a -> a
sum :: forall a. Num a => Dropped a -> a
$csum :: forall a. Num a => Dropped a -> a
minimum :: forall a. Ord a => Dropped a -> a
$cminimum :: forall a. Ord a => Dropped a -> a
maximum :: forall a. Ord a => Dropped a -> a
$cmaximum :: forall a. Ord a => Dropped a -> a
elem :: forall a. Eq a => a -> Dropped a -> Bool
$celem :: forall a. Eq a => a -> Dropped a -> Bool
length :: forall a. Dropped a -> Int
$clength :: forall a. Dropped a -> Int
null :: forall a. Dropped a -> Bool
$cnull :: forall a. Dropped a -> Bool
toList :: forall a. Dropped a -> [a]
$ctoList :: forall a. Dropped a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Dropped a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Dropped a -> a
foldr1 :: forall a. (a -> a -> a) -> Dropped a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Dropped a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Dropped a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Dropped a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Dropped a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Dropped a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Dropped a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Dropped a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Dropped a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Dropped a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Dropped a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Dropped a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Dropped a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Dropped a -> m
fold :: forall m. Monoid m => Dropped m -> m
$cfold :: forall m. Monoid m => Dropped m -> m
Foldable, Functor Dropped
Foldable Dropped
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Dropped (m a) -> m (Dropped a)
forall (f :: * -> *) a.
Applicative f =>
Dropped (f a) -> f (Dropped a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Dropped a -> m (Dropped b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dropped a -> f (Dropped b)
sequence :: forall (m :: * -> *) a. Monad m => Dropped (m a) -> m (Dropped a)
$csequence :: forall (m :: * -> *) a. Monad m => Dropped (m a) -> m (Dropped a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Dropped a -> m (Dropped b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Dropped a -> m (Dropped b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Dropped (f a) -> f (Dropped a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Dropped (f a) -> f (Dropped a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dropped a -> f (Dropped b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Dropped a -> f (Dropped b)
Traversable
           , forall a. Rep1 Dropped a -> Dropped a
forall a. Dropped a -> Rep1 Dropped a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Dropped a -> Dropped a
$cfrom1 :: forall a. Dropped a -> Rep1 Dropped a
Generic1
           )

instance Applicative Dropped where
  pure :: forall a. a -> Dropped a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b. Dropped (a -> b) -> Dropped a -> Dropped b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Dropped where
  return :: forall a. a -> Dropped a
return        = forall a. a -> Dropped a
Drop
  Dropped a
Top >>= :: forall a b. Dropped a -> (a -> Dropped b) -> Dropped b
>>= a -> Dropped b
_     = forall a. Dropped a
Top
  Drop a
x >>= a -> Dropped b
f  = a -> Dropped b
f a
x

instance NFData a => NFData (Dropped a) where
  rnf :: Dropped a -> ()
rnf Dropped a
Top      = ()
  rnf (Drop a
a) = forall a. NFData a => a -> ()
rnf a
a

instance Hashable a => Hashable (Dropped a)

instance PartialOrd a => PartialOrd (Dropped a) where
  leq :: Dropped a -> Dropped a -> Bool
leq Dropped a
_ Dropped a
Top = Bool
True
  leq Dropped a
Top Dropped a
_ = Bool
False
  leq (Drop a
x) (Drop a
y) = forall a. PartialOrd a => a -> a -> Bool
leq a
x a
y
  comparable :: Dropped a -> Dropped a -> Bool
comparable Dropped a
Top Dropped a
_ = Bool
True
  comparable Dropped a
_ Dropped a
Top = Bool
True
  comparable (Drop a
x) (Drop a
y) = forall a. PartialOrd a => a -> a -> Bool
comparable a
x a
y

instance Lattice a => Lattice (Dropped a) where
    Dropped a
Top    \/ :: Dropped a -> Dropped a -> Dropped a
\/ Dropped a
_      = forall a. Dropped a
Top
    Dropped a
_      \/ Dropped a
Top    = forall a. Dropped a
Top
    Drop a
x \/ Drop a
y = forall a. a -> Dropped a
Drop (a
x forall a. Lattice a => a -> a -> a
\/ a
y)

    Dropped a
Top    /\ :: Dropped a -> Dropped a -> Dropped a
/\ Dropped a
drop_y = Dropped a
drop_y
    Dropped a
drop_x /\ Dropped a
Top    = Dropped a
drop_x
    Drop a
x /\ Drop a
y = forall a. a -> Dropped a
Drop (a
x forall a. Lattice a => a -> a -> a
/\ a
y)

instance BoundedJoinSemiLattice a => BoundedJoinSemiLattice (Dropped a) where
    bottom :: Dropped a
bottom = forall a. a -> Dropped a
Drop forall a. BoundedJoinSemiLattice a => a
bottom

instance Lattice a => BoundedMeetSemiLattice (Dropped a) where
    top :: Dropped a
top = forall a. Dropped a
Top

-- | Interpret @'Dropped' a@ using the 'BoundedMeetSemiLattice' of @a@.
retractDropped :: BoundedMeetSemiLattice a => Dropped a -> a
retractDropped :: forall a. BoundedMeetSemiLattice a => Dropped a -> a
retractDropped = forall b a. b -> (a -> b) -> Dropped a -> b
foldDropped forall a. BoundedMeetSemiLattice a => a
top forall a. a -> a
id

-- | Similar to @'maybe'@, but for @'Dropped'@ type.
foldDropped :: b -> (a -> b) -> Dropped a -> b
foldDropped :: forall b a. b -> (a -> b) -> Dropped a -> b
foldDropped b
_ a -> b
f (Drop a
x) = a -> b
f a
x
foldDropped b
y a -> b
_ Dropped a
Top      = b
y

instance Universe a => Universe (Dropped a) where
    universe :: [Dropped a]
universe = forall a. Dropped a
Top forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Dropped a
Drop forall a. Universe a => [a]
universe
instance Finite a => Finite (Dropped a) where
    universeF :: [Dropped a]
universeF = forall a. Dropped a
Top forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Dropped a
Drop forall a. Finite a => [a]
universeF
    cardinality :: Tagged (Dropped a) Natural
cardinality = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Enum a => a -> a
succ (forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (forall a. Finite a => Tagged a Natural
cardinality :: Tagged a Natural))

instance QC.Arbitrary a => QC.Arbitrary (Dropped a) where
    arbitrary :: Gen (Dropped a)
arbitrary = forall a. [(Int, Gen a)] -> Gen a
QC.frequency
        [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Dropped a
Top)
        , (Int
9, forall a. a -> Dropped a
Drop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary)
        ]

    shrink :: Dropped a -> [Dropped a]
shrink Dropped a
Top      = []
    shrink (Drop a
x) = forall a. Dropped a
Top forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Dropped a
Drop (forall a. Arbitrary a => a -> [a]
QC.shrink a
x)

instance QC.CoArbitrary a => QC.CoArbitrary (Dropped a) where
    coarbitrary :: forall b. Dropped a -> Gen b -> Gen b
coarbitrary Dropped a
Top      = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
0 :: Int)
    coarbitrary (Drop a
x) = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
1 :: Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary a
x

instance QC.Function a => QC.Function (Dropped a) where
    function :: forall b. (Dropped a -> b) -> Dropped a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap forall {a}. Dropped a -> Maybe a
fromDropped forall {a}. Maybe a -> Dropped a
toDropped where
        fromDropped :: Dropped a -> Maybe a
fromDropped = forall b a. b -> (a -> b) -> Dropped a -> b
foldDropped forall a. Maybe a
Nothing forall a. a -> Maybe a
Just
        toDropped :: Maybe a -> Dropped a
toDropped   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Dropped a
Top forall a. a -> Dropped a
Drop