module Algebra.Lattice.Levitated (
Levitated(..)
) where
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
import Algebra.Lattice
#if MIN_VERSION_base(4,8,0)
#else
import Data.Monoid (Monoid(..))
import Data.Foldable
import Data.Traversable
#endif
import Control.Applicative
import Control.DeepSeq
import Data.Data
import Data.Hashable
import GHC.Generics
data Levitated a = Top
| Levitate a
| Bottom
deriving ( Eq, Ord, Show, Read, Data, Typeable, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
instance Functor Levitated where
fmap _ Bottom = Bottom
fmap _ Top = Top
fmap f (Levitate a) = Levitate (f a)
instance Foldable Levitated where
foldMap _ Bottom = mempty
foldMap _ Top = mempty
foldMap f (Levitate a) = f a
instance Traversable Levitated where
traverse _ Bottom = pure Bottom
traverse _ Top = pure Top
traverse f (Levitate a) = Levitate <$> f a
instance NFData a => NFData (Levitated a) where
rnf Top = ()
rnf Bottom = ()
rnf (Levitate a) = rnf a
instance Hashable a => Hashable (Levitated a)
instance JoinSemiLattice a => JoinSemiLattice (Levitated a) where
Top `join` _ = Top
_ `join` Top = Top
Levitate x `join` Levitate y = Levitate (x `join` y)
Bottom `join` lev_y = lev_y
lev_x `join` Bottom = lev_x
instance MeetSemiLattice a => MeetSemiLattice (Levitated a) where
Top `meet` lev_y = lev_y
lev_x `meet` Top = lev_x
Levitate x `meet` Levitate y = Levitate (x `meet` y)
Bottom `meet` _ = Bottom
_ `meet` Bottom = Bottom
instance Lattice a => Lattice (Levitated a) where
instance JoinSemiLattice a => BoundedJoinSemiLattice (Levitated a) where
bottom = Bottom
instance MeetSemiLattice a => BoundedMeetSemiLattice (Levitated a) where
top = Top
instance Lattice a => BoundedLattice (Levitated a) where