Correction : Calc.Balance : union => unionWith : évite une éventuelle surprise.
[comptalang.git] / lib / Hcompta / Model / Amount.hs
index 055cb42b7fe37160b04f82af263b13f0c86a4dab..37d8d60aa9a04e473c4f00827aac7ded431f871e 100644 (file)
@@ -1,23 +1,22 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Hcompta.Model.Amount where
 
 import Data.Data
 import qualified Data.List
-import qualified Data.Map
+import qualified Data.Map.Strict as Data.Map
 import qualified Data.Foldable
 import Data.Typeable ()
 
-import qualified Hcompta.Model.Amount.Conversion as Conversion
 import qualified Hcompta.Model.Amount.Quantity as Quantity
 import qualified Hcompta.Model.Amount.Style as Style
 import qualified Hcompta.Model.Amount.Unit as Unit
 
 -- * Type synonyms to submodules
 
-type Conversion = Conversion.Conversion
 type Quantity   = Quantity.Quantity
 type Style      = Style.Style
 type Unit       = Unit.Unit
@@ -26,11 +25,28 @@ type Unit       = Unit.Unit
 
 data Amount
  =   Amount
- { conversion :: Maybe Conversion
- , quantity :: Quantity
+ { quantity :: Quantity
  , style :: Style
  , unit :: Unit
- } deriving (Data, Eq, Ord, Read, Show, Typeable)
+ } deriving (Data, Read, Show, Typeable)
+
+instance Eq Amount where
+       (==)
+        Amount{quantity=q0, unit=u0}
+        Amount{quantity=q1, unit=u1} =
+               case compare u0 u1 of
+                LT -> False
+                GT -> False
+                EQ -> (==) q0 q1 -- NOTE: MUST already be rounded to Style.precision
+
+instance Ord Amount where
+       compare
+        Amount{quantity=q0, unit=u0}
+        Amount{quantity=q1, unit=u1} =
+               case compare u0 u1 of
+                LT -> LT
+                GT -> GT
+                EQ -> compare q0 q1 -- NOTE: MUST already be rounded to Style.precision
 
 -- | An 'Amount' is a partially valid 'Num' instance:
 --
@@ -41,14 +57,21 @@ instance Num Amount where
        fromInteger            = scalar . fromInteger
        negate a@Amount{quantity=q} = a{quantity=negate q}
        signum a@Amount{quantity=q} = a{quantity=signum q}
-       (+) a b = a{ quantity=quantity a + quantity b
-                  , style=Style.union (style a) (style b)
-                  , unit=if unit a == unit b then unit a else error "(+) on non-homogeneous units"
-                  }
-       (*) a b = a{ quantity=quantity a * quantity b
-                  , style=s
-                  , unit=u
-                  }
+       (+) a b =
+               let s@(Style.Style{Style.precision=p}) = Style.union (style a) (style b) in
+               a{ quantity = Quantity.round p $ quantity a + quantity b
+                , style = s
+                , unit =
+                       if unit a == unit b
+                       then unit a
+                       else error "(+) on non-homogeneous units"
+                }
+       (*) a b =
+               let Style.Style{Style.precision=p} = s in
+               a{ quantity = Quantity.round p $ quantity a * quantity b
+                , style = s
+                , unit = u
+                }
                where (s, u) =
                        if unit a == ""
                        then
@@ -60,124 +83,123 @@ instance Num Amount where
                                then (style a, unit a)
                                else error "(*) by non-scalar unit"
 
---- ** Constructors
+-- ** Constructors
 
 nil :: Amount
 nil =
        Amount
-        { conversion = Nothing
-        , quantity = Quantity.nil
+        { quantity = Quantity.nil
         , style = Style.nil
         , unit = ""
         }
 
---- *** From 'Quantity'
+-- *** From 'Quantity'
 
--- | Return an empty 'Unit' 'Amount'.
+-- | Return an 'Amount' with 'unit' = Unit.'Unit.nil'.
 scalar :: Quantity -> Amount
 scalar q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just '.'
-                , Style.format=Just $ Style.Format ',' [3]
-                , Style.precision=maxBound
-                , Style.unit_side=Just Style.Side_Right
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just '.'
+                , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping ',' [3]
+                , Style.precision = maxBound
+                , Style.unit_side = Just Style.Side_Right
+                , Style.unit_spaced = Just False
                 }
-        , unit=""
+        , unit = ""
         }
 
 -- | <https://en.wikipedia.org/wiki/Swiss_franc Swiss franc> unit of currency.
 chf :: Quantity -> Amount
 chf q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just ','
-                , Style.format=Just $ Style.Format '.' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Right
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just ','
+                , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping '.' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Right
+                , Style.unit_spaced = Just False
                 }
-        , unit="CHF"
+        , unit = "CHF"
         }
 -- | <https://en.wikipedia.org/wiki/Yuan Yuan> unit of currency.
 cny :: Quantity -> Amount
 cny q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just ','
-                , Style.format=Just $ Style.Format '.' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Right
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just ','
+                , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping '.' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Right
+                , Style.unit_spaced = Just False
                 }
-        , unit="Ұ"
+        , unit = "Ұ"
         }
 -- | <https://en.wikipedia.org/wiki/Euro Euro> unit of currency.
 eur :: Quantity -> Amount
 eur q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just ','
