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

import           Control.Applicative ((<$>), (<*>), (<*))
import           Control.Arrow ((***), first)
import           Control.DeepSeq (NFData(..))
import qualified Control.Exception as Exception
import           Control.Monad (Monad(..), guard, liftM, join, forM, void)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (ExceptT(..), throwE)
import           Data.Bool
import           Data.Char (Char, isSpace)
import           Data.Either (Either(..), either)
import           Data.Eq (Eq(..))
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..), fromMaybe, maybe)
import           Data.Monoid (Monoid(..))
import           Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO (readFile)
import qualified Data.Time.Calendar  as Time
import qualified Data.Time.Clock     as Time
import qualified Data.Time.LocalTime as Time
import           Data.Typeable ()
import           Prelude (($), (.), IO, FilePath, const, flip, id)
import qualified System.FilePath.Posix as Path
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 Text.Parsec.Pos as R
import           Text.Show (Show)

-- import qualified Hcompta.Account as Account
import qualified Hcompta.Amount as Amount
import qualified Hcompta.Balance as Balance
import qualified Hcompta.Chart as Chart
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter.Date.Read as Date.Read
import           Hcompta.Format.Ledger
                  ( Account
                  , Comment
                  , Journal(..)
                  , Posting(..)
                  , Transaction(..)
                  , Chart_With(..)
                  )
import qualified Hcompta.Format.Ledger as Ledger
import qualified Hcompta.Format.Ledger.Account.Read as Ledger.Account.Read
import qualified Hcompta.Format.Ledger.Amount as Ledger.Amount
import qualified Hcompta.Format.Ledger.Amount.Read as Ledger.Amount.Read
import qualified Hcompta.Format.Ledger.Amount.Style as Ledger.Amount.Style
-- import qualified Hcompta.Format.Ledger.Quantity as Ledger.Quantity
import           Hcompta.Lib.Consable (Consable(..))
import qualified Hcompta.Lib.Parsec as R
import qualified Hcompta.Lib.Path as Path
import           Hcompta.Lib.Regex (Regex)
import qualified Hcompta.Lib.TreeMap as TreeMap
import qualified Hcompta.Polarize as Polarize
import qualified Hcompta.Quantity as Quantity
import           Hcompta.Tag (Tag)
import qualified Hcompta.Tag as Tag
import qualified Hcompta.Unit as Unit

-- * Type 'Context'

data Context f ts t
 =   Context
 { context_account_prefix :: !(Maybe Account)
 , context_aliases_exact  :: !(Map Account Account)
 , context_aliases_joker  :: ![(Ledger.Account_Joker, Account)]
 , context_aliases_regex  :: ![(Regex, Account)]
 , context_date           :: !Date
 , context_filter         :: !f
 , context_journal        :: !(Journal (ts (Chart_With t)))
 , context_unit           :: !(Maybe Ledger.Unit)
 , context_year           :: !Date.Year
 }

context
 :: (Show f, Consable f ts (Chart_With t))
 => f -> Journal (ts (Chart_With t)) -> Context f ts t
context flt context_journal =
	Context
	 { context_account_prefix = Nothing
	 , context_aliases_exact  = mempty
	 , context_aliases_joker  = []
	 , context_aliases_regex  = []
	 , context_date           = Date.nil
	 , context_filter         = flt
	 , context_journal
	 , context_unit           = Nothing
	 , context_year           = Date.year Date.nil
	 }

-- * Type 'Error'

data Error
 =   Error_date Date.Read.Error
 |   Error_transaction_not_equilibrated
      Ledger.Amount.Styles
      Transaction
      [( Ledger.Unit
       , Balance.Unit_Sum Account
          (Polarize.Polarized Ledger.Quantity)
       )]
 |   Error_virtual_transaction_not_equilibrated
      Ledger.Amount.Styles
      Transaction
      [( Ledger.Unit
       , Balance.Unit_Sum Account
          (Polarize.Polarized Ledger.Quantity)
       )]
 |   Error_reading_file FilePath Exception.IOException
 |   Error_including_file FilePath [R.Error Error]
 deriving (Show)

