-- | Integers augmented with Infinity.
module Util.IntPlus(
   IntPlus,
   infinity
   ) where

-- --------------------------------------------------------------------
-- The datatype
-- --------------------------------------------------------------------

-- | The Bool is a sign, with True meaning positive infinity.
data IntPlus = Infinite Bool | Finite Integer deriving IntPlus -> IntPlus -> Bool
(IntPlus -> IntPlus -> Bool)
-> (IntPlus -> IntPlus -> Bool) -> Eq IntPlus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntPlus -> IntPlus -> Bool
$c/= :: IntPlus -> IntPlus -> Bool
== :: IntPlus -> IntPlus -> Bool
$c== :: IntPlus -> IntPlus -> Bool
Eq

-- --------------------------------------------------------------------
-- The interface
-- --------------------------------------------------------------------

infinity :: IntPlus
infinity :: IntPlus
infinity = Bool -> IntPlus
Infinite Bool
True

instance Ord IntPlus where
   compare :: IntPlus -> IntPlus -> Ordering
compare IntPlus
i1 IntPlus
i2 = case (IntPlus
i1,IntPlus
i2) of
      (Infinite Bool
b1,Infinite Bool
b2) -> Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
b1 Bool
b2
      (Finite Integer
_,Infinite Bool
b) -> if Bool
b then Ordering
LT else Ordering
GT
      (Infinite Bool
b,Finite Integer
_) -> if Bool
b then Ordering
GT else Ordering
LT
      (Finite Integer
i1,Finite Integer
i2) -> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i1 Integer
i2

instance Show IntPlus where
   showsPrec :: Int -> IntPlus -> ShowS
showsPrec Int
_ (Infinite Bool
b) String
s = if Bool
b then String
"infinity"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s else String
"-infinity"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s
   showsPrec Int
p (Finite Integer
i) String
s = Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Integer
i String
s

instance Num IntPlus where
   + :: IntPlus -> IntPlus -> IntPlus
(+) IntPlus
i1 IntPlus
i2 = case (IntPlus
i1,IntPlus
i2) of
      (Finite Integer
i1,Finite Integer
i2) -> Integer -> IntPlus
Finite (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i2)
      (Infinite Bool
b,Finite Integer
_) -> Bool -> IntPlus
Infinite Bool
b
      (Finite Integer
_,Infinite Bool
b) -> Bool -> IntPlus
Infinite Bool
b
      (Infinite Bool
b1,Infinite Bool
b2) ->
         if Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2 then Bool -> IntPlus
Infinite Bool
b1 else
            String -> IntPlus
forall a. HasCallStack => String -> a
error String
"IntPlus: attempt to subtract infinities of like sign"
   * :: IntPlus -> IntPlus -> IntPlus
(*) IntPlus
i1 IntPlus
i2 = case (IntPlus
i1,IntPlus
i2) of
      (Finite Integer
i1,Finite Integer
i2) -> Integer -> IntPlus
Finite (Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
i2)
      (Finite Integer
i,Infinite Bool
b) -> Integer -> Bool -> IntPlus
forall a. (Ord a, Num a) => a -> Bool -> IntPlus
mul Integer
i Bool
b
      (Infinite Bool
b,Finite Integer
i) -> Integer -> Bool -> IntPlus
forall a. (Ord a, Num a) => a -> Bool -> IntPlus
mul Integer
i Bool
b
      (Infinite Bool
b1,Infinite Bool
b2) -> Bool -> IntPlus
Infinite (Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2)
      where
         mul :: a -> Bool -> IntPlus
mul a
i Bool
b = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
i a
0 of
            Ordering
LT -> Bool -> IntPlus
Infinite (Bool -> Bool
not Bool
b)
            Ordering
EQ -> Integer -> IntPlus
Finite Integer
0
            Ordering
GT -> Bool -> IntPlus
Infinite Bool
b

   negate :: IntPlus -> IntPlus
negate (Finite Integer
i) = Integer -> IntPlus
Finite (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i)
   negate (Infinite Bool
b) = Bool -> IntPlus
Infinite (Bool -> Bool
not Bool
b)

   abs :: IntPlus -> IntPlus
abs (Finite Integer
i) = Integer -> IntPlus
Finite (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
   abs (Infinite Bool
_) = IntPlus
infinity

   signum :: IntPlus -> IntPlus
signum IntPlus
i = case IntPlus -> IntPlus -> Ordering
forall a. Ord a => a -> a -> Ordering
compare IntPlus
i IntPlus
0 of
      Ordering
LT -> -IntPlus
1
      Ordering
EQ -> IntPlus
0
      Ordering
GT -> IntPlus
1

   fromInteger :: Integer -> IntPlus
fromInteger Integer
i = Integer -> IntPlus
Finite Integer
i