{-# LANGUAGE LambdaCase #-}

module Hedgehog.Classes.Common.Bottom
  ( Bottom(..), genBottom
  ) where

import Hedgehog
import qualified Hedgehog.Gen as Gen
 
data Bottom a = BottomUndefined | BottomValue a
  deriving (Bottom a -> Bottom a -> Bool
(Bottom a -> Bottom a -> Bool)
-> (Bottom a -> Bottom a -> Bool) -> Eq (Bottom a)
forall a. Eq a => Bottom a -> Bottom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bottom a -> Bottom a -> Bool
$c/= :: forall a. Eq a => Bottom a -> Bottom a -> Bool
== :: Bottom a -> Bottom a -> Bool
$c== :: forall a. Eq a => Bottom a -> Bottom a -> Bool
Eq)

instance Show a => Show (Bottom a) where
  show :: Bottom a -> String
show = \case
    Bottom a
BottomUndefined -> String
"undefined"
    BottomValue a
a   -> a -> String
forall a. Show a => a -> String
show a
a

genBottom :: Gen a -> Gen (Bottom a)
genBottom :: Gen a -> Gen (Bottom a)
genBottom = (Maybe a -> Bottom a) -> GenT Identity (Maybe a) -> Gen (Bottom a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bottom a
forall a. Maybe a -> Bottom a
maybeToBottom (GenT Identity (Maybe a) -> Gen (Bottom a))
-> (Gen a -> GenT Identity (Maybe a)) -> Gen a -> Gen (Bottom a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen a -> GenT Identity (Maybe a)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe

maybeToBottom :: Maybe a -> Bottom a
maybeToBottom :: Maybe a -> Bottom a
maybeToBottom = \case { Maybe a
Nothing -> Bottom a
forall a. Bottom a
BottomUndefined; Just a
a -> a -> Bottom a
forall a. a -> Bottom a
BottomValue a
a }