-- * Directives

directive_alias
 :: (Consable f ts (Chart_With t), Stream s m Char)
 => ParsecT s (Context f ts t) m ()
directive_alias = do
	_ <- R.string "alias"
	R.skipMany1 $ R.space_horizontal
	pattern <- Ledger.Account.Read.pattern
	R.skipMany $ R.space_horizontal
	_ <- R.char '='
	R.skipMany $ R.space_horizontal
	repl <- Ledger.Account.Read.account
	R.skipMany $ R.space_horizontal
	case pattern of
	 Ledger.Account_Pattern_Exact acct -> R.modifyState $ \ctx -> ctx{context_aliases_exact=
		Map.insert acct repl $ context_aliases_exact ctx}
	 Ledger.Account_Pattern_Joker jokr -> R.modifyState $ \ctx -> ctx{context_aliases_joker=
		(jokr, repl):context_aliases_joker ctx}
	 Ledger.Account_Pattern_Regex regx -> R.modifyState $ \ctx -> ctx{context_aliases_regex=
		(regx, repl):context_aliases_regex ctx}
	return ()

-- * Read 'Comment'

comment_begin :: Char
comment_begin = ';'

comment :: Stream s m Char => ParsecT s u m Comment
comment = (do
	_ <- R.char comment_begin
	fromString <$> do
	R.manyTill R.anyChar (R.lookAhead R.new_line <|> R.eof)
	) <?> "comment"

comments :: Stream s m Char => ParsecT s u m [Comment]
comments = (do
	R.try $ do
		_ <- R.spaces
		R.many1_separated comment (R.new_line >> R.skipMany R.space_horizontal)
	<|> return []
	) <?> "comments"

-- * Read 'Tag'

tag_value_sep :: Char
tag_value_sep = ':'

tag_sep :: Char
tag_sep = ','

tag_path_section_char :: Stream s m Char => ParsecT s u m Char
tag_path_section_char =
	R.satisfy (\c -> c /= tag_value_sep && c /= tag_sep && not (Data.Char.isSpace c))

tag :: Stream s m Char => ParsecT s u m Tag
tag = ((,) <$> tag_path <*> tag_value) <?> "tag"

tag_path :: Stream s m Char => ParsecT s u m Tag.Path
tag_path = do
	NonEmpty.fromList <$> do
	R.many1 $ R.try tag_path_section

tag_path_section :: Stream s m Char => ParsecT s u m Tag.Section
tag_path_section = do
	fromString <$> do
		((R.many1 $ tag_path_section_char) <* R.char tag_value_sep)

tag_value :: Stream s m Char => ParsecT s u m Tag.Value
tag_value = do
	fromString <$> do
	R.manyTill R.anyChar $ do
		R.lookAhead $ do
			R.try (R.char tag_sep >> R.many R.space_horizontal >> void tag_path_section)
			<|> R.try (void (R.try R.new_line))
			<|> R.eof

tags :: Stream s m Char => ParsecT s u m (Map Tag.Path [Tag.Value])
tags = do
	Map.fromListWith (flip mappend)
	. List.map (\(p, v) -> (p, [v])) <$> do
		R.many_separated tag $ do
			_ <- R.char tag_sep
			R.skipMany $ R.space_horizontal

not_tag :: Stream s m Char => ParsecT s u m ()
not_tag = do
	R.skipMany $ R.try $ do
		R.skipMany $ tag_path_section_char
		R.space_horizontal

-- * Read 'Posting'

posting ::
 ( Consable f ts (Chart_With t)
 , Stream s (R.Error_State Error m) Char
 , Monad m
 ) => ParsecT s (Context f ts t) (R.Error_State Error m) (Ledger.Posting_Typed Posting)
