{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

-- | [Lattices](https://en.wikipedia.org/wiki/Lattice_(order\))
module NumHask.Algebra.Lattice
  ( JoinSemiLattice (..),
    joinLeq,
    MeetSemiLattice (..),
    meetLeq,
    BoundedJoinSemiLattice (..),
    BoundedMeetSemiLattice (..),
  )
where

import Data.Bool
import Data.Eq
import Data.Function (const)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Ord (Ord (..))
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Enum (Bounded (..))
import GHC.Float (Double, Float)
import GHC.Int (Int)
import GHC.Natural (Natural (..))
import GHC.Num (Integer)
import GHC.Word (Word)
import NumHask.Algebra.Additive (zero)
import NumHask.Algebra.Field

-- | A algebraic structure with element joins: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice)
--
-- > Associativity: x \/ (y \/ z) == (x \/ y) \/ z
-- > Commutativity: x \/ y == y \/ x
-- > Idempotency:   x \/ x == x
class (Eq a) => JoinSemiLattice a where
  infixr 5 \/
  (\/) :: a -> a -> a

-- | The partial ordering induced by the join-semilattice structure
joinLeq :: (JoinSemiLattice a) => a -> a -> Bool
joinLeq :: a -> a -> Bool
joinLeq a
x a
y = (a
x a -> a -> a
forall a. JoinSemiLattice a => a -> a -> a
\/ a
y) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

-- | A algebraic structure with element meets: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice)
--
-- > Associativity: x /\ (y /\ z) == (x /\ y) /\ z
-- > Commutativity: x /\ y == y /\ x
-- > Idempotency:   x /\ x == x
class (Eq a) => MeetSemiLattice a where
  infixr 6 /\
  (/\) :: a -> a -> a

-- | The partial ordering induced by the meet-semilattice structure
meetLeq :: (MeetSemiLattice a) => a -> a -> Bool
meetLeq :: a -> a -> Bool
meetLeq a
x a
y = (a
x a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
y) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x

