{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}

module RON.Semilattice (
    Semilattice (..),
    BoundedSemilattice,
) where

import           Prelude

import           Data.Semigroup (Max)
import           Data.Set (Set)

{- |
A semilattice.

It may be a join-semilattice, or meet-semilattice, it doesn't matter.

If it matters for you, use package @lattices@.

In addition to 'Semigroup', Semilattice defines these laws:

[commutativity]

    @x '<>' y == y '<>' x@

[idempotency]

    @x '<>' x == x@

[relation-operation equivalence]

    @x '≼' y == (x '<>' y == y)@
    @x '<>' y == minimum \z -> x '≼' z && y '≼' z@
-}
class Semigroup a => Semilattice a where

    -- | Semilattice relation.
    (≼) :: a -> a -> Bool
    default (≼) :: Eq a => a -> a -> Bool
    a
a ≼ a
b = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b

{- |
A bounded semilattice.

Bounded semilattice laws are already defined by 'Monoid' and 'Semilattice',
so we don't define an explicit class here.
-}
type BoundedSemilattice a = (Monoid a, Semilattice a)

-- instances for base types

instance Ord a => Semilattice (Max a)

instance Ord a => Semilattice (Set a)

instance Semilattice a => Semilattice (Maybe a) where
    Maybe a
Nothing ≼ :: Maybe a -> Maybe a -> Bool
≼ Maybe a
_       = Bool
True
    Maybe a
_       ≼ Maybe a
Nothing = Bool
False
    Just a
a  ≼ Just a
b  = a
a a -> a -> Bool
forall a. Semilattice a => a -> a -> Bool
≼ a
b