posting = (do
	posting_sourcepos <- R.getPosition
	R.skipMany1 $ R.space_horizontal
	posting_status <- status
	R.skipMany $ R.space_horizontal
	acct <- Ledger.Account.Read.account
	let Ledger.Posting_Typed type_ posting_account = posting_type acct
	posting_amounts <-
		R.choice_try
		 [ do
			(void R.tab <|> void (R.count 2 R.space_horizontal))
			R.skipMany $ R.space_horizontal
			amts <-
				R.many_separated Ledger.Amount.Read.amount $ do
					R.skipMany $ R.space_horizontal
					_ <- R.char amount_sep
					R.skipMany $ R.space_horizontal
			ctx <- flip liftM R.getState $ \ctx ->
				ctx
				 { context_journal=
					let jnl = context_journal ctx in
					jnl
					 { Ledger.journal_amount_styles =
						List.foldl'
						 (\(Ledger.Amount.Style.Styles styles) (style, amt) ->
							Ledger.Amount.Style.Styles $
							Map.insertWith mappend
							 (Amount.amount_unit amt)
							 style styles)
						 (Ledger.journal_amount_styles jnl)
						 amts
					 }
				 }
			R.setState ctx
			return $
				Map.fromListWith Quantity.quantity_add $
				List.map
				 (\(_sty, amt) ->
					let unit = Amount.amount_unit amt in
					( if unit == Unit.unit_empty
						then maybe unit id (context_unit ctx)
						else unit
					, Amount.amount_quantity amt
					)
				 )
				 amts
		 , return mempty
		 ] <?> "amounts"
	R.skipMany $ R.space_horizontal
	-- TODO: balance assertion
	-- TODO: conversion
	posting_comments <- comments
	let posting_tags@(Tag.Tags tags_) = tags_of_comments posting_comments
	posting_dates <- do
		ctx <- R.getState
		case Map.lookup ("date":|[]) tags_ of
		 Nothing -> return []
		 Just dates -> do
			let date2s = Map.lookup ("date2":|[]) tags_ -- NOTE: support hledger's date2
			do
			forM (dates `mappend` fromMaybe [] date2s) $ \s ->
				R.runParserT_with_Error_fail "tag date" id
				 (Date.Read.date Error_date (Just $ context_year ctx) <* R.eof) ()
				 (Text.unpack s) s
			>>= \dates_ -> case (dates, date2s) of -- NOTE: put hledger's date2 at least in second position
			 ([], Just (_:_)) ->
				return $ context_date ctx:dates_
			 _ -> return $ dates_
	return $ Ledger.Posting_Typed type_ Posting
	 { posting_account
	 , posting_amounts
	 , posting_comments
	 , posting_dates
	 , posting_sourcepos
	 , posting_status
	 , posting_tags
	 }
	) <?> "posting"

amount_sep :: Char
amount_sep = '+'

tags_of_comments :: [Comment] -> Tag.Tags
tags_of_comments =
	Tag.Tags .
	Map.unionsWith mappend
	. List.map
	 ( Data.Either.either (const Map.empty) id
	 . R.runParser (not_tag >> tags <* R.eof) () "" )

status :: Stream s m Char => ParsecT s u m Ledger.Status
status = (do
	( R.try $ do
		R.skipMany $ R.space_horizontal
		_ <- (R.char '*' <|> R.char '!')
		return True )
	<|> return False
	) <?> "status"

