{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Filter.Amount where
import           Data.Data
import           Data.Decimal (Decimal, DecimalRaw(..), roundTo)
import           Data.Eq (Eq(..))
import           Data.Maybe (Maybe(..))
import           Data.Ord (Ord(..))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Typeable ()
import           Data.Word (Word8)
import           Prelude ((.), Integral, Num(..), fromIntegral)
import           Text.Show (Show(..))

import           Hcompta.Quantity
import qualified Hcompta.Filter as Filter
import           Hcompta.Polarize
import qualified Hcompta.Unit as Unit

-- * Type 'Quantity'
type Quantity = Decimal
deriving instance Data Quantity

-- | Round the two 'DecimalRaw' values to the smallest exponent.
round_min :: Integral i => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
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

instance Zero Quantity where
	quantity_zero = 0
	quantity_null = (==) 0
instance Addable Quantity where
	quantity_add d1 d2 =
		Decimal e (fromIntegral (n1 + n2))
		where (e, n1, n2) = round_min d1 d2
instance Negable Quantity where
	quantity_neg = negate
instance Polarizable Quantity where
	polarizable_negative q =
		case q of
		 _ | q < 0 -> Just q
		 _         -> Nothing
	polarizable_positive q =
		case q of
		 _ | q <= 0 -> Nothing
		 _          -> Just q

-- * Type 'Unit'
newtype Unit
 =      Unit Text
 deriving (Data, Eq, Ord, Show, Typeable)

instance Unit.Unit Unit where
	unit_empty = Unit (Text.pack "")
	unit_text (Unit t) = t

-- * Type 'Amount'
data Amount
 =   Amount
 { amount_unit     :: Unit
 , amount_quantity :: Quantity
 } deriving (Data, Eq, Show, Typeable)
instance Filter.Amount Amount where
	type Amount_Unit     Amount = Unit
	type Amount_Quantity Amount = Quantity
	amount_quantity = polarize . amount_quantity
	amount_unit     = amount_unit