{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Hcompta.Format.Ledger.Amount.Write where

import           Data.Bool
import           Data.Char (Char)
import           Data.Decimal (DecimalRaw(..))
import           Data.Eq (Eq(..))
import qualified Data.List as List
import           Data.Maybe (Maybe(..), fromMaybe, maybe)
import           Data.Ord (Ord(..))
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import           Data.Tuple (fst)
import           GHC.Exts (Int(..))
import           GHC.Integer.Logarithms (integerLogBase#)
import           Prelude (($), (.), Num(..), Show(..), flip, fromIntegral, id)

import qualified Hcompta.Amount as Amount
import           Hcompta.Format.Ledger.Amount (Amount(..))
import qualified Hcompta.Format.Ledger.Amount as Ledger.Amount
import qualified Hcompta.Format.Ledger.Amount.Style as Amount.Style
import           Hcompta.Format.Ledger.Quantity (Quantity)
import qualified Hcompta.Format.Ledger.Quantity as Ledger.Quantity
import qualified Hcompta.Format.Ledger.Unit as Ledger.Unit
import           Hcompta.Lib.Leijen (Doc, (<>))
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Unit as Unit

-- * Write 'Amount'
amount :: Amount.Style.Styled Amount -> Doc
amount
 ( sty@(Amount.Style.Style
	 { Amount.Style.unit_side
	 , Amount.Style.unit_spaced
	 })
 , amt ) =
	let unt = Amount.amount_unit amt in
	case unit_side of
	 Just Amount.Style.Side_Left ->
		unit unt <>
		case unit_spaced of
		 Just True | unt /= Unit.unit_empty -> W.space
		 _ -> W.empty
	 _ -> W.empty
	<> quantity (sty, Amount.amount_quantity amt)
	<> case unit_side of
	 (Just Amount.Style.Side_Right) ->
		(case unit_spaced of
		 Just True | unt /= Unit.unit_empty -> W.space
		 _ -> W.empty) <>
		unit unt
	 Nothing ->
		(case unit_spaced of
		 Just True | unt /= Unit.unit_empty -> W.space
		 _ -> W.empty) <>
		unit unt
	 _ -> W.empty

amount_length :: Ledger.Amount.Styled Amount -> Int
amount_length (sty@(Amount.Style.Style { Amount.Style.unit_spaced }), amt) =
	let unt = Amount.amount_unit amt in
	Ledger.Unit.unit_length unt
	+ (case unit_spaced of { Just True | unt /= Unit.unit_empty -> 1; _ -> 0 })
	+ quantity_length sty (Amount.amount_quantity amt)

-- * Write 'Unit'
unit :: Ledger.Unit.Unit -> Doc
unit = W.yellow . W.strict_text . Unit.unit_text

-- * Write 'Quantity'
quantity :: Ledger.Amount.Styled Quantity -> Doc
quantity
 ( Amount.Style.Style
	 { Amount.Style.fractioning
	 , Amount.Style.grouping_integral
	 , Amount.Style.grouping_fractional
	 }
 , qty ) = do
	let Decimal e n = qty
	let num = show $ abs $ n
	let sign = W.bold $ W.yellow $ W.strict_text (if n < 0 then "-" else "")
	case e == 0 of
	 True  -> sign <> do W.bold $ W.blue $ (W.strict_text $ Text.pack num)
	 False -> do
		let num_len = List.length num
		let padded =
			List.concat
			 [ List.replicate (fromIntegral e + 1 - num_len) '0'
			 , num
			 -- , replicate (fromIntegral precision - fromIntegral e) '0'
			 ]
		let (int, frac) = List.splitAt (max 1 (num_len - fromIntegral e)) padded
		let default_fractioning =
			List.head $
			del_grouping_sep grouping_integral $
			del_grouping_sep grouping_fractional $
			['.', ',']
		sign <> do
		W.bold $ W.blue $ do
			W.text (TL.pack $ maybe id
			 (\g -> List.reverse . group g . List.reverse)
			 grouping_integral $ int) <> do
			(W.yellow $ W.char (fromMaybe default_fractioning fractioning)) <> do
			W.text (TL.pack $ maybe id group grouping_fractional frac)
	where
		group :: Amount.Style.Grouping -> [Char] -> [Char]
		group (Amount.Style.Grouping sep sizes_) =
			List.concat . List.reverse .
			List.map List.reverse . fst .
			List.foldl'
			 (flip (\digit x -> case x of
				 ([], sizes) -> ([[digit]], sizes)
				 (digits:groups, []) -> ((digit:digits):groups, [])
				 (digits:groups, curr_sizes@(size:sizes)) ->
					if List.length digits < size
					then (      (digit:digits):groups, curr_sizes)
					else ([digit]:[sep]:digits:groups, if List.null sizes then curr_sizes else sizes)
			 ))
			 ([], sizes_)
		del_grouping_sep grouping =
			case grouping of
			 Just (Amount.Style.Grouping sep _) -> List.delete sep
			 _ -> id

quantity_length :: Ledger.Amount.Style -> Ledger.Quantity.Quantity -> Int
quantity_length Amount.Style.Style
 { Amount.Style.grouping_integral
 , Amount.Style.grouping_fractional
 } qty =
	let Decimal e n     = qty in
	let sign_len        = if n < 0 then 1 else 0 in
	let fractioning_len = if e > 0 then 1 else 0 in
	let num_len         = if n == 0 then 0 else (1 +) $ I# (integerLogBase# 10 (abs n)) in
	let pad_left_len    = max 0 (fromIntegral e + 1 - num_len) in
	-- let pad_right_len   = max 0 (fromIntegral precision - fromIntegral e) in
	let padded_len      = pad_left_len + num_len {-+ pad_right_len-} in
	let int_len         = max 1 (num_len - fromIntegral e) in
	let frac_len        = max 0 (padded_len - int_len) in
	( sign_len
	+ fractioning_len
	+ padded_len
	+ maybe 0 (group int_len)  grouping_integral
	+ maybe 0 (group frac_len) grouping_fractional
	)
	where
		group :: Int -> Amount.Style.Grouping -> Int
		group num_len (Amount.Style.Grouping _sep sizes_) =
			if num_len <= 0
			then 0
			else loop 0 num_len sizes_
			where
				loop :: Int -> Int -> [Int] -> Int
				loop pad len =
					\x -> case x of
					 [] -> 0
					 sizes@[size] ->
						let l = len - size in
						if l <= 0 then pad
						else loop (pad + 1) l sizes
					 size:sizes ->
						let l = len - size in
						if l <= 0 then pad
						else loop (pad + 1) l sizes