-- | Return the 'Posting_Type' and stripped 'Account' of the given 'Account'.
posting_type :: Account -> (Ledger.Posting_Typed Account)
posting_type acct =
	fromMaybe (Ledger.Posting_Typed Ledger.Posting_Type_Regular acct) $ do
		case acct of
		 name:|[] ->
			case Text.stripPrefix virtual_begin name of
			 Just name' -> do
				name'' <- liftM Text.strip $ Text.stripSuffix virtual_end name'
				guard $ not $ Text.null name''
				Just $ Ledger.Posting_Typed Ledger.Posting_Type_Virtual $ name'':|[]
			 Nothing -> do
				name' <- liftM Text.strip $
					    Text.stripPrefix virtual_balanced_begin name
					>>= Text.stripSuffix virtual_balanced_end
				guard $ not $ Text.null name'
				Just $ Ledger.Posting_Typed Ledger.Posting_Type_Virtual_Balanced $ name':|[]
		 first_name:|acct' -> do
			let rev_acct' = List.reverse acct'
			let last_name = List.head rev_acct'
			case liftM Text.stripStart $
				Text.stripPrefix virtual_begin first_name of
			 Just first_name' -> do
				last_name' <- liftM Text.stripEnd $
					Text.stripSuffix virtual_end last_name
				guard $ not $ Text.null first_name'
				guard $ not $ Text.null last_name'
				Just $ Ledger.Posting_Typed
					Ledger.Posting_Type_Virtual $
					first_name':| List.reverse (last_name':List.tail rev_acct')
			 Nothing -> do
				first_name' <- liftM Text.stripStart $
					Text.stripPrefix virtual_balanced_begin first_name
				last_name'  <- liftM Text.stripEnd $
					Text.stripSuffix virtual_balanced_end last_name
				guard $ not $ Text.null first_name'
				guard $ not $ Text.null last_name'
				Just $ Ledger.Posting_Typed
					Ledger.Posting_Type_Virtual_Balanced $
					first_name':|List.reverse (last_name':List.tail rev_acct')
	where
		virtual_begin          = Text.singleton posting_type_virtual_begin
		virtual_end            = Text.singleton posting_type_virtual_end
		virtual_balanced_begin = Text.singleton posting_type_virtual_balanced_begin
		virtual_balanced_end   = Text.singleton posting_type_virtual_balanced_end

posting_type_virtual_begin :: Char
posting_type_virtual_begin = '('
posting_type_virtual_balanced_begin :: Char
posting_type_virtual_balanced_begin = '['
posting_type_virtual_end :: Char
posting_type_virtual_end = ')'
posting_type_virtual_balanced_end :: Char
posting_type_virtual_balanced_end = ']'

-- * Read 'Transaction'

transaction ::
 ( Consable f ts (Chart_With t)
 , Stream s (R.Error_State Error m) Char
 , Monad m
 ) => ParsecT s (Context f ts t) (R.Error_State Error m) Transaction
transaction = (do
	ctx <- R.getState
	transaction_sourcepos <- R.getPosition
	transaction_comments_before <-
		comments
		>>= \x -> case x of
		 [] -> return []
		 _  -> return x <* R.new_line
	date_ <- Date.Read.date Error_date (Just $ context_year ctx)
	dates_ <-
		R.option [] $ R.try $ do
			R.skipMany $ R.space_horizontal
			_ <- R.char date_sep
			R.skipMany $ R.space_horizontal
			R.many_separated
			 (Date.Read.date Error_date (Just $ context_year ctx)) $
				R.try $ do
					R.many $ R.space_horizontal
					>> R.char date_sep
					>> (R.many $ R.space_horizontal)
	let transaction_dates = (date_, dates_)
	R.skipMany $ R.space_horizontal
	transaction_status <- status
	transaction_code <- R.option "" $ R.try code
	R.skipMany $ R.space_horizontal
	transaction_description <- description
	R.skipMany $ R.space_horizontal
	transaction_comments_after <- comments
	let transaction_tags =
		mappend
		 (tags_of_comments transaction_comments_before)
		 (tags_of_comments transaction_comments_after)
	R.new_line
	(postings_unchecked, postings_not_regular) <-
		first (Ledger.map_Postings_by_Account . List.map
		 (\(Ledger.Posting_Typed _ p) -> p)) .
		List.partition (\(Ledger.Posting_Typed pt _) ->
			Ledger.Posting_Type_Regular == pt) <$>
		R.many1_separated posting R.new_line
	let (transaction_virtual_postings, balanced_virtual_postings_unchecked) =
		join (***) (Ledger.map_Postings_by_Account . List.map
		 (\(Ledger.Posting_Typed _ p) -> p)) $
		List.partition (\(Ledger.Posting_Typed pt _) ->
			Ledger.Posting_Type_Virtual == pt)
		 postings_not_regular
	let tr_unchecked =
		Transaction
		 { transaction_code
		 , transaction_comments_before
		 , transaction_comments_after
		 , transaction_dates
		 , transaction_description
		 , transaction_postings=postings_unchecked
		 , transaction_virtual_postings
		 , transaction_balanced_virtual_postings=balanced_virtual_postings_unchecked
		 , transaction_sourcepos
		 , transaction_status
		 , transaction_tags
		 }
	let styles = Ledger.journal_amount_styles $ context_journal ctx
	transaction_postings <-
		case Balance.infer_equilibrium postings_unchecked of
		 (_, Left ko) -> R.fail_with "transaction infer_equilibrium" $
			Error_transaction_not_equilibrated styles tr_unchecked ko
		 (_bal, Right ok) -> return ok
	transaction_balanced_virtual_postings <-
		case Balance.infer_equilibrium balanced_virtual_postings_unchecked of
		 (_, Left ko) -> R.fail_with "transaction infer_equilibrium" $
			Error_virtual_transaction_not_equilibrated styles tr_unchecked ko
		 (_bal, Right ok) -> return ok
	return $
		tr_unchecked
		 { transaction_postings
		 , transaction_balanced_virtual_postings
		 }
	) <?> "transaction"

