{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Algebra.Lattice.Lifted
-- 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.Lifted (
    Lifted(..)
  , retractLifted
  , foldLifted
  ) 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

--
-- Lifted
--

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

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

instance Monad Lifted where
  return :: forall a. a -> Lifted a
return        = forall a. a -> Lifted a
Lift
  Lifted a
Bottom >>= :: forall a b. Lifted a -> (a -> Lifted b) -> Lifted b
>>= a -> Lifted b
_  = forall a. Lifted a
Bottom
  Lift a
x >>= a -> Lifted b
f  = a -> Lifted b
f a
x

instance NFData a => NFData (Lifted a) where
  rnf :: Lifted a -> ()
rnf Lifted a
Bottom   = ()
  rnf (Lift a
a) = forall a. NFData a => a -> ()
rnf a
a

instance Hashable a => Hashable (Lifted a)

instance PartialOrd a => PartialOrd (Lifted a) where
  leq :: Lifted a -> Lifted a -> Bool
leq Lifted a
Bottom Lifted a
_ = Bool
True
  leq Lifted a
_ Lifted a
Bottom = Bool
False
  leq (Lift a
x) (Lift a
y) = forall a. PartialOrd a => a -> a -> Bool
leq a
x a
y
  comparable :: Lifted a -> Lifted a -> Bool
comparable Lifted a
Bottom Lifted a
_ = Bool
True
  comparable Lifted a
_ Lifted a
Bottom = Bool
True
  comparable (Lift a
x) (Lift a
y) = forall a. PartialOrd a => a -> a -> Bool
comparable a
x a
y

instance Lattice a => Lattice (Lifted a) where
    Lift a
x \/ :: Lifted a -> Lifted a -> Lifted a
\/ Lift a
y = forall a. a -> Lifted a
Lift (a
x forall a. Lattice a => a -> a -> a
\/ a
y)
    Lifted a
Bottom \/ Lifted a
lift_y = Lifted a
lift_y
    Lifted a
lift_x \/ Lifted a
Bottom = Lifted a
lift_x

    Lift a
x /\ :: Lifted a -> Lifted a -> Lifted a
/\ Lift a
y = forall a. a -> Lifted a
Lift (a
x forall a. Lattice a => a -> a -> a
/\ a
y)
    Lifted a
Bottom /\ Lifted a
_      = forall a. Lifted a
Bottom
    Lifted a
_      /\ Lifted a
Bottom = forall a. Lifted a
Bottom

instance Lattice a => BoundedJoinSemiLattice (Lifted a) where
    bottom :: Lifted a
bottom = forall a. Lifted a
Bottom

instance BoundedMeetSemiLattice a => BoundedMeetSemiLattice (Lifted a) where
    top :: Lifted a
top = forall a. a -> Lifted a
Lift forall a. BoundedMeetSemiLattice a => a
top

-- | Interpret @'Lifted' a@ using the 'BoundedJoinSemiLattice' of @a@.
retractLifted :: BoundedJoinSemiLattice a => Lifted a -> a
retractLifted :: forall a. BoundedJoinSemiLattice a => Lifted a -> a
retractLifted = forall b a. b -> (a -> b) -> Lifted a -> b
foldLifted forall a. BoundedJoinSemiLattice a => a
bottom forall a. a -> a
id

-- | Similar to @'maybe'@, but for @'Lifted'@ type.
foldLifted :: b -> (a -> b) -> Lifted a -> b
foldLifted :: forall b a. b -> (a -> b) -> Lifted a -> b
foldLifted b
_ a -> b
f (Lift a
x) = a -> b
f a
x
foldLifted b
y a -> b
_ Lifted a
Bottom   = b
y

instance Universe a => Universe (Lifted a) where
    universe :: [Lifted a]
universe = forall a. Lifted a
Bottom forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Lifted a
Lift forall a. Universe a => [a]
universe
instance Finite a => Finite (Lifted a) where
    universeF :: [Lifted a]
universeF = forall a. Lifted a
Bottom forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Lifted a
Lift forall a. Finite a => [a]
universeF
    cardinality :: Tagged (Lifted 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 (Lifted a) where
    arbitrary :: Gen (Lifted a)
arbitrary = forall a. [(Int, Gen a)] -> Gen a
QC.frequency
        [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Lifted a
Bottom)
        , (Int
9, forall a. a -> Lifted a
Lift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary)
        ]
    shrink :: Lifted a -> [Lifted a]
shrink Lifted a
Bottom   = []
    shrink (Lift a
x) = forall a. Lifted a
Bottom forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Lifted a
Lift (forall a. Arbitrary a => a -> [a]
QC.shrink a
x)

instance QC.CoArbitrary a => QC.CoArbitrary (Lifted a) where
    coarbitrary :: forall b. Lifted a -> Gen b -> Gen b
coarbitrary Lifted a
Bottom      = forall n a. Integral n => n -> Gen a -> Gen a
QC.variant (Int
0 :: Int)
    coarbitrary (Lift 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 (Lifted a) where
    function :: forall b. (Lifted a -> b) -> Lifted a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap forall {a}. Lifted a -> Maybe a
fromLifted forall {a}. Maybe a -> Lifted a
toLifted where
        fromLifted :: Lifted a -> Maybe a
fromLifted = forall b a. b -> (a -> b) -> Lifted a -> b
foldLifted forall a. Maybe a
Nothing forall a. a -> Maybe a
Just
        toLifted :: Maybe a -> Lifted a
toLifted   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Lifted a
Bottom forall a. a -> Lifted a
Lift