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

import           Control.Applicative ((<$>), (<*>), (<*))
-- import           Control.Arrow ((***), first)
import qualified Control.Exception as Exception
import           Control.Monad (Monad(..), liftM, join)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (ExceptT(..), throwE)
import           Data.Bool
import           Data.Char (Char)
import qualified Data.Char
import           Data.Either (Either(..))
import           Data.Eq (Eq(..))
import qualified Data.List as List
import           Data.Semigroup as Semigroup
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(..), maybe)
import           Data.String (fromString)
import           Data.Text (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           Hcompta.Account ( Account_Anchor
                                 , Account_Tag(..)
                                 , Account_Tags(..) )
import qualified Hcompta.Account as Account
import qualified Hcompta.Amount as Amount
import           Hcompta.Anchor (Anchors(..))
import           Hcompta.Tag (Tags(..))
import qualified Hcompta.Balance as Balance
import qualified Hcompta.Chart as Chart
import           Hcompta.Chart (Chart(..))
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter.Date.Read as Date.Read
import           Hcompta.Format.JCC
                  ( Account
                  , Comment
                  , Journal(..)
                  , Posting(..)
                  , Transaction(..)
                  , Charted
                  )
import qualified Hcompta.Format.JCC as JCC
import qualified Hcompta.Format.JCC.Amount as JCC.Amount
import qualified Hcompta.Format.JCC.Amount.Read as JCC.Amount.Read
import qualified Hcompta.Format.JCC.Amount.Style as JCC.Amount.Style
import           Hcompta.Format.JCC.Common.Read
-- import qualified Hcompta.Format.JCC.Quantity as JCC.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           Hcompta.Posting ( Posting_Anchor(..)
                                 , Posting_Anchors(..)
                                 , Posting_Tag(..)
                                 , Posting_Tags(..) )
import qualified Hcompta.Posting as Posting
import qualified Hcompta.Quantity as Quantity
import           Hcompta.Transaction ( Transaction_Anchor(..)
                                     , Transaction_Anchors(..)
                                     , Transaction_Tag(..)
                                     , Transaction_Tags(..) )
import qualified Hcompta.Transaction as Transaction
import qualified Hcompta.Unit as Unit

-- * Type 'Context'

data Context c j
 =   Context
 { context_cons    :: Charted Transaction -> c
 , context_date    :: !Date
 , context_journal :: !(Journal j)
 , context_unit    :: !(Maybe JCC.Unit)
 , context_year    :: !Date.Year
 }

context
 :: Consable c j
 => (Charted Transaction -> c)
 -> Journal j
 -> Context c j
context context_cons context_journal =
	Context
	 { context_cons
	 , context_date    = Date.nil
	 , context_journal
	 , context_unit    = Nothing
	 , context_year    = Date.year Date.nil
	 }

-- * Type 'Error'

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

-- * Read 'Comment'

comment_begin :: Char
comment_begin = ';'

comment :: Stream s m Char => ParsecT s u m Comment
comment = (R.char comment_begin >> line) <?> "comment"

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

-- * Read 'Account'

account :: Stream s m Char => ParsecT s u m JCC.Account
account = do
	Account.from_List <$> do
	R.many1 (R.char account_section_sep >> account_section)

account_section :: Stream s m Char => ParsecT s u m Text
account_section = name

account_section_sep :: Char
account_section_sep = '/'

-- ** Read 'Account_Tag'
account_tag_prefix :: Char
account_tag_prefix = '.'
account_tag_sep :: Char
account_tag_sep = ':'
account_tag_value_prefix :: Char
account_tag_value_prefix = '='

account_tag :: Stream s m Char => ParsecT s u m Account_Tag
account_tag = (do
	_ <- R.char account_tag_prefix
	p <- name
	Account.tag
	 <$> (:|) p <$>
		R.many (R.char account_tag_sep >> name)
	 <*> (fromString <$>
		R.option ""
		 (hspaces >> R.char transaction_tag_value_prefix >> hspaces >>
			(List.concat <$> R.many (R.choice
			 [ R.string [account_tag_prefix   , account_tag_prefix]    >> return [account_tag_prefix]
			 , R.string [account_anchor_prefix, account_anchor_prefix] >> return [account_anchor_prefix]
			 , (\s c -> mappend s [c])
				 <$> R.many space
				 <*> R.satisfy (\c ->
					    c /= account_tag_prefix
					 && c /= account_anchor_prefix
					 && is_char c)
			 ]))))
	) <?> "account_tag"

-- ** Read 'Account_Anchor'
account_anchor_prefix :: Char
account_anchor_prefix = '~'
account_anchor_sep :: Char
account_anchor_sep = ':'

account_anchor :: Stream s m Char => ParsecT s u m Account_Anchor
account_anchor = (do
	_ <- R.char account_anchor_prefix
	p <- name
	ps <- R.many (R.char account_anchor_sep >> name)
	return $ Account.anchor (p:|ps)
	) <?> "account_anchor"

-- ** Read 'Account' 'Comment'
account_comment :: Stream s m Char => ParsecT s u m Comment
account_comment = comment

-- * Read 'Posting'

posting ::
 ( Consable c j
 , Monad m
 , Stream s (R.Error_State Error m) Char
 ) => ParsecT s (Context c j)
                (R.Error_State Error m)
                Posting
posting = (do
	posting_sourcepos <- R.getPosition
	_ <- hspaces
	(posting_account, posting_account_anchor) <-
		R.choice_try
		 [ (,Nothing) <$> account
		 , do
			anchor <- account_anchor
			ctx <- R.getState
			let anchors = chart_anchors $ journal_chart $ context_journal ctx
			case Map.lookup anchor anchors of
			 Just (a:|as) -> do
				sa <- R.option Nothing $ Just <$> account
				return $ ( a:|mappend as (maybe [] NonEmpty.toList sa)
				         , Just (anchor, sa) )
			 Nothing -> R.fail_with "account anchor"
				 (Error_account_anchor_unknown posting_sourcepos anchor)
		 ] <?> "posting_account"
	posting_amounts <-
		R.choice_try
		 [ do
			R.skipMany1 space
			amts <-
				R.many_separated JCC.Amount.Read.amount $ do
					R.skipMany space
					_ <- R.char amount_sep
					R.skipMany space
			ctx <- flip liftM R.getState $ \ctx ->
				ctx
				 { context_journal=
					let jnl = context_journal ctx in
					jnl
					 { JCC.journal_amount_styles =
						List.foldl'
						 (\(JCC.Amount.Style.Styles styles) (style, amt) ->
							JCC.Amount.Style.Styles $
							Map.insertWith mappend
							 (Amount.amount_unit amt)
							 style styles)
						 (JCC.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
		 ] <?> "posting_amounts"
	(posting_tags, posting_anchors, posting_comments) <-
		fields mempty mempty mempty
	return $ Posting
	 { posting_account
	 , posting_account_anchor
	 , posting_amounts
	 , posting_anchors = Posting_Anchors posting_anchors
	 , posting_tags = Posting_Tags posting_tags
	 , posting_comments
	 , posting_dates = []
	 , posting_sourcepos
	 }
	) <?> "posting"
	where
		{-
		fields :: Tags -> Anchors -> Comments
		 -> ParsecT s (Context c j)
		              (R.Error_State Error m)
		              (Tags, Anchors, Comments)
		-}
		fields
		 tags@(Tags tagm)
		 anchors@(Anchors anchs)
		 cmts =
			R.choice_try
			 [ hspaces1 >> posting_comment >>= \c ->
				fields tags anchors (c:cmts)
			 , hspaces1 >> posting_tag >>= \(Posting_Tag (p, v)) ->
				fields (Tags $ Map.insertWith mappend p [v] tagm) anchors cmts
			 , hspaces1 >> posting_anchor >>= \(Posting_Anchor p) ->
				fields tags (Anchors $ Map.insert p () anchs) cmts
			 , hspaces  >> eol >>
				fields tags anchors cmts
			 , return (tags, anchors, cmts)
			 ]

amount_sep :: Char
amount_sep = '+'

posting_comment :: Stream s m Char => ParsecT s u m Comment
posting_comment = comment

-- ** Read 'Posting_Tag'
posting_tag :: Stream s m Char => ParsecT s u m Posting_Tag
posting_tag = (liftM (\(Transaction_Tag tag) -> Posting_Tag tag) transaction_tag) <?> "posting_tag"

-- ** Read 'Posting_Anchor'
posting_anchor :: Stream s m Char => ParsecT s u m Posting_Anchor
posting_anchor = (do
	_ <- R.char transaction_anchor_prefix
	Posting.anchor <$>
		NonEmpty.fromList <$>
		R.many1 (R.char transaction_anchor_sep >> name)
	) <?> "posting_anchor"

-- * Read 'Transaction'

map_Postings_by_Account :: [Posting] -> Map Account [Posting]
map_Postings_by_Account =
	Map.fromListWith (flip mappend) .
	List.map (\p -> (posting_account p, [p]))

transaction ::
 ( Consable c j
 , Monad m
 , Stream s (R.Error_State Error m) Char
 ) => ParsecT s (Context c j) (R.Error_State Error m) Transaction
transaction = (do
	ctx <- R.getState
	transaction_sourcepos <- R.getPosition
	date_ <- Date.Read.date Error_date (Just $ context_year ctx)
	dates_ <-
		R.option [] $ R.try $ do
			_ <- hspaces
			_ <- R.char date_sep
			_ <- hspaces
			R.many_separated
			 (Date.Read.date Error_date (Just $ context_year ctx)) $
				R.try $
					hspaces
					>> R.char date_sep
					>> hspaces
	let transaction_dates = (date_, dates_)
	_ <- hspaces
	transaction_wording <- wording
	_ <- eol
	(transaction_tags, transaction_anchors, transaction_comments) <-
		-- return (mempty, mempty, mempty)
		fields mempty mempty mempty
	transaction_postings_unchecked <-
		map_Postings_by_Account <$> postings
	let transaction_unchecked =
		Transaction
		 { transaction_anchors = Transaction_Anchors transaction_anchors
		 , transaction_tags = Transaction_Tags transaction_tags
		 , transaction_comments
		 , transaction_dates
		 , transaction_wording
		 , transaction_postings = transaction_postings_unchecked
		 , transaction_sourcepos
		 }
	let styles = JCC.journal_amount_styles $ context_journal ctx
	transaction_postings <-
		case Balance.infer_equilibrium transaction_postings_unchecked of
		 (_, Left ko) -> R.fail_with "transaction infer_equilibrium" $
			Error_transaction_not_equilibrated styles transaction_unchecked ko
		 (_bal, Right ok) -> return ok
	return $
		transaction_unchecked
		 { transaction_postings
		 }
	) <?> "transaction"
	where
		fields
		 tags@(Tags tagm)
		 anchors@(Anchors anchs)
		 cmts =
			R.choice_try
			 [ hspaces1 >> transaction_comment >>= \c ->
				fields tags anchors (c:cmts)
			 , hspaces1 >> transaction_tag >>= \(Transaction_Tag (p, v)) ->
				fields (Tags $ Map.insertWith mappend p [v] tagm) anchors cmts
			 , hspaces1 >> transaction_anchor >>= \(Transaction_Anchor p) ->
				fields tags (Anchors $ Map.insert p () anchs) cmts
			 , hspaces >> eol >>
				fields tags anchors cmts
			 , return (tags, anchors, cmts)
			 ]

postings ::
 (Consable c j, Monad m, Stream s (R.Error_State Error m) Char)
 => ParsecT s (Context c j) (R.Error_State Error m) [Posting]
postings =
	R.many1
	 (hspaces1 >> posting)

date_sep :: Char
date_sep = '='

code :: ( Consable c j
        , Stream s m Char )
 => ParsecT s (Context c j) m JCC.Code
code = (do
	fromString <$> do
	_ <- hspaces
	R.between (R.char '(') (R.char ')') $
		R.many $ R.satisfy (\c -> c /= ')' && not (R.is_space_horizontal c))
	) <?> "code"

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

-- ** Read 'Transaction_Anchor'

transaction_anchor_prefix :: Char
transaction_anchor_prefix = '@'
transaction_anchor_sep :: Char
transaction_anchor_sep = ':'

transaction_anchor :: Stream s m Char => ParsecT s u m Transaction_Anchor
transaction_anchor = (do
	_ <- R.char transaction_anchor_prefix
	p <- name
	Transaction.anchor <$>
		(:|) p <$>
		R.many (R.char transaction_anchor_sep >> name)
	) <?> "transaction_anchor"

-- ** Read 'Transaction_Tag'
transaction_tag_prefix :: Char
transaction_tag_prefix = '#'
transaction_tag_sep :: Char
transaction_tag_sep = ':'
transaction_tag_value_prefix :: Char
transaction_tag_value_prefix = '='

transaction_tag :: Stream s m Char => ParsecT s u m Transaction_Tag
transaction_tag = (do
	_ <- R.char transaction_tag_prefix
	p <- name
	Transaction.tag
	 <$>
		(:|) p <$>
		R.many (R.char transaction_tag_sep >> name)
	 <*> (fromString <$>
			R.option ""
			 (hspaces >> R.char transaction_tag_value_prefix >> hspaces >>
				 (List.concat <$>
					R.many (R.choice
					 [ R.string [transaction_tag_prefix, transaction_tag_prefix] >>
						return [transaction_tag_prefix]
					 , R.string [transaction_anchor_prefix, transaction_anchor_prefix] >>
						return [transaction_anchor_prefix]
					 , (\s c -> mappend s [c])
						 <$> R.many space
						 <*> R.satisfy (\c -> c /= transaction_tag_prefix && c /= transaction_anchor_prefix && is_char c)
					 ]))))
	) <?> "transaction_tag"

-- ** Read 'Transaction' 'Comment'
transaction_comment :: Stream s m Char => ParsecT s u m Comment
transaction_comment = comment

-- * Read directives

default_year
 :: ( Consable c j
    , Stream s m Char )
 => ParsecT s (Context c j) m ()
default_year = (do
	year <- R.integer_of_digits 10 <$> R.many1 R.digit
	_ <- hspaces
	context_ <- R.getState
	R.setState context_{context_year=year}
	) <?> "default year"

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

-- * Read included 'Journal'

include ::
 ( Consable c j
 , Monoid j
 , Stream s (R.Error_State Error IO) Char
 )
 => ParsecT s (Context c j)
              (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=
					JCC.journal
					 { journal_chart=
						journal_chart journal_including
					 , journal_amount_styles=
						journal_amount_styles 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
			 , journal_amount_styles=
				journal_amount_styles journal_included
			 }
		 }
	) <?> "include"

-- * Read 'Chart'

chart ::
 ( Consable c j
 , Stream s (R.Error_State Error IO) Char
 )
 => ParsecT s (Context c j)
              (R.Error_State Error IO)
              ()
chart = (do
	-- sourcepos <- R.getPosition
	acct <- account
	_ <- eol
	( chart_tags
	 , chart_anchors
	 , _chart_comments ) <-
		fields acct mempty mempty mempty
	let chart_accounts =
		TreeMap.singleton acct $
		Account_Tags chart_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.chart_anchors
					 }
			 }
		 }
	) <?> "chart"
	where
		fields
		 acct
		 tags@(Tags tagm)
		 anchors
		 cmts =
			R.choice_try
			 [ hspaces1 >> account_comment >>= \c ->
				fields acct tags anchors (c:cmts)
			 , hspaces1 >> account_tag >>= \(Account_Tag (p, v)) ->
				fields acct (Tags $ Map.insertWith mappend p [v] tagm) anchors cmts
			 , hspaces1 >> account_anchor >>= \anchor ->
				case Map.insertLookupWithKey (\_k n _o -> n) anchor acct anchors of
				 (Nothing, m) -> fields acct tags m cmts
				 (Just _, _) -> do
					sourcepos <- R.getPosition
					R.fail_with "account anchor not unique"
					 (Error_account_anchor_not_unique sourcepos anchor)
			 , hspaces >> eol >>
				fields acct tags anchors cmts
			 , return (tags, anchors, cmts)
			 ]

