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

import Data.Data
#ifdef DOUBLE
#else
import Data.Decimal
#endif
import Data.Word
import Data.Typeable ()

#ifdef DOUBLE
type Quantity
 = Double
#else
type Quantity
 = Decimal
deriving instance Data Quantity
#endif

representation :: String
zero :: Quantity
is_zero :: Quantity -> Bool
round :: Word8 -> Quantity -> Quantity
#ifdef DOUBLE
representation = "Double"
zero = 0.0

round n f = fromInteger $ round $ (f * (10^n)) / (10.0^^n)

is_zero = (== 0) . decimalMantissa
--is_zero decimal_places quantity =
--	floor quantity == 0 && -- NOTE: check integral part, in case of an overflow in roundTo'
--	0 == roundTo' decimal_places quantity
--	where
--		roundTo' n f = fromInteger $ round $ f * (10 ^ n)

#else
representation = "Decimal"
zero = 0

round = Data.Decimal.roundTo

is_zero = (== 0) . decimalMantissa
--is_zero decimal_places quantity =
--	(== 0) $ decimalMantissa $
--	Hcompta.Amount.Quantity.round decimal_places quantity
#endif