date_sep :: Char
date_sep = '='

code :: (Consable f ts (Chart_With t), Stream s m Char)
 => ParsecT s (Context f ts t) m Ledger.Code
code = (do
	fromString <$> do
	R.skipMany $ R.space_horizontal
	R.between (R.char '(') (R.char ')') $
		R.many $ R.satisfy (\c -> c /= ')' && not (R.is_space_horizontal c))
	) <?> "code"

description :: Stream s m Char => ParsecT s u m Ledger.Description
description = (do
	fromString <$> do
	R.many $ R.try description_char
	) <?> "description"
	where
		description_char :: Stream s m Char => ParsecT s u m Char
		description_char = do
			c <- R.anyChar
			case c of
			 _ | c == comment_begin -> R.parserZero
			 _ | R.is_space_horizontal c -> return c <* (R.lookAhead $ R.try $ description_char)
			 _ | not (Data.Char.isSpace c) -> return c
			 _ -> R.parserZero

-- * Read directives

default_year
 :: (Consable f ts (Chart_With t), Stream s m Char)
 => ParsecT s (Context f ts t) m ()
default_year = (do
	year <- R.integer_of_digits 10 <$> R.many1 R.digit
	R.skipMany R.space_horizontal
	context_ <- R.getState
	R.setState context_{context_year=year}
	) <?> "default year"

default_unit_and_style
 :: (Consable f ts (Chart_With t), Stream s m Char)
 => ParsecT s (Context f ts t) m ()
default_unit_and_style = (do
	(sty, amt) <- Ledger.Amount.Read.amount
	R.skipMany R.space_horizontal
	ctx <- R.getState
	let unit = Amount.amount_unit amt
	R.setState ctx
	 { context_journal =
		let jnl = context_journal ctx in
		jnl
		 { Ledger.journal_amount_styles =
			let Ledger.Amount.Style.Styles styles =
				Ledger.journal_amount_styles jnl in
			Ledger.Amount.Style.Styles $
			Map.insertWith const unit sty styles
		 }
	 , context_unit = Just unit
	 }
	) <?> "default unit and style"

include ::
 ( Consable f ts (Chart_With Transaction)
 , Show f
 , Show (ts (Chart_With Transaction))
 , Stream s (R.Error_State Error IO) Char
 , NFData (ts (Chart_With Transaction))
 )
 => ParsecT s (Context f ts Transaction)
              (R.Error_State Error IO)
              ()