-- * Read 'Journal'

journal ::
 ( Consable c j
 , Monoid j
 , Stream s (R.Error_State Error IO) Char
 )
 => FilePath
 -> ParsecT s (Context c j)
              (R.Error_State Error IO)
              (Journal j)
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 c j
 , Monoid j
 , Stream s (R.Error_State Error IO) Char
 )
 => FilePath
 -> ParsecT s (Context c j)
              (R.Error_State Error IO)
              (Journal j)
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 (hspaces >> R.new_line)
			_ <- join r
			R.skipMany (hspaces >> R.new_line)
			R.try (hspaces >> R.eof) <|> loop r
		jump_comment ::
		 ( Stream s m Char
		 , Consable c j
		 , u ~ Context c j
		 , 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_content=
							mcons (context_filter ctx) cmts $
								journal_content j}}
				-}
				return ()
		jump_directive ::
		 ( Consable c j
		 , Monoid j
		 , Stream s m Char
		 , u ~ Context c j
		 , m ~ R.Error_State Error IO
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_directive = do
			let choice s = R.string s >> hspaces1
			R.choice_try
			 [ choice "Y"        >> return default_year
			 , choice "D"        >> return default_unit_and_style
			 , choice "!include" >> return include
			 ] <?> "directive"
		jump_transaction ::
		 ( Consable c j
		 , Stream s m Char
		 , u ~ Context c j
		 , m ~ R.Error_State Error IO
		 )
		 => ParsecT s u m (ParsecT s u m ())
		jump_transaction = do
			_ <- R.lookAhead $ R.try (R.many1 R.digit >> R.char Date.Read.date_separator)
			return $ do
				t <- transaction
				R.modifyState $ \ctx ->
					let j = context_journal ctx in
					ctx{context_journal=
						j{journal_content=
							mcons
							 (context_cons ctx $ Chart.Charted (journal_chart j) t)
							 (journal_content j)}}
		jump_chart ::
		 ( Consable c j
		 , Stream s m Char
		 , u ~ Context c j
		 , 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 c j
 , Monoid j
 )
 => Context c j
 -> FilePath
 -> ExceptT [R.Error Error] IO (Journal j)
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