-                , Style.format=Just $ Style.Format '.' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Right
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just ','
+                , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping '.' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Right
+                , Style.unit_spaced = Just False
                 }
-        , unit="€"
+        , unit = "€"
         }
 -- | <https://en.wikipedia.org/wiki/Pound_sterling Pound sterling> unit of currency.
 gbp :: Quantity -> Amount
 gbp q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just '.'
-                , Style.format=Just $ Style.Format ',' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Left
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just '.'
+                , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping ',' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Left
+                , Style.unit_spaced = Just False
                 }
-        , unit="£"
+        , unit = "£"
         }
 -- | <https://en.wikipedia.org/wiki/Indian_rupee Indian rupee> unit of currency.
 inr :: Quantity -> Amount
 inr q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just ','
-                , Style.format=Just $ Style.Format '.' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Right
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just ','
+                , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping '.' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Right
+                , Style.unit_spaced = Just False
                 }
-        , unit="₹"
+        , unit = "₹"
         }
 -- | <https://en.wikipedia.org/wiki/Japanese_yen Japanese yen> unit of currency.
 jpy :: Quantity -> Amount
 jpy q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just '.'
-                , Style.format=Just $ Style.Format ',' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Left
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just '.'
+                , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping ',' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Left
+                , Style.unit_spaced = Just False
                 }
-        , unit="¥"
+        , unit = "¥"
         }
 -- | <https://en.wikipedia.org/wiki/Russian_ruble Russian ruble> unit of currency.
 --
@@ -188,52 +210,49 @@ jpy q =
 rub :: Quantity -> Amount
 rub q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just '.'
-                , Style.format=Just $ Style.Format ',' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Left
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just '.'
+                , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+                , Style.grouping_integral   = Just $ Style.Grouping ',' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Left
+                , Style.unit_spaced = Just False
                 }
-        , unit="Ꝑ"
+        , unit = "Ꝑ"
         }
 -- | <https://en.wikipedia.org/wiki/United_States_dollar United States dollar> unit of currency.
 usd :: Quantity -> Amount
 usd q =
        Amount
-        { conversion=Nothing
-        , quantity=q
-        , style=Style.Style
-                { Style.decimal_point=Just '.'
-                , Style.format=Just $ Style.Format ',' [3]
-                , Style.precision=2
-                , Style.unit_side=Just Style.Side_Left
-                , Style.unit_spaced=Just False
+        { quantity = q
+        , style = Style.Style
+                { Style.fractioning = Just '.'
+                , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+                , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+                , Style.precision = 2
+                , Style.unit_side = Just Style.Side_Left
+                , Style.unit_spaced = Just False
                 }
-        , unit="$"
+        , unit = "$"
         }
 
---- ** Tests
+-- ** Tests
 
--- | Return 'True' if and only if 'Amount'’s 'Quantity' is zero at 'Style'’s precision.
+-- | Return 'True' if and only if 'Amount'’s 'Quantity' is zero.
+--
+--  NOTE: the 'Amount'’s 'quantity' MUST be have been rounded at 'Amount'’s 'style'’s 'Style.precision'.
 is_zero :: Amount -> Bool
-is_zero amount =
-       Quantity.is_zero
-        (Style.precision $ style amount) $
-       quantity amount
+is_zero = Quantity.is_zero . quantity
 
 -- * The 'By_Unit' mapping
 
--- | 'By_Unit'’s is a partially valid 'Num' instance:
---
---   * (*) operator is not defined.
 type By_Unit
  = Data.Map.Map Unit Amount
 
--- XXX: haddock drops this instance
 -- | 'By_Unit'’s is a partially valid 'Num' instance.
+--
+--   * (*) operator is not defined.
 instance Num By_Unit where
        abs         = Data.Map.map (\a@Amount{quantity=q} -> a{quantity=abs    q})
        fromInteger = Data.Map.singleton "" . fromInteger
@@ -242,6 +261,17 @@ instance Num By_Unit where
        (+)         = Data.Map.unionWith (+)
        (*)         = error "(*) not-supported"
 
+type Signs = (Int, Int)
+
+signs :: By_Unit -> Signs
+signs = Data.Map.foldl
+ (\(nega, plus) amt ->
+       case flip compare 0 $ quantity amt of
+        LT -> (nega - 1, plus)
+        EQ -> (nega, plus)
+        GT -> (nega, plus + 1))
+ (0, 0)
+
 -- ** Constructors
 
 nil_By_Unit :: By_Unit
@@ -250,7 +280,7 @@ nil_By_Unit =
 
 -- ** Tests
 
--- | Return 'True' if and only if all 'Amount's are zero at their 'Style'’s precision.
+-- | Return 'True' if and only if all 'Amount's satisfy 'is_zero'.
 are_zero :: By_Unit -> Bool
 are_zero = Data.Foldable.all is_zero
 
@@ -261,5 +291,5 @@ assoc_by_unit amount = (unit amount, amount)
 -- | Return a 'Data.Map.Map' associating the given 'Amount's with their respective 'Unit'.
 from_List :: [Amount] -> By_Unit
 from_List amounts =
-       Data.Map.fromListWith (+) $
+       Data.Map.fromListWith (flip (+)) $ -- NOTE: flip to propagate 'Style' first to last.
        Data.List.map assoc_by_unit amounts