{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Filter.Amount.Read where

import           Control.Applicative ((<$>), (<*))
import           Control.Monad (Monad(..), guard, void)
import           Data.Bool
import           Data.Char
import           Data.Decimal (DecimalRaw(..))
import qualified Data.List as List
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..))
import           Data.String (String)
import qualified Data.Text as Text
import           Data.Typeable ()
import           Prelude (($), (.), fromIntegral, Num(..), id)
import qualified Text.Parsec as R hiding
                  ( char
                  , anyChar
                  , crlf
                  , newline
                  , noneOf
                  , oneOf
                  , satisfy
                  , space
                  , spaces
                  , string
                  )
import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))

import           Hcompta.Filter.Amount
import qualified Hcompta.Lib.Parsec as R
import qualified Hcompta.Unit as Unit

-- * Read 'Amount'

quantity :: Stream s m Char => ParsecT s u m Quantity
quantity = do
	signing <- sign
	(integral, fractional) <-
		R.choice_try
		 [ try_quantity '_' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
		 , try_quantity '_' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
		 , try_quantity ',' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
		 , try_quantity '.' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
		 ] <?> "quantity"
	let int       = List.concat integral
	let frac      = List.concat fractional
	let precision = List.length frac
	guard (precision <= 255)
	let mantissa = R.integer_of_digits 10 $ int `mappend` frac
	return $
		Decimal
		 (fromIntegral precision)
		 (signing mantissa)
	where
		try_quantity int_group_sep frac_sep frac_group_sep = do
			integral <- do
				h <- R.many R.digit
				case h of
				 [] -> return []
				 _ -> do
					t <- R.many $ R.char int_group_sep >> R.many1 R.digit
					return (h:t)
			fractional <-
				(case integral of
				 [] -> id
				 _ -> R.option []) $ do
					void $ R.char frac_sep
					h <- R.many R.digit
					t <- R.many $ R.char frac_group_sep >> R.many1 R.digit
					return (h:t)
			return ((integral::[String]), (fractional::[String]))

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 =
			Unit . Text.pack <$> 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 =
			Unit . Text.pack <$> do
			R.between (R.char '"') (R.char '"') $
				R.many1 $
					R.noneOf ";\n\""

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

amount :: Stream s m Char => ParsecT s u m Amount
amount = do
	left_signing <- sign
	left_unit <-
		R.option Nothing $ do
			u <- unit
			R.skipMany R.space_horizontal
			return $ Just u
	quantity_ <- quantity
	unit_ <-
		case left_unit of
		 Just u -> return u
		 Nothing ->
			R.option (Unit.unit_empty) $ R.try $ do
				R.skipMany R.space_horizontal
				unit
	return $
		Amount
		 { amount_quantity = left_signing quantity_
		 , amount_unit = unit_
		 }