```{-# LANGUAGE NoImplicitPrelude #-}
module Algebra.Lattice (
C(up, dn)
, max, min, abs
, propUpCommutative, propDnCommutative
, propUpAssociative, propDnAssociative
, propUpDnDistributive, propDnUpDistributive
) where

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Number.Ratio     as Ratio

import qualified Algebra.Laws as Laws

import NumericPrelude hiding (abs)
import PreludeBase hiding (max, min)
import qualified Prelude as P

infixl 5 `up`, `dn`

class C a where
up, dn :: a -> a -> a

{- * Properties -}

propUpCommutative, propDnCommutative ::
(Eq a, C a) => a -> a -> Bool
propUpCommutative  =  Laws.commutative up
propDnCommutative  =  Laws.commutative dn

propUpAssociative, propDnAssociative ::
(Eq a, C a) => a -> a -> a -> Bool
propUpAssociative  =  Laws.associative up
propDnAssociative  =  Laws.associative dn

propUpDnDistributive, propDnUpDistributive ::
(Eq a, C a) => a -> a -> a -> Bool
propUpDnDistributive  =  Laws.leftDistributive up dn
propDnUpDistributive  =  Laws.leftDistributive dn up

-- With  @up == gcd@  and  @dn == lcm@  we have also a lattice.
instance C Integer where
up = P.max
dn = P.min

instance (Ord a, PID.C a) => C (Ratio.T a) where
up = P.max
dn = P.min

instance C Bool where
up = (P.||)
dn = (P.&&)

instance (C a, C b) => C (a,b) where
(x1,y1)`up`(x2,y2) = (x1`up`x2, y1`up`y2)
(x1,y1)`dn`(x2,y2) = (x1`dn`x2, y1`dn`y2)

max, min :: (C a) => a -> a -> a
max = up
min = dn

abs :: (C a, Additive.C a) => a -> a
abs x = x `up` negate x
```