Semilattice.hs

{-# 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 ≼ b = a <> b == 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
    Nothing ≼ _ = True
    _ ≼ Nothing = False
    Just a ≼ Just b = a ≼ b