{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Quantity where

import           Data.Bool
import           Data.Data (Data)
import           Data.Decimal (Decimal, DecimalRaw(..), roundTo)
import           Data.Eq (Eq(..))
import qualified Data.Foldable as Foldable
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Ord (Ord(..), Ordering(..))
import           Data.Word (Word8)
import           Prelude (Integer, Integral, Num(..), fromIntegral)
import           Text.Show (Show)

-- * Class 'Zero'
class
 ( Data a
 , Show a
 ) => Zero a where
	quantity_zero :: a
	quantity_null :: a -> Bool
instance
 ( Data unit
 , Show q
 , Show unit
 , Ord  unit
 , Zero q
 ) => Zero (Map unit q) where
	quantity_zero = Map.empty
	quantity_null = Foldable.all quantity_null
instance Zero Integer where
	quantity_zero = 0
	quantity_null = (==) 0
instance Zero Decimal where
	quantity_zero = 0
	quantity_null = (==) 0

quantity_sign :: (Zero q, Ord q) => q -> Ordering
quantity_sign q =
	case q of
	 _ | quantity_null q -> EQ
	 _ | q < quantity_zero -> LT
	 _ -> GT

-- * Class 'Addable'
class (Data a, Show a) => Addable a where
	quantity_add :: a -> a -> a
instance Addable Integer where
	quantity_add = (+)
instance Addable Decimal where
	quantity_add d1 d2 =
		Decimal e (fromIntegral (n1 + n2))
		where (e, n1, n2) = decimal_round_min d1 d2
instance -- Map unit quantity
 ( Addable quantity
 , Data unit
 , Ord  unit
 , Show unit
 ) => Addable (Map unit quantity) where
	quantity_add = Map.unionWith quantity_add

-- * Class 'Negable'
class (Data a, Show a) => Negable a where
	quantity_neg  :: a -> a
instance Negable Integer where
	quantity_neg = negate
instance Negable Decimal where
	quantity_neg = negate
instance -- Map unit quantity
 ( Negable quantity
 , Data    unit
 , Ord     unit
 , Show    unit
 ) => Negable (Map unit quantity) where
	quantity_neg = Map.map quantity_neg

-- * Class 'Subable'
class (Data a, Show a) => Subable a where
	quantity_sub :: a -> a -> a
instance Subable Integer where
	quantity_sub = (-)
instance
 ( Subable quantity
 , Data    unit
 , Ord     unit
 , Show    unit
 ) => Subable (Map unit quantity) where
	quantity_sub = Map.unionWith quantity_sub

-- * Type 'Decimal' (with orphan Data instance)

-- Orphan instance
deriving instance Data Decimal

-- | Round the two 'DecimalRaw' values to the smallest exponent.
decimal_round_min
 :: Integral i
 => DecimalRaw i
 -> DecimalRaw i
 -> (Word8, i, i)
decimal_round_min d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)
	where
		e = min e1 e2
		Decimal _ n1 = roundTo e d1
		Decimal _ n2 = roundTo e d2