{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Format.Ledger.Amount where

import           Control.DeepSeq
import           Data.Bool
import           Data.Data
import           Data.Eq (Eq(..))
-- import qualified Data.Foldable
-- import qualified Data.List
-- import           Data.Map.Strict (Map)
import           Data.Ord (Ord(..), Ordering(..))
-- import           Data.String (IsString)
-- import           Data.Text (Text)
-- import qualified Data.Text as Text
import           Data.Typeable ()
import           Prelude ((.), seq)
-- import           Prelude (($), (.), Bounded(..), Int, Num(..), flip, seq, error)
import           Text.Show (Show(..))

import qualified Hcompta.Amount as Amount
import qualified Hcompta.Filter as Filter
import qualified Hcompta.Polarize as Polarize
import qualified Hcompta.Quantity as Quantity
import qualified Hcompta.Unit as Unit
import qualified Hcompta.Format.Ledger.Amount.Style as Style
import           Hcompta.Format.Ledger.Quantity (Quantity)
import           Hcompta.Format.Ledger.Unit (Unit(..))

-- * Type 'Style'

type Style    = Style.Style
type Styles   = Style.Styles
type Styled t = Style.Styled t

-- * Type 'Amount'

data Amount
 =   Amount
 { amount_unit     :: !Unit
 , amount_quantity :: !Quantity
 } deriving (Data, Show, Typeable)
instance Amount.Amount Amount where
	type Amount_Quantity Amount = Quantity
	type Amount_Unit     Amount = Unit
	amount_quantity = amount_quantity
	amount_unit     = amount_unit
instance Filter.Amount Amount where
	type Amount_Quantity Amount = Quantity
	type Amount_Unit     Amount = Unit
	amount_quantity = Polarize.polarize . amount_quantity
	amount_unit     = amount_unit
instance NFData Amount where
	rnf (Amount q u) = rnf q `seq` rnf u
{-
instance Eq Amount where
	(==)
	 Amount{amount_quantity=q0, amount_unit=u0}
	 Amount{amount_quantity=q1, amount_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{amount_quantity=q0, amount_unit=u0}
	 Amount{amount_quantity=q1, amount_unit=u1} =
		case compare u0 u1 of
		 LT -> LT
		 GT -> GT
		 EQ -> compare q0 q1 -- NOTE: MUST already be rounded to Style.precision
-}
instance Quantity.Zero Amount where
	quantity_zero = Amount Unit.unit_empty Quantity.quantity_zero
	quantity_null = (==) Quantity.quantity_zero . amount_quantity

amount_style :: Styles -> Amount -> Style
amount_style styles = Style.style styles . amount_unit

style :: Styles -> Amount -> Styled Amount
style styles amt = (amount_style styles amt, amt)

{-
instance GL.Amount Amount where
	type Amount_Unit Amount = Unit
	amount_add = (+)
instance GL.Amount (Map Unit Amount) where
	type Amount_Unit (Map Unit Amount) = Unit
	amount_add = Data.Map.unionWith (+)
-}

{-
-- | 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{amount_quantity=q} = a{amount_quantity=abs q}
	fromInteger                        = scalar . fromInteger
	negate a@Amount{amount_quantity=q} = a{amount_quantity=negate q}
	signum a@Amount{amount_quantity=q} = a{amount_quantity=signum q}
	(+) a b =
		let s@(Style.Style{Style.precision=p}) = Style.union (amount_style a) (amount_style b) in
		a{ amount_quantity = quantity_round p $ amount_quantity a + amount_quantity b
		 , amount_style = s
		 , amount_unit =
			if amount_unit a == amount_unit b
			then amount_unit a
			else error "(+) on non-homogeneous units"
		 }
	(*) a b =
		let Style.Style{Style.precision=p} = s in
		a{ amount_quantity = quantity_round p $ amount_quantity a * amount_quantity b
		 , amount_style = s
		 , amount_unit = u
		 }
		where (s, u)
			| amount_unit a == "" =
				if amount_unit b == ""
				then (Style.union (amount_style a) (amount_style b), "")
				else (amount_style b, amount_unit b)
			| amount_unit b == "" = (amount_style a, amount_unit a)
			| otherwise = error "(*) by non-scalar amount_unit"
-}

sign :: Amount -> Ordering
sign a =
	case amount_quantity a of
	 0         -> EQ
	 q | q < 0 -> LT
	 _         -> GT

-- ** Constructors

amount :: Amount
amount =
	Amount
	 { amount_quantity = Quantity.quantity_zero
	 , amount_unit     = ""
	 }


-- ** Tests

-- | Return 'True' if and only if 'Amount'’s 'Quantity' is zero.
--
--  NOTE: the 'Amount'’s 'amount_quantity' MUST have been rounded
--        at 'Amount'’s 'amount_style'’s 'Style.precision'.
null :: Amount -> Bool
null = Quantity.quantity_null . amount_quantity

{-
-- * Type 'Amount_by_Unit' mapping

type Amount_by_Unit
 = 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{amount_quantity=q} -> a{amount_quantity=abs    q})
	fromInteger = Data.Map.singleton "" . fromInteger
	negate      = Data.Map.map (\a@Amount{amount_quantity=q} -> a{amount_quantity=negate q})
	signum      = Data.Map.map (\a@Amount{amount_quantity=q} -> a{amount_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 $ amount_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 'null'.
nulls :: Amount_by_Unit -> Bool
nulls = Data.Foldable.all null

-- | Return a tuple associating the given 'Amount' with its 'Unit'.
assoc_by_unit :: Amount -> (Unit, Amount)
assoc_by_unit amt = (amount_unit amt, amt)

-- | 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

-}