{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.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.Balance as Balance
import qualified Hcompta.Amount.Quantity as Quantity
import qualified Hcompta.Amount.Style as Style
import qualified Hcompta.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, 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 Balance.Amount Amount where
	type Amount_Unit Amount = Unit
	amount_null = (==) Quantity.zero . quantity
	amount_add = (+)
	amount_negate = negate
	amount_positive a =
		case compare (quantity a) Quantity.zero of
		 LT -> Nothing
		 EQ -> Nothing
		 _  -> Just a
	amount_negative a =
		case compare (quantity a) Quantity.zero of
		 GT -> Nothing
		 EQ -> Nothing
		 _  -> Just a

-- | 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.zero
	 , 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 'Amount_by_Unit' mapping

type Amount_by_Unit
 = Data.Map.Map Unit Amount
type By_Unit = Amount_by_Unit

-- | 'Amount_by_Unit'’s is a partially valid 'Num' instance.
--
--   * (*) operator is not defined.
instance Num Amount_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 :: Amount_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 :: Amount_by_Unit
nil_By_Unit =
	Data.Map.empty

-- ** Tests

-- | Return 'True' if and only if all 'Amount's satisfy 'is_zero'.
are_zero :: Amount_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] -> 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