module Hcompta.Model.Amount.Quantity where
import Data.Data
-import Data.Typeable ()
+#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
+nil :: Quantity
+is_zero :: Quantity -> Bool
+round :: Word8 -> Quantity -> Quantity
#ifdef DOUBLE
-type T = Double
representation = "Double"
+nil = 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
-type T = Decimal
representation = "Decimal"
-deriving instance Data T
+nil = fromInteger 0
+
+round = Data.Decimal.roundTo
+
+is_zero = (== 0) . decimalMantissa
+--is_zero decimal_places quantity =
+-- (== 0) $ decimalMantissa $
+-- Hcompta.Model.Amount.Quantity.round decimal_places quantity
#endif
+