-- | The combination of two semi lattices makes a lattice if the absorption law holds:
-- see [Absorption Law](http://en.wikipedia.org/wiki/Absorption_law) and [Lattice](http://en.wikipedia.org/wiki/Lattice_(order\))
--
-- > Absorption: a \/ (a /\ b) == a /\ (a \/ b) == a
class (JoinSemiLattice a, MeetSemiLattice a) => Lattice a

instance (JoinSemiLattice a, MeetSemiLattice a) => Lattice a

-- | A join-semilattice with an identity element 'bottom' for '\/'.
--
-- > Identity: x \/ bottom == x
class JoinSemiLattice a => BoundedJoinSemiLattice a where
  bottom :: a

-- | A meet-semilattice with an identity element 'top' for '/\'.
--
-- > Identity: x /\ top == x
class MeetSemiLattice a => BoundedMeetSemiLattice a where
  top :: a

-- | Lattices with both bounds
class (JoinSemiLattice a, MeetSemiLattice a, BoundedJoinSemiLattice a, BoundedMeetSemiLattice a) => BoundedLattice a

instance (JoinSemiLattice a, MeetSemiLattice a, BoundedJoinSemiLattice a, BoundedMeetSemiLattice a) => BoundedLattice a

instance JoinSemiLattice Float where
  \/ :: Float -> Float -> Float
(\/) = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Float where
  /\ :: Float -> Float -> Float
(/\) = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Double where
  \/ :: Double -> Double -> Double
(\/) = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Double where
  /\ :: Double -> Double -> Double
(/\) = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int where
  \/ :: Int -> Int -> Int
(\/) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int where
  /\ :: Int -> Int -> Int
(/\) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Integer where
  \/ :: Integer -> Integer -> Integer
(\/) = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Integer where
  /\ :: Integer -> Integer -> Integer
(/\) = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Bool where
  \/ :: Bool -> Bool -> Bool
(\/) = Bool -> Bool -> Bool
(||)

instance MeetSemiLattice Bool where
  /\ :: Bool -> Bool -> Bool
(/\) = Bool -> Bool -> Bool
(&&)

instance JoinSemiLattice Natural where
  \/ :: Natural -> Natural -> Natural
(\/) = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Natural where
  /\ :: Natural -> Natural -> Natural
(/\) = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int8 where
  \/ :: Int8 -> Int8 -> Int8
(\/) = Int8 -> Int8 -> Int8
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int8 where
  /\ :: Int8 -> Int8 -> Int8
(/\) = Int8 -> Int8 -> Int8
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int16 where
  \/ :: Int16 -> Int16 -> Int16
(\/) = Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int16 where
  /\ :: Int16 -> Int16 -> Int16
(/\) = Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int32 where
  \/ :: Int32 -> Int32 -> Int32
(\/) = Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int32 where
  /\ :: Int32 -> Int32 -> Int32
(/\) = Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int64 where
  \/ :: Int64 -> Int64 -> Int64
(\/) = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int64 where
  /\ :: Int64 -> Int64 -> Int64
(/\) = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word where
  \/ :: Word -> Word -> Word
(\/) = Word -> Word -> Word
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word where
  /\ :: Word -> Word -> Word
(/\) = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word8 where
  \/ :: Word8 -> Word8 -> Word8
(\/) = Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word8 where
  /\ :: Word8 -> Word8 -> Word8
(/\) = Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word16 where
  \/ :: Word16 -> Word16 -> Word16
(\/) = Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word16 where
  /\ :: Word16 -> Word16 -> Word16
(/\) = Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word32 where
  \/ :: Word32 -> Word32 -> Word32
(\/) = Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word32 where
  /\ :: Word32 -> Word32 -> Word32
(/\) = Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word64 where
  \/ :: Word64 -> Word64 -> Word64
(\/) = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word64 where
  /\ :: Word64 -> Word64 -> Word64
(/\) = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max

instance (Eq (a -> b), JoinSemiLattice b) => JoinSemiLattice (a -> b) where
  a -> b
f \/ :: (a -> b) -> (a -> b) -> a -> b
\/ a -> b
f' = \a
a -> a -> b
f a
a b -> b -> b
forall a. JoinSemiLattice a => a -> a -> a
\/ a -> b
f' a
a

instance (Eq (a -> b), MeetSemiLattice b) => MeetSemiLattice (a -> b) where
  a -> b
f /\ :: (a -> b) -> (a -> b) -> a -> b
/\ a -> b
f' = \a
a -> a -> b
f a
a b -> b -> b
forall a. MeetSemiLattice a => a -> a -> a
/\ a -> b
f' a
a

-- from here

instance BoundedJoinSemiLattice Float where
  bottom :: Float
bottom = Float
forall a. LowerBoundedField a => a
negInfinity

instance BoundedMeetSemiLattice Float where
  top :: Float
top = Float
forall a. UpperBoundedField a => a
infinity

instance BoundedJoinSemiLattice Double where
  bottom :: Double
bottom = Double
forall a. LowerBoundedField a => a
negInfinity

instance BoundedMeetSemiLattice Double where
  top :: Double
top = Double
forall a. UpperBoundedField a => a
infinity

instance BoundedJoinSemiLattice Int where
  bottom :: Int
bottom = Int
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int where
  top :: Int
top = Int
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Bool where
  bottom :: Bool
bottom = Bool
False

instance BoundedMeetSemiLattice Bool where
  top :: Bool
top = Bool
True

instance BoundedJoinSemiLattice Natural where
  bottom :: Natural
bottom = Natural
forall a. Additive a => a
zero

instance BoundedJoinSemiLattice Int8 where
  bottom :: Int8
bottom = Int8
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int8 where
  top :: Int8
top = Int8
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int16 where
  bottom :: Int16
bottom = Int16
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int16 where
  top :: Int16
top = Int16
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int32 where
  bottom :: Int32
bottom = Int32
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int32 where
  top :: Int32
top = Int32
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int64 where
  bottom :: Int64
bottom = Int64
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int64 where
  top :: Int64
top = Int64
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word where
  bottom :: Word
bottom = Word
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word where
  top :: Word
top = Word
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word8 where
  bottom :: Word8
bottom = Word8
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word8 where
  top :: Word8
top = Word8
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word16 where
  bottom :: Word16
bottom = Word16
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word16 where
  top :: Word16
top = Word16
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word32 where
  bottom :: Word32
bottom = Word32
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word32 where
  top :: Word32
top = Word32
forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word64 where
  bottom :: Word64
bottom = Word64
forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word64 where
  top :: Word64
top = Word64
forall a. Bounded a => a
maxBound

instance (Eq (a -> b), BoundedJoinSemiLattice b) => BoundedJoinSemiLattice (a -> b) where
  bottom :: a -> b
bottom = b -> a -> b
forall a b. a -> b -> a
const b
forall a. BoundedJoinSemiLattice a => a
bottom

instance (Eq (a -> b), BoundedMeetSemiLattice b) => BoundedMeetSemiLattice (a -> b) where
  top :: a -> b
top = b -> a -> b
forall a b. a -> b -> a
const b
forall a. BoundedMeetSemiLattice a => a
top