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

import           Data.Decimal (DecimalRaw(..))
import           Data.Bool
import           Data.Char (Char)
import           Data.List hiding (group)
import           Data.Maybe (Maybe(..), fromMaybe, maybe)
import           Data.Ord (Ord(..))
import           Data.Eq (Eq(..))
import qualified Data.Text.Lazy as TL
import qualified Data.Text as Text
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.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)
import qualified Hcompta.Lib.Leijen as W
import           Hcompta.Lib.Leijen (Doc, (<>))

-- * 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 = 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 null 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