include = (do
	sourcepos <- R.getPosition
	filename <- R.manyTill R.anyChar (R.lookAhead (R.try R.new_line <|> R.eof))
	context_including <- R.getState
	let journal_including = context_journal context_including
	let cwd = Path.takeDirectory (R.sourceName sourcepos)
	file_path <- liftIO $ Path.abs cwd filename
	content <- do
		join $ liftIO $ Exception.catch
		 (liftM return $ Text.IO.readFile file_path)
		 (return . R.fail_with "include reading" . Error_reading_file file_path)
	(journal_included, context_included) <- do
		liftIO $
			R.runParserT_with_Error
			 (R.and_state $ journal_rec file_path)
			 context_including
				 { context_journal=
					Ledger.journal
					 { journal_chart=
						journal_chart journal_including
					 }
				 }
			 file_path content
		>>= \x -> case x of
		 Right ok -> return ok
		 Left  ko -> R.fail_with "include parsing" (Error_including_file file_path ko)
	R.setState $
		context_included
		 { context_journal=
			journal_including
			 { journal_includes=
				journal_included{journal_file=file_path} :
				journal_includes journal_including
			 , journal_chart=
				journal_chart journal_included
			 }
		 }
	) <?> "include"

-- * Read 'Chart'

chart ::
 ( Consable f ts (Chart_With Transaction)
 , Show f
 , Show (ts (Chart_With Transaction))
 , Stream s (R.Error_State Error IO) Char
 )
 => ParsecT s (Context f ts Transaction)
              (R.Error_State Error IO)
        ()
chart = (do
	-- sourcepos <- R.getPosition
	acct <- Ledger.Account.Read.account
	R.skipMany R.space_horizontal
	_ <- comments
	R.new_line
	tags_ <- R.many_separated
	 (R.skipMany1 R.space_horizontal >> tag
	 <* R.skipMany R.space_horizontal <* comments)
	 R.new_line
	R.skipMany R.space
	let chart_accounts =
		TreeMap.singleton acct $
		Tag.Tags $
		Map.fromListWith (flip mappend) $
		List.map (\(p, v) -> (p, [v])) tags_
	{-
	let chart_tags =
		foldl'
		 (flip (\(p:|ps, v) ->
			TreeMap.insert mappend
			 (p:|ps `mappend` [v])
			 [acct]))
		 mempty
		 tags_
	-}
	ctx <- R.getState
	let j = context_journal ctx
	R.setState $
		ctx{context_journal=
			j{journal_chart=
				mappend
				 (journal_chart j)
				 Chart.Chart
					 { Chart.chart_accounts
					 -- , Chart.chart_tags
					 }
			 }
		 }
	) <?> "chart"

-- * Read 'Journal'

journal ::
 ( Consable f ts (Chart_With Transaction)
 , Show f
 , Show (ts (Chart_With Transaction))
 , Stream s (R.Error_State Error IO) Char
 , NFData (ts (Chart_With Transaction))
 )
 => FilePath
 -> ParsecT s (Context f ts Transaction)
              (R.Error_State Error IO)
              (Journal (ts (Chart_With Transaction)))
journal file_ = (do
	currentLocalTime <- liftIO $
		Time.utcToLocalTime
		<$> Time.getCurrentTimeZone
		<*> Time.getCurrentTime
	let (currentLocalYear, _, _) = Time.toGregorian $ Time.localDay currentLocalTime
	ctx <- R.getState
	R.setState $ ctx{context_year=currentLocalYear}
	journal_rec file_
	) <?> "journal"

journal_rec ::
 ( Consable f ts (Chart_With Transaction)
 , Show f
 , Show (ts (Chart_With Transaction))
 , Stream s (R.Error_State Error IO) Char
 , NFData (ts (Chart_With Transaction))
 )
 => FilePath
 -> ParsecT s (Context f ts Transaction)
              (R.Error_State Error IO)
              (Journal (ts (Chart_With Transaction)))
