module Data.Monoid.Ord
( module Data.Monoid.Reducer
, Max(Max,getMax)
, Min(Min,getMin)
, MaxPriority(MaxPriority,getMaxPriority)
, minfinity
, MinPriority(MinPriority,getMinPriority)
, infinity
) where
import Control.Functor.Pointed
import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty)
import Data.Ring.Semi
newtype Max a = Max { getMax :: a } deriving (Eq,Ord,Show,Read,Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where
mempty = Max minBound
mappend = max
instance (Ord a, Bounded a) => Reducer a (Max a) where
unit = Max
instance Functor Max where
fmap f (Max a) = Max (f a)
instance Pointed Max where
point = Max
instance Copointed Max where
extract = getMax
newtype Min a = Min { getMin :: a } deriving (Eq,Ord,Show,Read,Bounded)
instance (Ord a, Bounded a) => Monoid (Min a) where
mempty = Min maxBound
mappend = min
instance (Ord a, Bounded a) => Reducer a (Min a) where
unit = Min
instance Functor Min where
fmap f (Min a) = Min (f a)
instance Pointed Min where
point = Min
instance Copointed Min where
extract = getMin
minfinity :: MaxPriority a
minfinity = MaxPriority Nothing
newtype MaxPriority a = MaxPriority { getMaxPriority :: Maybe a } deriving (Eq,Ord,Show,Read)
instance Ord a => Monoid (MaxPriority a) where
mempty = MaxPriority Nothing
mappend = max
instance Ord a => Reducer (Maybe a) (MaxPriority a) where
unit = MaxPriority
instance Functor MaxPriority where
fmap f (MaxPriority a) = MaxPriority (fmap f a)
instance Pointed MaxPriority where
point = MaxPriority . Just
infinity :: MinPriority a
infinity = MinPriority Nothing
newtype MinPriority a = MinPriority { getMinPriority :: Maybe a } deriving (Eq,Show,Read)
instance Ord a => Ord (MinPriority a) where
MinPriority Nothing `compare` MinPriority Nothing = EQ
MinPriority Nothing `compare` _ = GT
_ `compare` MinPriority Nothing = LT
MinPriority (Just a) `compare` MinPriority (Just b) = a `compare` b
instance Ord a => Monoid (MinPriority a) where
mempty = MinPriority Nothing
mappend = min
instance Ord a => Reducer (Maybe a) (MinPriority a) where
unit = MinPriority
instance Functor MinPriority where
fmap f (MinPriority a) = MinPriority (fmap f a)
instance Pointed MinPriority where
point = MinPriority . Just