Boolean.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Ring.Boolean
-- Copyright   :  (c) Edward Kmett 2009
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs)
--
-- A Boolean 'Ring' over 'Bool'. Note well that the 'mappend' of this ring is
-- symmetric difference and not disjunction like you might expect. To get that 
-- you should use use 'Ord' from "Data.Ring.Semi.Ord.Order" on 'Bool' to get the '&&'/'||'-based 
-- distributive-lattice 'SemiRing'
-----------------------------------------------------------------------------

module Data.Ring.Boolean
    ( module Data.Ring
    , BoolRing(BoolRing, getBoolRing)
    ) where

import Data.Ring
import Data.Monoid.Reducer
import Test.QuickCheck

newtype BoolRing = BoolRing { getBoolRing :: Bool } deriving (Eq,Ord,Show,Read,Arbitrary,CoArbitrary)

instance Monoid BoolRing where
    mempty = BoolRing False
    BoolRing a `mappend` BoolRing b = BoolRing ((a || b) && not (a && b))

instance Group BoolRing where
    gnegate = BoolRing . not . getBoolRing

instance Multiplicative BoolRing where
    one = BoolRing True
    BoolRing a `times` BoolRing b = BoolRing (a && b)

instance Ringoid BoolRing
instance LeftSemiNearRing BoolRing
instance RightSemiNearRing BoolRing
instance SemiRing BoolRing
instance Ring BoolRing

instance Reducer Bool BoolRing where
    unit = BoolRing