{-# 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
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:
--
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
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.
--
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
(+) = 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
-- ** 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
-- | 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