{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE EmptyDataDecls     #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-imports       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Monoid.Inf
-- Copyright   :  (c) 2012-2015 diagrams-core team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Make semigroups under 'min' or 'max' into monoids by adjoining an
-- element corresponding to infinity (positive or negative,
-- respectively). These types are similar to @Maybe (Min a)@ and
-- @Maybe (Max a)@ respectively, except that the 'Ord' instance
-- matches the 'Monoid' instance.
--
-----------------------------------------------------------------------------

module Data.Monoid.Inf
       ( Inf(..)
       , Pos, Neg
       , PosInf, NegInf
       , minimum, maximum
       -- * Type-restricted constructors
       , posInfty, negInfty
       , posFinite, negFinite
       ) where

import           Control.Applicative (Applicative(..), liftA2)
import           Data.Data
import           Data.Semigroup
import           Prelude             hiding (maximum, minimum)
import qualified Prelude             as P

import           Data.Foldable       (Foldable)
import           Data.Traversable    (Traversable)

-- | Type index indicating positive infinity.
data Pos
-- | Type index indicating negative infinity.
data Neg

-- | @Inf p a@ represents the type 'a' extended with a new "infinite"
--   value, which is treated as either positive or negative infinity
--   depending on the type index 'p'.  This type exists mostly for its
--   'Ord', 'Semigroup', and 'Monoid' instances.
data Inf p a = Infinity | Finite a
  deriving (Inf p a -> DataType
Inf p a -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {p} {a}. (Data p, Data a) => Typeable (Inf p a)
forall p a. (Data p, Data a) => Inf p a -> DataType
forall p a. (Data p, Data a) => Inf p a -> Constr
forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Inf p a -> Inf p a
forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Inf p a -> u
forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Inf p a -> [u]
forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Inf p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inf p a -> c (Inf p a)
forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Inf p a))
forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Inf p a))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Inf p a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inf p a -> c (Inf p a)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Inf p a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
$cgmapMo :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
$cgmapMp :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
$cgmapM :: forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Inf p a -> m (Inf p a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Inf p a -> u
$cgmapQi :: forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Inf p a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Inf p a -> [u]
$cgmapQ :: forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Inf p a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
$cgmapQr :: forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
$cgmapQl :: forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Inf p a -> r
gmapT :: (forall b. Data b => b -> b) -> Inf p a -> Inf p a
$cgmapT :: forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Inf p a -> Inf p a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Inf p a))
$cdataCast2 :: forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Inf p a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Inf p a))
$cdataCast1 :: forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Inf p a))
dataTypeOf :: Inf p a -> DataType
$cdataTypeOf :: forall p a. (Data p, Data a) => Inf p a -> DataType
toConstr :: Inf p a -> Constr
$ctoConstr :: forall p a. (Data p, Data a) => Inf p a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Inf p a)
$cgunfold :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Inf p a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inf p a -> c (Inf p a)
$cgfoldl :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Inf p a -> c (Inf p a)
Data, Typeable, Int -> Inf p a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. Show a => Int -> Inf p a -> ShowS
forall p a. Show a => [Inf p a] -> ShowS
forall p a. Show a => Inf p a -> String
showList :: [Inf p a] -> ShowS
$cshowList :: forall p a. Show a => [Inf p a] -> ShowS
show :: Inf p a -> String
$cshow :: forall p a. Show a => Inf p a -> String
showsPrec :: Int -> Inf p a -> ShowS
$cshowsPrec :: forall p a. Show a => Int -> Inf p a -> ShowS
Show, ReadPrec [Inf p a]
ReadPrec (Inf p a)
ReadS [Inf p a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p a. Read a => ReadPrec [Inf p a]
forall p a. Read a => ReadPrec (Inf p a)
forall p a. Read a => Int -> ReadS (Inf p a)
forall p a. Read a => ReadS [Inf p a]
readListPrec :: ReadPrec [Inf p a]
$creadListPrec :: forall p a. Read a => ReadPrec [Inf p a]
readPrec :: ReadPrec (Inf p a)
$creadPrec :: forall p a. Read a => ReadPrec (Inf p a)
readList :: ReadS [Inf p a]
$creadList :: forall p a. Read a => ReadS [Inf p a]
readsPrec :: Int -> ReadS (Inf p a)
$creadsPrec :: forall p a. Read a => Int -> ReadS (Inf p a)
Read, Inf p a -> Inf p a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a. Eq a => Inf p a -> Inf p a -> Bool
/= :: Inf p a -> Inf p a -> Bool
$c/= :: forall p a. Eq a => Inf p a -> Inf p a -> Bool
== :: Inf p a -> Inf p a -> Bool
$c== :: forall p a. Eq a => Inf p a -> Inf p a -> Bool
Eq, forall a b. a -> Inf p b -> Inf p a
forall a b. (a -> b) -> Inf p a -> Inf p b
forall p a b. a -> Inf p b -> Inf p a
forall p a b. (a -> b) -> Inf p a -> Inf p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Inf p b -> Inf p a
$c<$ :: forall p a b. a -> Inf p b -> Inf p a
fmap :: forall a b. (a -> b) -> Inf p a -> Inf p b
$cfmap :: forall p a b. (a -> b) -> Inf p a -> Inf p b
Functor, forall a. Inf p a -> Bool
forall p a. Eq a => a -> Inf p a -> Bool
forall p a. Num a => Inf p a -> a
forall p a. Ord a => Inf p a -> a
forall m a. Monoid m => (a -> m) -> Inf p a -> m
forall p m. Monoid m => Inf p m -> m
forall p a. Inf p a -> Bool
forall p a. Inf p a -> Int
forall p a. Inf p a -> [a]
forall a b. (a -> b -> b) -> b -> Inf p a -> b
forall p a. (a -> a -> a) -> Inf p a -> a
forall p m a. Monoid m => (a -> m) -> Inf p a -> m
forall p b a. (b -> a -> b) -> b -> Inf p a -> b
forall p a b. (a -> b -> b) -> b -> Inf p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Inf p a -> a
$cproduct :: forall p a. Num a => Inf p a -> a
sum :: forall a. Num a => Inf p a -> a
$csum :: forall p a. Num a => Inf p a -> a
minimum :: forall a. Ord a => Inf p a -> a
$cminimum :: forall p a. Ord a => Inf p a -> a
maximum :: forall a. Ord a => Inf p a -> a
$cmaximum :: forall p a. Ord a => Inf p a -> a
elem :: forall a. Eq a => a -> Inf p a -> Bool
$celem :: forall p a. Eq a => a -> Inf p a -> Bool
length :: forall a. Inf p a -> Int
$clength :: forall p a. Inf p a -> Int
null :: forall a. Inf p a -> Bool
$cnull :: forall p a. Inf p a -> Bool
toList :: forall a. Inf p a -> [a]
$ctoList :: forall p a. Inf p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Inf p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> Inf p a -> a
foldr1 :: forall a. (a -> a -> a) -> Inf p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> Inf p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Inf p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> Inf p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Inf p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> Inf p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Inf p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> Inf p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Inf p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> Inf p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Inf p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> Inf p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Inf p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> Inf p a -> m
fold :: forall m. Monoid m => Inf p m -> m
$cfold :: forall p m. Monoid m => Inf p m -> m
Foldable,
            forall p. Functor (Inf p)
forall p. Foldable (Inf p)
forall p (m :: * -> *) a. Monad m => Inf p (m a) -> m (Inf p a)
forall p (f :: * -> *) a.
Applicative f =>
Inf p (f a) -> f (Inf p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inf p a -> m (Inf p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inf p a -> f (Inf p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inf p a -> f (Inf p b)
sequence :: forall (m :: * -> *) a. Monad m => Inf p (m a) -> m (Inf p a)
$csequence :: forall p (m :: * -> *) a. Monad m => Inf p (m a) -> m (Inf p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inf p a -> m (Inf p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Inf p a -> m (Inf p b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Inf p (f a) -> f (Inf p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
Inf p (f a) -> f (Inf p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inf p a -> f (Inf p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inf p a -> f (Inf p b)
Traversable)

-- | The type 'a' extended with positive infinity.
type PosInf a = Inf Pos a

-- | The type 'a' extended with negative infinity.
type NegInf a = Inf Neg a

-- | Positive infinity is greater than any finite value.
instance Ord a => Ord (Inf Pos a) where
  compare :: Inf Pos a -> Inf Pos a -> Ordering
compare Inf Pos a
Infinity Inf Pos a
Infinity = Ordering
EQ
  compare Inf Pos a
Infinity Finite{} = Ordering
GT
  compare Finite{} Inf Pos a
Infinity = Ordering
LT
  compare (Finite a
a) (Finite a
b) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- | Negative infinity is less than any finite value.
instance Ord a => Ord (Inf Neg a) where
  compare :: Inf Neg a -> Inf Neg a -> Ordering
compare Inf Neg a
Infinity Inf Neg a
Infinity = Ordering
EQ
  compare Inf Neg a
Infinity Finite{} = Ordering
LT
  compare Finite{} Inf Neg a
Infinity = Ordering
GT
  compare (Finite a
a) (Finite a
b) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- | An ordered type extended with positive infinity is a semigroup
--   under 'min'.
instance Ord a => Semigroup (Inf Pos a) where
  <> :: Inf Pos a -> Inf Pos a -> Inf Pos a
(<>) = forall a. Ord a => a -> a -> a
min

-- | An ordered type extended with negative infinity is a semigroup
--   under 'max'.
instance Ord a => Semigroup (Inf Neg a) where
  <> :: Inf Neg a -> Inf Neg a -> Inf Neg a
(<>) = forall a. Ord a => a -> a -> a
max

-- | An ordered type extended with positive infinity is a monoid under
--   'min', with positive infinity as the identity element.
instance Ord a => Monoid (Inf Pos a) where
  mempty :: Inf Pos a
mempty = forall p a. Inf p a
Infinity
  mappend :: Inf Pos a -> Inf Pos a -> Inf Pos a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | An ordered type extended with negative infinity is a monoid under
--   'max', with negative infinity as the identity element.
instance Ord a => Monoid (Inf Neg a) where
  mempty :: Inf Neg a
mempty = forall p a. Inf p a
Infinity
  mappend :: Inf Neg a -> Inf Neg a -> Inf Neg a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Applicative (Inf p) where
    pure :: forall a. a -> Inf p a
pure = forall p a. a -> Inf p a
Finite
    Inf p (a -> b)
Infinity <*> :: forall a b. Inf p (a -> b) -> Inf p a -> Inf p b
<*> Inf p a
_ = forall p a. Inf p a
Infinity
    Inf p (a -> b)
_ <*> Inf p a
Infinity = forall p a. Inf p a
Infinity
    Finite a -> b
f <*> Finite a
x = forall p a. a -> Inf p a
Finite forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Monad (Inf p) where
    Inf p a
Infinity >>= :: forall a b. Inf p a -> (a -> Inf p b) -> Inf p b
>>= a -> Inf p b
_ = forall p a. Inf p a
Infinity
    Finite a
x >>= a -> Inf p b
f = a -> Inf p b
f a
x
    return :: forall a. a -> Inf p a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Bounded a => Bounded (NegInf a) where
    minBound :: NegInf a
minBound = forall p a. Inf p a
Infinity
    maxBound :: NegInf a
maxBound = forall p a. a -> Inf p a
Finite forall a. Bounded a => a
maxBound

instance Bounded a => Bounded (PosInf a) where
    minBound :: PosInf a
minBound = forall p a. a -> Inf p a
Finite forall a. Bounded a => a
minBound
    maxBound :: PosInf a
maxBound = forall p a. Inf p a
Infinity

-- | Find the minimum of a list of values.  Returns positive infinity
--   iff the list is empty.
minimum :: Ord a => [a] -> PosInf a
minimum :: forall a. Ord a => [a] -> PosInf a
minimum [a]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
P.minimum (forall p a. Inf p a
Infinity forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall p a. a -> Inf p a
Finite [a]
xs)

-- | Find the maximum of a list of values.  Returns negative infinity
--   iff the list is empty.
maximum :: Ord a => [a] -> NegInf a
maximum :: forall a. Ord a => [a] -> NegInf a
maximum [a]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
P.maximum (forall p a. Inf p a
Infinity forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall p a. a -> Inf p a
Finite [a]
xs)

-- | Positive infinity.
posInfty :: PosInf a

-- | Negative infinity.
negInfty :: NegInf a

-- | Embed a finite value into the space of such values extended with
--   positive infinity.
posFinite :: a -> PosInf a

-- | Embed a finite value into the space of such values extended with
--   negative infinity.
negFinite :: a -> NegInf a

posInfty :: forall a. PosInf a
posInfty = forall p a. Inf p a
Infinity
negInfty :: forall a. NegInf a
negInfty = forall p a. Inf p a
Infinity
posFinite :: forall a. a -> PosInf a
posFinite = forall p a. a -> Inf p a
Finite
negFinite :: forall a. a -> NegInf a
negFinite = forall p a. a -> Inf p a
Finite