{- |The Extended module allows real-valued numeric data types to be extended by
   positive and negative infinity.
-}
{-# LANGUAGE DeriveFunctor #-}
module Data.CDAR.Extended (Extended(..)) where

import Control.Monad

-- |Extended numbers are either finite numbers or one of the two infinities.
data Extended a = PosInf | NegInf | Finite a deriving (Extended a -> Extended a -> Bool
(Extended a -> Extended a -> Bool)
-> (Extended a -> Extended a -> Bool) -> Eq (Extended a)
forall a. Eq a => Extended a -> Extended a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extended a -> Extended a -> Bool
$c/= :: forall a. Eq a => Extended a -> Extended a -> Bool
== :: Extended a -> Extended a -> Bool
$c== :: forall a. Eq a => Extended a -> Extended a -> Bool
Eq,ReadPrec [Extended a]
ReadPrec (Extended a)
Int -> ReadS (Extended a)
ReadS [Extended a]
(Int -> ReadS (Extended a))
-> ReadS [Extended a]
-> ReadPrec (Extended a)
-> ReadPrec [Extended a]
-> Read (Extended a)
forall a. Read a => ReadPrec [Extended a]
forall a. Read a => ReadPrec (Extended a)
forall a. Read a => Int -> ReadS (Extended a)
forall a. Read a => ReadS [Extended a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extended a]
$creadListPrec :: forall a. Read a => ReadPrec [Extended a]
readPrec :: ReadPrec (Extended a)
$creadPrec :: forall a. Read a => ReadPrec (Extended a)
readList :: ReadS [Extended a]
$creadList :: forall a. Read a => ReadS [Extended a]
readsPrec :: Int -> ReadS (Extended a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Extended a)
Read,Int -> Extended a -> ShowS
[Extended a] -> ShowS
Extended a -> String
(Int -> Extended a -> ShowS)
-> (Extended a -> String)
-> ([Extended a] -> ShowS)
-> Show (Extended a)
forall a. Show a => Int -> Extended a -> ShowS
forall a. Show a => [Extended a] -> ShowS
forall a. Show a => Extended a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extended a] -> ShowS
$cshowList :: forall a. Show a => [Extended a] -> ShowS
show :: Extended a -> String
$cshow :: forall a. Show a => Extended a -> String
showsPrec :: Int -> Extended a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Extended a -> ShowS
Show,a -> Extended b -> Extended a
(a -> b) -> Extended a -> Extended b
(forall a b. (a -> b) -> Extended a -> Extended b)
-> (forall a b. a -> Extended b -> Extended a) -> Functor Extended
forall a b. a -> Extended b -> Extended a
forall a b. (a -> b) -> Extended a -> Extended b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Extended b -> Extended a
$c<$ :: forall a b. a -> Extended b -> Extended a
fmap :: (a -> b) -> Extended a -> Extended b
$cfmap :: forall a b. (a -> b) -> Extended a -> Extended b
Functor)

instance Applicative Extended where
    pure :: a -> Extended a
pure = a -> Extended a
forall a. a -> Extended a
Finite
    (Finite a -> b
f) <*> :: Extended (a -> b) -> Extended a -> Extended b
<*> (Finite a
x) = b -> Extended b
forall a. a -> Extended a
Finite (b -> Extended b) -> b -> Extended b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
    (Finite a -> b
_) <*> Extended a
PosInf = Extended b
forall a. Extended a
PosInf
    (Finite a -> b
_) <*> Extended a
NegInf = Extended b
forall a. Extended a
NegInf
    Extended (a -> b)
PosInf <*> Extended a
_ = Extended b
forall a. Extended a
PosInf
    Extended (a -> b)
NegInf <*> Extended a
_ = Extended b
forall a. Extended a
NegInf

instance Monad Extended where
    return :: a -> Extended a
return = a -> Extended a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Finite a
x) >>= :: Extended a -> (a -> Extended b) -> Extended b
>>= a -> Extended b
f = a -> Extended b
f a
x
    Extended a
PosInf >>= a -> Extended b
_ = Extended b
forall a. Extended a
PosInf
    Extended a
NegInf >>= a -> Extended b
_ = Extended b
forall a. Extended a
NegInf

instance Ord a => Ord (Extended a) where
    compare :: Extended a -> Extended a -> Ordering
compare Extended a
PosInf Extended a
PosInf = Ordering
EQ
    compare Extended a
NegInf Extended a
NegInf = Ordering
EQ
    compare Extended a
_ Extended a
PosInf = Ordering
LT
    compare Extended a
NegInf Extended a
_ = Ordering
LT
    compare Extended a
PosInf Extended a
_ = Ordering
GT
    compare Extended a
_ Extended a
NegInf = Ordering
GT
    compare (Finite a
a) (Finite a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

instance (Ord a, Num a) => Num (Extended a) where
    -- PosInf + NegInf should be undefined, but here it is the first argument
    + :: Extended a -> Extended a -> Extended a
(+) = (a -> a -> a) -> Extended a -> Extended a -> Extended a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
    -- 0 * ???Inf should be undefined, but here it is PosInf
    Extended a
a * :: Extended a -> Extended a -> Extended a
* Extended a
PosInf = if Extended a
a Extended a -> Extended a -> Bool
forall a. Ord a => a -> a -> Bool
< Extended a
0 then Extended a
forall a. Extended a
NegInf else Extended a
forall a. Extended a
PosInf
    Extended a
PosInf * Extended a
a = if Extended a
a Extended a -> Extended a -> Bool
forall a. Ord a => a -> a -> Bool
< Extended a
0 then Extended a
forall a. Extended a
NegInf else Extended a
forall a. Extended a
PosInf
    Extended a
a * Extended a
NegInf = if Extended a
a Extended a -> Extended a -> Bool
forall a. Ord a => a -> a -> Bool
< Extended a
0 then Extended a
forall a. Extended a
PosInf else Extended a
forall a. Extended a
NegInf
    Extended a
NegInf * Extended a
a = if Extended a
a Extended a -> Extended a -> Bool
forall a. Ord a => a -> a -> Bool
< Extended a
0 then Extended a
forall a. Extended a
PosInf else Extended a
forall a. Extended a
NegInf
    Extended a
a * Extended a
b = a -> a -> a
forall a. Num a => a -> a -> a
(*) (a -> a -> a) -> Extended a -> Extended (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended a
a Extended (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Extended a
b
    negate :: Extended a -> Extended a
negate = (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
    abs :: Extended a -> Extended a
abs = (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
    signum :: Extended a -> Extended a
signum Extended a
PosInf = a -> Extended a
forall a. a -> Extended a
Finite a
1
    signum Extended a
NegInf = a -> Extended a
forall a. a -> Extended a
Finite (-a
1)
    signum Extended a
a = a -> a
forall a. Num a => a -> a
signum (a -> a) -> Extended a -> Extended a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended a
a
    fromInteger :: Integer -> Extended a
fromInteger Integer
i = a -> Extended a
forall a. a -> Extended a
Finite (a -> Extended a) -> a -> Extended a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i

instance Real a => Real (Extended a) where
    toRational :: Extended a -> Rational
toRational (Finite a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x
    toRational Extended a
_ = Rational
forall a. HasCallStack => a
undefined