journal_rec file_ = do
	last_read_time <- liftIO Date.now
	loop $
		R.choice_try
		 [ jump_comment
		 , jump_directive
		 , jump_transaction
		 , jump_chart
		 ]
	journal_ <- context_journal <$> R.getState
	return $
		journal_
		 { journal_file = file_
		 , journal_last_read_time = last_read_time
		 , journal_includes = List.reverse $ journal_includes journal_
		 }
	where
		loop
		 :: Stream s m Char
		 => ParsecT s u m (ParsecT s u m ())
		 -> ParsecT s u m ()
		loop r = do
			R.skipMany (R.skipMany R.space_horizontal >> R.new_line)
			_ <- join r
			R.skipMany (R.skipMany R.space_horizontal >> R.new_line)
			R.try (R.skipMany R.space_horizontal >> R.eof) <|> loop r
		jump_comment ::
		 ( Stream s m Char
		 , Consable f ts (Chart_With Transaction)
		 , Show f
		 , Show (ts (Chart_With Transaction))
		 , u ~ Context f ts Transaction
		 , m ~ R.Error_State Error IO
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_comment = do
			_ <- R.spaces
			_ <- R.lookAhead (R.try $ R.char comment_begin)
			return $ do
				_cmts <- comments
				{-
				R.modifyState $ \ctx ->
					let j = context_journal ctx in
					ctx{context_journal=
						j{journal_sections=
							mcons (context_filter ctx) cmts $
								journal_sections j}}
				-}
				return ()
		jump_directive ::
		 ( Stream s m Char
		 , Consable f ts (Chart_With Transaction)
		 , Show f
		 , Show (ts (Chart_With Transaction))
		 , u ~ Context f ts Transaction
		 , m ~ R.Error_State Error IO
		 , NFData (ts (Chart_With Transaction))
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_directive = do
			let choice s = R.string s >> R.skipMany1 R.space_horizontal
			R.choice_try
			 [ choice "Y"        >> return default_year
			 , choice "D"        >> return default_unit_and_style
			 , choice "!include" >> return include
			 ] <?> "directive"
		jump_transaction ::
		 ( Stream s m Char
		 , Consable f ts (Chart_With Transaction)
		 , Show f
		 , Show (ts (Chart_With Transaction))
		 , u ~ Context f ts Transaction
		 , m ~ R.Error_State Error IO
		 , NFData (ts (Chart_With Transaction))
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_transaction = do
			_ <- R.lookAhead $ R.try (R.many1 R.digit >> Date.Read.date_separator)
			return $ do
				t <- transaction
				R.modifyState $ \ctx ->
					let j = context_journal ctx in
					ctx{context_journal=
						j{journal_sections=
							mcons
							 (context_filter ctx)
							 (Chart_With (journal_chart j) t)
							 (journal_sections j)}}
		jump_chart ::
		 ( Stream s m Char
		 , Consable f ts (Chart_With Transaction)
		 , Show f
		 , Show (ts (Chart_With Transaction))
		 , u ~ Context f ts Transaction
		 , m ~ R.Error_State Error IO
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_chart = do
			return chart

-- ** Read 'Journal' from a file

file
 ::
 ( Consable f ts (Chart_With Transaction)
 , Show f
 , Show (ts (Chart_With Transaction))
 , NFData (ts (Chart_With Transaction))
 )
 => Context f ts Transaction
 -> FilePath
 -> ExceptT [R.Error Error] IO (Journal (ts (Chart_With Transaction)))
file ctx path = do
	ExceptT $
		Exception.catch
		 (liftM Right $ Text.IO.readFile path) $
		 \ko -> return $ Left $
			 [ R.Error_Custom (R.initialPos path) $ Error_reading_file path ko ]
	>>= liftIO . R.runParserT_with_Error (journal path) ctx path
	>>= \x -> case x of
	 Left  ko -> throwE $ ko
	 Right ok -> ExceptT $ return $ Right ok