{-# LANGUAGE DefaultSignatures #-}
module Symantic.Compta.Lang.Math where

import Data.Bool
import Data.Function ((.), flip)
import Data.Decimal (Decimal, DecimalRaw(..), roundTo)
import Data.Eq (Eq(..))
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..))
import Data.Functor ((<$>))
import Data.Monoid (Endo(..))
import Data.String (String)
import Data.Ord (Ord(..), Ordering(..))
import Data.Word (Word8)
import Data.Int (Int)
import Prelude (Integral, Integer, fromIntegral)
import qualified Data.Map.Strict as Map
import qualified Prelude

import Symantic.Compta.Lang.Rebindable

-- * Class 'Zeroable'
class Zeroable a where
  zero :: a
instance Zeroable String where
  zero = ""
instance Zeroable Decimal where
  zero = 0
instance Zeroable (Map.Map k a) where
  zero = Map.empty

{-
instance Zeroable Decimal where
  zero = 0
instance Zeroable (Map k a) where
  zero = Map.empty
-}

-- * Class 'Nullable'
class Nullable a where
  null :: a -> Bool
  default null :: Zeroable a => Eq a => a -> Bool
  null = (== zero)
instance Nullable String
instance Nullable Decimal

{-
instance Nullable Decimal where
  null = (==) zero
instance Nullable a => Nullable (Map k a) where
  null = Foldable.all null
-}

-- * Class 'Signable'
class Signable a where
  sign :: a -> Ordering
  default sign :: Zeroable a => Nullable a => Ord a => a -> Ordering
  sign a =
    case () of
     _ | null a -> EQ
     _ | a < zero -> LT
     _ -> GT
--instance Signable Decimal

-- * Class 'Addable'
class Addable a where
  (+) :: a -> a -> a; infixl 6 +
  default (+) :: Prelude.Num a => a -> a -> a
  (+) = (Prelude.+)
-- | For @'Addable' ('Map' k ())@.
instance Addable () where
  (+) () () = ()
instance (Ord k, Addable a) => Addable (Map k a) where
  (+) = Map.unionWith (flip (+))
instance Addable a => Addable (Maybe a) where
  Nothing + Nothing = Nothing
  Just x + Nothing = Just x
  Nothing + Just y = Just y
  Just x + Just y = Just (x + y)
instance Addable Decimal where
  (+) x y = Decimal e (fromIntegral (nx Prelude.+ ny))
    where (e, nx, ny) = roundMinDecimal x y
-- | Round the two 'DecimalRaw' values to the smallest exponent.
roundMinDecimal :: Integral i => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
roundMinDecimal d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)
  where
    e = min e1 e2
    Decimal _ n1 = roundTo e d1
    Decimal _ n2 = roundTo e d2

-- * Class 'Negable'
class Negable a where
  negate :: a -> a
  default negate :: Prelude.Num a => a -> a
  negate = Prelude.negate
-- | For @'Negable' ('Map' k ())@.
instance Negable () where
  negate () = ()
instance Negable Int
instance Negable Integer
instance Negable Decimal
instance Negable a => Negable (Map k a) where
  negate = Map.map negate
instance Negable a => Negable (Endo a) where
  negate (Endo f) = Endo (f . negate)
instance Negable a => Negable [a] where
  negate = (negate <$>)

-- * Class 'Subable'
class Subable a where
  (-) :: a -> a -> a; infixl 6 -
  default (-) :: Prelude.Num a => a -> a -> a
  (-) = (Prelude.-)
-- | For @'Subable' ('Map' k ())@.
instance Subable () where
  (-) () () = ()
instance Subable Int
instance Subable Integer
instance Subable Decimal
instance (Ord k, Addable a, Negable a) => Subable (Map k a) where
  (-) x y = Map.unionWith (flip (+)) x (negate y)