{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Format.Ledger.Account.Read where

import           Control.Applicative ((<$>), (<*))
import           Control.Monad (Monad(..))
import           Data.Bool
import           Data.Char
import           Data.Eq (Eq(..))
import           Data.Maybe (Maybe(..))
import           Data.String (fromString)
import           Data.Typeable ()
import           Data.Text (Text)
import           Prelude (($), (.))
import qualified Text.Parsec as R hiding
                  ( char
                  , anyChar
                  , crlf
                  , newline
                  , noneOf
                  , oneOf
                  , satisfy
                  , space
                  , spaces
                  , string
                  , tab
                  )
import           Text.Parsec (Stream, ParsecT, (<|>))

import qualified Hcompta.Account as Account
import qualified Hcompta.Format.Ledger as Ledger
import           Hcompta.Format.Ledger ( Account_Joker
                                       , Account_Joker_Section(..)
                                       , Account_Pattern(..)
                                       )
import qualified Hcompta.Lib.Regex as Regex
import           Hcompta.Lib.Regex (Regex)
import qualified Hcompta.Lib.Parsec as R

-- * Read 'Account'

section_sep :: Char
section_sep = ':'

-- | Read an 'Account'.
account :: Stream s m Char => ParsecT s u m Ledger.Account
account = do
	R.notFollowedBy $ R.space_horizontal
	Account.from_List <$> do
	R.many1_separated section $ R.char section_sep

-- | Read an Account.'Account.Account_Section'.
comment_begin :: Char
comment_begin = ';'

section :: Stream s m Char => ParsecT s u m Text
section = do
	fromString <$> do
	R.many1 $ R.try account_name_char
	where
		account_name_char :: Stream s m Char => ParsecT s u m Char
		account_name_char = do
			c <- R.anyChar
			case c of
			 _ | c == comment_begin -> R.parserZero
			 _ | c == section_sep -> R.parserZero
			 _ | c /= '\t' && R.is_space_horizontal c -> do
				_ <- R.notFollowedBy $ R.space_horizontal
				return c <* (R.lookAhead $ R.try $
				 ( R.try (R.char section_sep)
				 <|> account_name_char
				 ))
			 _ | not (Data.Char.isSpace c) -> return c
			 _ -> R.parserZero

-- | Read an 'Account_Joker_Section'.
joker_section :: Stream s m Char => ParsecT s u m Account_Joker_Section
joker_section = do
	n <- R.option Nothing $ (Just <$> section)
	case n of
	 Nothing -> R.char section_sep >> (return $ Account_Joker_Any)
	 Just n' -> return $ Account_Joker_Section n'

-- | Read an 'Account_Joker'.
joker :: Stream s m Char => ParsecT s u m Account_Joker
joker = do
	R.notFollowedBy $ R.space_horizontal
	R.many1_separated joker_section $ R.char section_sep

-- | Read a 'Regex'.
regex :: Stream s m Char => ParsecT s u m Regex
regex = do
	re <- R.many1 $ R.satisfy (not . R.is_space_horizontal)
	Regex.of_StringM re

-- | Read an 'Account_Filter'.
pattern :: Stream s m Char => ParsecT s u m Account_Pattern
pattern = do
	R.choice_try
	 [ Account_Pattern_Exact <$> (R.char '=' >> account)
	 , Account_Pattern_Joker <$> (R.char '*' >> joker)
	 , Account_Pattern_Regex <$> (R.option '~' (R.char '~') >> regex)
	 ]