```{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Monoid.Inf
--
-- Make semigroup under 'min' or 'max' into monoids by adjoining an
-- element corresponding to infinity (positive or negative,
-- respectively). These types are similar to @Option (Min a)@ and
-- @Option (Max a)@ respectively, except that the 'Ord' instance
-- matches the 'Monoid' instance.
--
-----------------------------------------------------------------------------

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

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

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

data Pos
data Neg

data Inf p a = Infinity | Finite a
deriving (Eq, Show, Read, Functor, Foldable, Traversable)

type PosInf a = Inf Pos a
type NegInf a = Inf Neg a

instance Ord a => Ord (Inf Pos a) where
compare Infinity Infinity = EQ
compare Infinity Finite{} = GT
compare Finite{} Infinity = LT
compare (Finite a) (Finite b) = compare a b

instance Ord a => Ord (Inf Neg a) where
compare Infinity Infinity = EQ
compare Infinity Finite{} = LT
compare Finite{} Infinity = GT
compare (Finite a) (Finite b) = compare a b

instance Ord a => Semigroup (Inf Pos a) where
(<>) = min

instance Ord a => Semigroup (Inf Neg a) where
(<>) = max

instance Ord a => Monoid (Inf Pos a) where
mempty = Infinity
mappend = (<>)

instance Ord a => Monoid (Inf Neg a) where
mempty = Infinity
mappend = (<>)

minimum :: Ord a => [a] -> PosInf a
minimum xs = P.minimum (Infinity : map Finite xs)

maximum :: Ord a => [a] -> NegInf a
maximum xs = P.maximum (Infinity : map Finite xs)

posInfty :: PosInf a
negInfty :: NegInf a
posFinite :: a -> PosInf a
negFinite :: a -> NegInf a

posInfty = Infinity
negInfty = Infinity
posFinite = Finite
negFinite = Finite
```