{-# 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.Strict as Data.Map
import qualified Data.Foldable
import Data.Typeable ()

import qualified Hcompta.Calc.Balance as Calc.Balance
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 Quantity   = Quantity.Quantity
type Style      = Style.Style
type Unit       = Unit.Unit

-- * The 'Amount' type

data Amount
 =   Amount
 { quantity :: Quantity
 , style :: Style
 , unit :: Unit
 } 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

instance Calc.Balance.Amount Amount where
	amount_is_zero = is_zero

-- | An 'Amount' is a partially valid 'Num' instance:
--
--   * (+) operator requires both operand to have the same 'Unit' (homogeneity constraint).
--   * (*) operator requires at least one operand with an empty 'Unit' ('scalar').
instance Num Amount where
	abs    a@Amount{quantity=q} = a{quantity=abs q}
	fromInteger            = scalar . fromInteger
	negate a@Amount{quantity=q} = a{quantity=negate q}
	signum a@Amount{quantity=q} = a{quantity=signum q}
	(+) 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
				if unit b == ""
				then (Style.union (style a) (style b), "")
				else (style b, unit b)
			else
				if unit b == ""
				then (style a, unit a)
				else error "(*) by non-scalar unit"

-- ** Constructors

nil :: Amount
nil =
	Amount
	 { quantity = Quantity.nil
	 , style = Style.nil
	 , unit = ""
	 }

-- *** From 'Quantity'

-- | Return an 'Amount' with 'unit' = Unit.'Unit.nil'.
scalar :: Quantity -> Amount
scalar q =
	Amount
	 { 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 = ""
	 }

-- | <https://en.wikipedia.org/wiki/Swiss_franc Swiss franc> unit of currency.
chf :: Quantity -> Amount
chf q =
	Amount
	 { 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"
	 }
-- | <https://en.wikipedia.org/wiki/Yuan Yuan> unit of currency.
cny :: Quantity -> Amount
cny q =
	Amount
	 { 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 = "Ұ"
	 }
-- | <https://en.wikipedia.org/wiki/Euro Euro> unit of currency.
eur :: Quantity -> Amount
eur q =
	Amount
	 { 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 = "€"
	 }
-- | <https://en.wikipedia.org/wiki/Pound_sterling Pound sterling> unit of currency.
gbp :: Quantity -> Amount
gbp q =
	Amount
	 { 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 = "£"
	 }
-- | <https://en.wikipedia.org/wiki/Indian_rupee Indian rupee> unit of currency.
inr :: Quantity -> Amount
inr q =
	Amount
	 { 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 = "₹"
	 }
-- | <https://en.wikipedia.org/wiki/Japanese_yen Japanese yen> unit of currency.
jpy :: Quantity -> Amount
jpy q =
	Amount
	 { 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 = "¥"
	 }
-- | <https://en.wikipedia.org/wiki/Russian_ruble Russian ruble> unit of currency.
--
-- NOTE: Ꝑ (U+A750) is used as a replacement latin letter,
--       because GHC currently chokes on ₽ (U+20BD),
--       which is the recently (2014/02) assigned Unicode code-point
--       for this currency.
rub :: Quantity -> Amount
rub q =
	Amount
	 { 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 = "Ꝑ"
	 }
-- | <https://en.wikipedia.org/wiki/United_States_dollar United States dollar> unit of currency.
usd :: Quantity -> Amount
usd q =
	Amount
	 { 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 = "$"
	 }

-- ** Tests

-- | 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 = Quantity.is_zero . quantity

-- * The 'By_Unit' mapping

type By_Unit
 = Data.Map.Map Unit Amount

-- | '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
	negate      = Data.Map.map (\a@Amount{quantity=q} -> a{quantity=negate q})
	signum      = Data.Map.map (\a@Amount{quantity=q} -> a{quantity=signum q})
	(+)         = 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
nil_By_Unit =
	Data.Map.empty

-- ** Tests

-- | 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 tuple associating the given 'Amount' with its 'Unit'.
assoc_by_unit :: Amount -> (Unit, Amount)
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 (flip (+)) $ -- NOTE: flip to propagate 'Style' first to last.
	Data.List.map assoc_by_unit amounts