{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hcompta.Model.Amount.Read where

import           Control.Monad (guard)
import           Control.Applicative ((<$>), (<|>), (<*))
import qualified Data.Char
import qualified Data.Decimal
import qualified Data.List
import           Data.String (fromString)
import           Data.Typeable ()
import qualified Text.Parsec as R hiding
                  ( char
                  , noneOf
                  , oneOf
                  , satisfy
                  )
import           Text.Parsec (Stream, ParsecT, (<?>))

import qualified Hcompta.Model.Amount as Amount
import           Hcompta.Model.Amount (Amount, Unit)
import qualified Hcompta.Model.Amount.Style as Style
import qualified Hcompta.Model.Amount.Unit as Unit
import qualified Hcompta.Lib.Parsec as R

-- * Read 'Quantity'
data Quantity
 =   Quantity
 { integral :: [String]
 , fractional :: [String]
 , fractioning :: Maybe Style.Fractioning
 , grouping_integral :: Maybe Style.Grouping
 , grouping_fractional :: Maybe Style.Grouping
 }

quantity
 :: Stream s m Char
 => Char -- ^ Integral grouping separator.
 -> Char -- ^ Fractioning separator.
 -> Char -- ^ Fractional grouping separator.
 -> ParsecT s u m Quantity
quantity int_group_sep frac_sep frac_group_sep = do
	(integral, grouping_integral) <- do
		h <- R.many R.digit
		case h of
		 [] -> return ([], Nothing)
		 _ -> do
			t <- R.many $ R.char int_group_sep >> R.many1 R.digit
			let digits = h:t
			return (digits, grouping_of_digits int_group_sep digits)
	(fractional, fractioning, grouping_fractional) <-
		(case integral of
		 [] -> id
		 _ -> R.option ([], Nothing, Nothing)) $ do
			fractioning <- R.char frac_sep
			h <- R.many R.digit
			t <- R.many $ R.char frac_group_sep >> R.many1 R.digit
			let digits = h:t
			return (digits, Just fractioning
			 , grouping_of_digits frac_group_sep $ reverse digits)
	return $
		Quantity
		 { integral
		 , fractional
		 , fractioning
		 , grouping_integral
		 , grouping_fractional
		 }
	where
		grouping_of_digits :: Char -> [String] -> Maybe Style.Grouping
		grouping_of_digits group_sep digits =
			case digits of
			 []  -> Nothing
			 [_] -> Nothing
			 _   -> Just $
				Style.Grouping group_sep $
				canonicalize_grouping $
				map length $ digits
		canonicalize_grouping :: [Int] -> [Int]
		canonicalize_grouping groups =
			foldl -- NOTE: remove duplicates at beginning and reverse.
			 (\acc l0 -> case acc of
				 l1:_ -> if l0 == l1 then acc else l0:acc
				 _ -> l0:acc) [] $
			case groups of -- NOTE: keep only longer at beginning.
			 l0:l1:t -> if l0 > l1 then groups else l1:t
			 _ -> groups

-- * Read 'Unit'
unit :: Stream s m Char => ParsecT s u m Unit
unit =
	(quoted <|> unquoted) <?> "unit"
	where
		unquoted :: Stream s m Char => ParsecT s u m Unit
		unquoted =
			fromString <$> do
			R.many1 $
				R.satisfy $ \c ->
					case Data.Char.generalCategory c of
					 Data.Char.CurrencySymbol  -> True
					 Data.Char.LowercaseLetter -> True
					 Data.Char.ModifierLetter  -> True
					 Data.Char.OtherLetter     -> True
					 Data.Char.TitlecaseLetter -> True
					 Data.Char.UppercaseLetter -> True
					 _ -> False
		quoted :: Stream s m Char => ParsecT s u m Unit
		quoted =
			fromString <$> do
			R.between (R.char '"') (R.char '"') $
				R.many1 $
					R.noneOf ";\n\""

-- * Read 'Amount'
amount :: Stream s m Char => ParsecT s u m Amount
amount = do
	left_signing <- sign
	left_unit <-
		R.option Nothing $ do
			u <- unit
			s <- R.many $ R.space_horizontal
			return $ Just $ (u, not $ null s)
	(quantity_, style) <- do
		signing <- sign
		Quantity
		 { integral
		 , fractional
		 , fractioning
		 , grouping_integral
		 , grouping_fractional
		 } <-
			R.choice_try
			 [ quantity '_' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
			 , quantity '_' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
			 , quantity ',' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
			 , quantity '.' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
			 ] <?> "quantity"
		let int = Data.List.concat integral
		let frac_flat = Data.List.concat fractional
		let frac = reverse $ Data.List.dropWhile (== '0') $ reverse $ frac_flat
		let place = length frac
		guard (place <= 255)
		let mantissa = R.integer_of_digits 10 $ int ++ frac
		return $
		 ( Data.Decimal.Decimal
			 (fromIntegral place)
			 (signing mantissa)
		 , Style.nil
			 { Style.fractioning
			 , Style.grouping_integral
			 , Style.grouping_fractional
			 , Style.precision = fromIntegral $ length frac_flat
			 }
		 )
	(unit_, unit_side, unit_spaced) <-
		case left_unit of
		 Just (u, s) ->
			return (u, Just Style.Side_Left, Just s)
		 Nothing ->
			R.option (Unit.nil, Nothing, Nothing) $ R.try $ do
				s <- R.many $ R.space_horizontal
				u <- unit
				return $ (u, Just Style.Side_Right, Just $ not $ null s)
	return $
		Amount.Amount
		 { Amount.quantity = left_signing $ quantity_
		 , Amount.style = style
			 { Style.unit_side
			 , Style.unit_spaced
			 }
		 , Amount.unit = unit_
		 }

-- | Parse either '-' into 'negate', or '+' or '' into 'id'.
sign :: (Stream s m Char, Num i) => ParsecT s u m (i -> i)
sign =
	    (R.char '-' >> return negate)
	<|> (R.char '+' >> return id)
	<|> return id