{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Abstract.InfiniteNumbers where

import Data.Order
import Data.Hashable
import Data.Metric
import Prettyprinter

import Control.DeepSeq

import GHC.Generics

data InfiniteNumber a = NegInfinity | Number a | Infinity deriving (Eq,Ord,Generic)

instance NFData a => NFData (InfiniteNumber a)

instance Pretty n => Show (InfiniteNumber n) where show = show . pretty
instance Pretty n => Pretty (InfiniteNumber n) where
  pretty NegInfinity = "-∞"
  pretty (Number n) = pretty n
  pretty Infinity = "∞"

isNegative :: (Eq a,Num a) => a -> Bool
isNegative x = signum x == -1

instance (Num a, Ord a) => Num (InfiniteNumber a) where
  NegInfinity + Infinity = error "Addition of positive and negative infinity is undefined"
  Infinity + NegInfinity = error "Addition of positive and negative infinity is undefined"
  Infinity + _ = Infinity
  _ + Infinity = Infinity
  NegInfinity + _ = NegInfinity
  _ + NegInfinity = NegInfinity
  Number n + Number m = Number (n + m)

  Number n * e = mult n e
  e * Number m = mult m e
  Infinity * Infinity = Infinity
  Infinity * NegInfinity = NegInfinity
  NegInfinity * Infinity = NegInfinity
  NegInfinity * NegInfinity = Infinity

  abs (Number n) = Number (abs n)
  abs _ = Infinity

  signum Infinity = Number 1
  signum NegInfinity = Number (-1)
  signum (Number n) = Number (signum n)

  fromInteger = Number . fromInteger

  negate Infinity = NegInfinity
  negate NegInfinity = Infinity
  negate (Number n) = Number (negate n)

mult :: (Num a, Ord a) => a -> InfiniteNumber a -> InfiniteNumber a
mult a e
  | a < 0 = case e of
      NegInfinity -> Infinity
      Infinity -> NegInfinity
      Number b -> Number (a * b)
  | a == 0 = Number 0
  | otherwise = case e of
      NegInfinity -> NegInfinity
      Infinity -> Infinity
      Number b -> Number (a * b)

divInf :: Integral n => InfiniteNumber n -> InfiniteNumber n -> InfiniteNumber n
divInf n m = case (n,m) of
  (Number _,Infinity)    -> Number 0
  (Number _,NegInfinity) -> Number 0
  (Infinity,Number _)    -> signum n * Infinity
  (NegInfinity,Number _) -> signum n * NegInfinity
  (Number x,Number y) -> Number (x `div` y)
  (Infinity,Infinity) -> Infinity
  (NegInfinity,Infinity) -> NegInfinity
  (Infinity,NegInfinity) -> NegInfinity
  (NegInfinity,NegInfinity) -> Infinity

instance Ord a => PreOrd (InfiniteNumber a) where
  NegInfinity ⊑ _ = True
  _ ⊑ NegInfinity = False
  _ ⊑ Infinity = True
  Infinity ⊑ _ = False
  Number n ⊑ Number m = n <= m

instance Ord a => LowerBounded (InfiniteNumber a) where
  bottom = NegInfinity

instance Ord a => UpperBounded (InfiniteNumber a) where
  top = Infinity

instance Ord a => Complete (InfiniteNumber a) where
  NegInfinity ⊔ x = x
  x ⊔ NegInfinity = x
  Infinity ⊔ _ = Infinity
  _ ⊔ Infinity = Infinity
  Number n ⊔ Number m = Number (max n m)

instance Ord a => CoComplete (InfiniteNumber a) where
  NegInfinity ⊓ _ = NegInfinity
  _ ⊓ NegInfinity = NegInfinity
  Infinity ⊓ x = x
  x ⊓ Infinity = x
  Number n ⊓ Number m = Number (min n m)

instance Bounded (InfiniteNumber n) where
  minBound = NegInfinity
  maxBound = Infinity

instance Hashable a => Hashable (InfiniteNumber a)

metric :: Metric m n -> Metric (InfiniteNumber m) (InfiniteNumber n)
metric m (Number x) (Number y) = Number (m x y)
metric _ _ _ = Infinity
