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

import           Data.Decimal (DecimalRaw(..))
import qualified Data.List
import           Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import qualified Data.Text as Text
import qualified Hcompta.Lib.Leijen as W
import           Hcompta.Lib.Leijen (Doc, (<>))
import           GHC.Exts (Int(..))
import           GHC.Integer.Logarithms (integerLogBase#)

import qualified Hcompta.Amount as Amount
import           Hcompta.Amount (Amount)
import qualified Hcompta.Amount.Quantity as Quantity
import           Hcompta.Amount.Quantity (Quantity)
import qualified Hcompta.Amount.Style as Amount.Style
import qualified Hcompta.Amount.Unit as Unit
import           Hcompta.Amount.Unit (Unit)

-- * Write 'Amount'

amount :: Amount -> Doc
amount Amount.Amount
 { Amount.quantity=qty
 , Amount.style = sty@(Amount.Style.Style
	 { Amount.Style.unit_side
	 , Amount.Style.unit_spaced
	 })
 , Amount.unit=unit_
 } = do
	case unit_side of
	 Just Amount.Style.Side_Left ->
		(unit unit_)
		<> (case unit_spaced of { Just True | unit_ /= "" -> W.space; _ -> W.empty })
	 _ -> W.empty
	<> quantity sty qty
	<> case unit_side of
	 (Just Amount.Style.Side_Right) ->
		(case unit_spaced of { Just True | unit_ /= "" -> W.space; _ -> W.empty })
		<> unit unit_
	 Nothing ->
		(case unit_spaced of { Just True | unit_ /= "" -> W.space; _ -> W.empty })
		<> unit unit_
	 _ -> W.empty

unit :: Unit -> Doc
unit = W.yellow . W.strict_text . Unit.text

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

-- ** Measure 'Amount'

amount_length :: Amount -> Int
amount_length Amount.Amount
 { Amount.quantity = qty
 , Amount.style = sty@(Amount.Style.Style
	 { Amount.Style.unit_spaced
	 })
 , Amount.unit = unit_
 } = do
	Unit.length unit_
	+ (case unit_spaced of { Just True | unit_ /= "" -> 1; _ -> 0 })
	+ quantity_length sty qty

quantity_length :: Amount.Style -> Quantity -> Int
quantity_length Amount.Style.Style
 { Amount.Style.grouping_integral
 , Amount.Style.grouping_fractional
 , Amount.Style.precision
 } qty =
	let Decimal e n = Quantity.round precision 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 precision) 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