1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    2 
    3 -- | 
    4 -- Module      : Data.Semiring
    5 -- Copyright   : Thomas Wilke, Frank Huch, Sebastian Fischer
    6 -- License     : BSD3
    7 -- Maintainer  : Sebastian Fischer <mailto:mail@sebfisch.de>
    8 -- Stability   : experimental
    9 -- 
   10 -- This library provides a type class for semirings and instances for
   11 -- standard data types.
   12 -- 
   13 module Data.Semiring (
   14 
   15   Semiring(..), fromBool,
   16 
   17   Numeric(..)
   18 
   19   ) where
   20 
   21 infixr 6 .+.
   22 infixr 7 .*.
   23 
   24 -- |
   25 -- A semiring is an additive commutative monoid with identity 'zero':
   26 -- 
   27 -- >         a .+. b  ==  b .+. a
   28 -- >      zero .+. a  ==  a
   29 -- > (a .+. b) .+. c  ==  a .+. (b .+. c)
   30 -- 
   31 -- A semiring is a multiplicative monoid with identity 'one':
   32 -- 
   33 -- >        one .*. a  ==  a
   34 -- >        a .*. one  ==  a
   35 -- >  (a .*. b) .*. c  ==  a .*. (b .*. c)
   36 -- 
   37 -- Multiplication distributes over addition:
   38 -- 
   39 -- > a .*. (b .+. c)  ==  (a .*. b) .+. (a .*. c)
   40 -- > (a .+. b) .*. c  ==  (a .*. c) .+. (b .*. c)
   41 -- 
   42 -- 'zero' annihilates a semiring with respect to multiplication:
   43 -- 
   44 -- > zero .*. a  ==  zero
   45 -- > a .*. zero  ==  zero
   46 -- 
   47 -- All laws should hold with respect to the required `Eq` instance.
   48 -- 
   49 -- For example, the Booleans form a semiring.
   50 -- 
   51 --  * @False@ is an identity of disjunction which is commutative and
   52 --    associative,
   53 -- 
   54 --  * @True@ is an identity of conjunction which is associative,
   55 -- 
   56 --  * conjunction distributes over disjunction, and
   57 -- 
   58 --  * @False@ annihilates the Booleans with respect to conjunction.
   59 -- 
   60 class Eq s => Semiring s where
   61   zero, one    :: s
   62   (.+.), (.*.) :: s -> s -> s
   63 
   64 -- | Auxiliary function to convert Booleans to an arbitrary semiring.
   65 -- 
   66 fromBool :: Semiring s => Bool -> s
   67 fromBool False = zero
   68 fromBool True  = one
   69 
   70 instance Semiring Bool where
   71   zero = False; one = True; (.+.) = (||); (.*.) = (&&)
   72 
   73 -- |
   74 -- Wrapper for numeric types.
   75 -- 
   76 -- Every numeric type that satisfies the semiring laws (as all
   77 -- predefined numeric types do) is a semiring.
   78 -- 
   79 newtype Numeric a = Numeric { getNumeric :: a }
   80  deriving (Eq,Num)
   81 
   82 instance Show a => Show (Numeric a) where
   83   show = show . getNumeric
   84 
   85 instance Num a => Semiring (Numeric a) where
   86   zero = 0; one = 1; (.+.) = (+); (.*.) = (*)