{-# LANGUAGE DataKinds #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- {-# OPTIONS_GHC -freduction-depth=0 #-}
module Hcompta.LCC.Read where

-- import Data.Functor.Identity (Identity(..))
-- import Data.String (IsString(..))
-- import Data.String (String, fromString)
-- import Debug.Trace
-- import qualified Control.Monad.Classes as MC
import Control.Arrow (left)
import Control.Applicative (Applicative(..), liftA2)
import Control.Monad (Monad(..), void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bool
import Data.Char (Char)
import Data.Decimal
import Data.Eq (Eq(..))
import Data.Foldable
import Data.Functor.Compose (Compose(..))
import Data.List.NonEmpty (NonEmpty(..), (<|))
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Monoid (Monoid(..))
import Data.NonNull (NonNull)
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Time.LocalTime (TimeZone(..))
import Data.Typeable ()
import Language.Symantic.Parsing hiding (LR(..), At(..))
import Prelude (Int, Integer, Num(..), Integral(..), fromIntegral)
import Prelude hiding (any, (^), exp, read)
import System.FilePath ((</>))
import Text.Megaparsec.Pos (SourcePos)
import Text.Show (Show)
import qualified Control.Applicative as Alt
import qualified Control.Exception.Safe as Exn
import qualified Control.Monad.Classes as MC
-- import qualified Control.Monad.Classes.Run as MC
import qualified Control.Monad.Trans.State.Strict as SS
import qualified Data.ByteString as BS
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import qualified Data.NonNull as NonNull
import qualified Data.Strict as S
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Enc
import qualified Data.Time.Calendar  as Time
import qualified Data.Time.LocalTime as Time
import qualified Data.TreeMap.Strict as TreeMap
import qualified Hcompta as H
import qualified Language.Symantic as Sym
-- import qualified Language.Symantic.Lib as Sym
import qualified Language.Symantic.Grammar as Gram
import qualified System.Directory as IO
import qualified System.FilePath as FilePath
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Prim as P

import Hcompta.LCC.Account
import Hcompta.LCC.Name
import Hcompta.LCC.Tag
import Hcompta.LCC.Amount
import Hcompta.LCC.Chart
import Hcompta.LCC.Posting
import Hcompta.LCC.Transaction
import Hcompta.LCC.Journal

import qualified Hcompta.LCC.Lib.Strict as S

-- * Type 'Gram_Reader'
class Gram_Reader ctx g where
	g_ask        :: g (ctx -> a) -> g a
	g_ask_before :: g (ctx -> a) -> g a
deriving instance Gram_Reader ctx g => Gram_Reader ctx (CF g)
instance
 ( ParsecC e s
 , MC.MonadReader ctx (P.ParsecT e s m)
 ) => Gram_Reader ctx (P.ParsecT e s m) where
	g_ask g = do
		f <- g
		s <- MC.ask
		return (f s)
	g_ask_before g = do
		s <- MC.ask
		f <- g
		return (f s)

-- * Type 'Gram_State'
class Gram_State st g where
	g_get   :: g (st -> a) -> g a
	g_state :: g (st -> (st, a)) -> g a
	g_put   :: g (st, a) -> g a
deriving instance Gram_State st g => Gram_State st (CF g)
instance
 ( ParsecC e s
 , MC.MonadState st (P.ParsecT e s m)
 ) => Gram_State st (P.ParsecT e s m) where
	g_get g = do
		f <- g
		s <- MC.get
		return (f s)
	g_state g = do
		f <- g
		s <- MC.get
		let (s', a) = f s
		MC.put s'
		return a
	g_put g = do
		(s, a) <- g
		MC.put s
		return a

-- * Type 'At'
data At a
 =   At
 {   atBegin :: !(NonEmpty SourcePos)
 ,   atEnd   :: !SourcePos
 ,   atItem  :: !a
 } deriving (Eq, Functor, Ord, Show)

-- * Type 'Gram_At'
class Gram_At g where
	g_at :: g ((err -> At err) -> a) -> g a
deriving instance Gram_At g => Gram_At (CF g)
instance ParsecC e s => Gram_At (P.ParsecT e s m) where
	g_at g = do
		ps <- P.statePos <$> P.getParserState
		fa <- g
		p <- P.getPosition
		return $ fa (At ps p)

nonEmpty :: NonNull [a] -> NonEmpty a
nonEmpty n = x :| xs where (x, xs) = NonNull.splitFirst n
nonNull :: NonEmpty a -> NonNull [a]
nonNull n = NonNull.ncons x xs where x :| xs = n

instance Monad m => MC.MonadReaderN 'MC.Zero
 (NonEmpty CanonFile)
 (S.StateT (Context_Read j) m) where
	askN _px = MC.gets $ \(x::Context_Read j) -> context_read_canonfiles x

-- * Type 'ParsecT'
type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
type instance MC.CanDo (P.ParsecT e s m) (MC.EffState a) = 'False
type instance MC.CanDo (P.ParsecT e s m) (MC.EffReader P.SourcePos) = 'True
type instance MC.CanDo (P.ParsecT e s m) (MC.EffReader (S.Either Exn.IOException CanonFile)) = 'True

instance ParsecC e s => MC.MonadReaderN 'MC.Zero P.SourcePos (P.ParsecT e s m) where
	askN _px = P.getPosition
instance ParsecC e s => MC.MonadReaderN 'MC.Zero (NonEmpty P.SourcePos) (P.ParsecT e s m) where
	askN _px = P.statePos <$> P.getParserState
instance (ParsecC e s, MonadIO m) => MC.MonadReaderN 'MC.Zero
 (S.Either Exn.IOException CanonFile)
 (P.ParsecT e s m) where
	askN _px = do
		sn <- P.sourceName <$> P.getPosition
		liftIO $ Exn.catch
		 (S.Right . CanonFile . PathFile <$> IO.canonicalizePath sn)
		 (\exn -> return $ S.Left exn)
-- instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
--	fromString = P.string
instance ParsecC e s => Gram_Rule (P.ParsecT e s m) where
	rule = P.label . Text.unpack
instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
	any          = P.anyChar
	eoi          = P.eof
	char         = P.char
	string       = P.string
	unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
		where cats = unicode_categories cat
	range (l, h) = P.satisfy $ \c -> l <= c && c <= h
	but (Terminal f) (Terminal p) = Terminal $ P.notFollowedBy (P.try p) *> f
instance ParsecC e s => Alter (P.ParsecT e s m) where
	empty  = Alt.empty
	(<+>)  = (Alt.<|>)
	choice = P.choice
	-- choice = foldr ((Alt.<|>) . P.try) Alt.empty
	-- choice = foldr (Alt.<|>) Alt.empty
instance ParsecC e s => Try (P.ParsecT e s m) where
	try = P.try
instance ParsecC e s => Gram_RegR (P.ParsecT e s m) where
	Terminal f .*> Reg x = Reg $ f <*> x
instance ParsecC e s => Gram_RegL (P.ParsecT e s m) where
	Reg f <*. Terminal x = Reg $ f <*> x
instance ParsecC e s => App (P.ParsecT e s m)
instance ParsecC e s => Alt (P.ParsecT e s m) where
	many       = P.many
	some       = P.some
	option     = P.option
	optional g = P.option Nothing (Just <$> g)
instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
	CF f <& Reg p      = CF $ P.lookAhead f <*> p
	Reg f &> CF p      = CF $ P.lookAhead f <*> p
	CF f `minus` Reg p = CF $ P.notFollowedBy (P.try p) *> f
instance ParsecC e s => Gram_Meta P.SourcePos (P.ParsecT e s m) where
	metaG p = do
		pos <- P.getPosition
		($ pos) <$> p
instance ParsecC e s => Gram_Lexer   (P.ParsecT e s m)
instance ParsecC e s => Gram_Count   (P.ParsecT e s m)
instance ParsecC e s => Gram_Op      (P.ParsecT e s m)
instance ParsecC e s => Gram_Char    (P.ParsecT e s m)
instance ParsecC e s => Gram_Comment (P.ParsecT e s m)
instance ParsecC e s => Gram_Tag     (P.ParsecT e s m)
instance ParsecC e s => Gram_Account (P.ParsecT e s m)
instance ParsecC e s => Gram_Amount  (P.ParsecT e s m)
instance ParsecC e s => Gram_File    (P.ParsecT e s m)
instance -- Gram_Date
 ( ParsecC e s
 , MC.MonadState Year (P.ParsecT e s m)
 ) => Gram_Date (P.ParsecT e s m) where
instance -- Gram_Posting
 ( ParsecC e s
 , MC.MonadState Chart (P.ParsecT e s m)
 , MC.MonadState Style_Amounts (P.ParsecT e s m)
 , MC.MonadState (S.Maybe Unit) (P.ParsecT e s m)
 ) => Gram_Posting (P.ParsecT e s m)
instance -- Gram_Transaction
 ( ParsecC e s
 , MC.MonadState (S.Maybe Unit) (P.ParsecT e s m)
 , MC.MonadState Chart          (P.ParsecT e s m)
 , MC.MonadState Section        (P.ParsecT e s m)
 , MC.MonadState Style_Amounts  (P.ParsecT e s m)
 , MC.MonadState Year           (P.ParsecT e s m)
 ) => Gram_Transaction (P.ParsecT e s m)
instance -- Gram_Chart
 ( ParsecC e s
 , MC.MonadState Chart   (P.ParsecT e s m)
 , MC.MonadState Section (P.ParsecT e s m)
 ) => Gram_Chart (P.ParsecT e s m)
instance -- Gram_IO
 ( ParsecC e s
 , MC.MonadState (S.Maybe Unit) (P.ParsecT e s m)
 , MC.MonadState Chart          (P.ParsecT e s m)
 , MC.MonadState Style_Amounts  (P.ParsecT e s m)
 , MC.MonadState Year           (P.ParsecT e s m)
 , P.MonadParsec e Text         (P.ParsecT e s m)
 , MonadIO m
 ) => Gram_IO (P.ParsecT e s m) where
	g_canonfile g = do
		pf@(PathFile fp) <- g
		liftIO $ (pf,) <$> Exn.catch
		 (Right . CanonFile . PathFile <$> IO.canonicalizePath fp)
		 (return . Left)
	g_read g_path g = do
		lr <- g_at $ do
			lr_path <- g_path
			case lr_path of
			 S.Left e -> return $ \at -> S.Left $ at e
			 S.Right (PathFile fp) ->
				liftIO $ Exn.catch
				 (const . S.Right . (fp,) . Enc.decodeUtf8 <$> BS.readFile fp)
				 (\exn -> return $ \at -> S.Left $ at $ Error_Journal_Read (PathFile fp) exn)
		case lr of
		 S.Left e -> do
			return $ S.Left [e]
		 S.Right (fp_new, s_new) -> do
			P.pushPosition $ P.initialPos fp_new
			s_old <- P.getInput; P.setInput s_new
			
			lr_a <- g
				{-
				P.observing g >>= \case
				 Left err -> do
					MC.put jf_old
					P.setInput s_old
					P.popPosition
					P.updateParserState (\st -> st{P.statePos=P.errorPos $ trace ("ERROR: " <> show err) err})
					P.failure
					 (P.errorUnexpected err)
					 (P.errorExpected err)
					 (P.errorCustom err)
				 Right a -> return a
				-}
			
			P.setInput s_old
			P.popPosition
			
			return lr_a
instance -- Gram_Journal
 ( ParsecC e s
 , Sym.Gram_Term_AtomsR Meta is is (P.ParsecT e s m)
 , MC.MonadReader (S.Either Exn.IOException CanonFile) (P.ParsecT e s m)
 , MC.MonadState (Context_Read j) (P.ParsecT e s m)
 , MC.MonadState (Journal j)      (P.ParsecT e s m)
 , MC.MonadState (Journals j)     (P.ParsecT e s m)
 , MC.MonadState (S.Maybe Unit)   (P.ParsecT e s m)
 , MC.MonadState Chart            (P.ParsecT e s m)
 , MC.MonadState Section          (P.ParsecT e s m)
 , MC.MonadState Style_Amounts    (P.ParsecT e s m)
 , MC.MonadState Year             (P.ParsecT e s m)
 , MC.MonadState (Env cs is) m
 , MC.MonadState (Sym.Tokenizers Meta is) m
 , P.MonadParsec e Text           (P.ParsecT e s m)
 , MonadIO m
 , Monoid j
 -- , Show j
 , Sym.Inj_Token Meta is (->)
 , Sym.Compile cs is
 ) => Gram_Journal cs is j (P.ParsecT e s m) where
instance -- Gram_Term
 ( ParsecC e s
 , Gram.Gram_Meta meta (P.ParsecT e s m)
 , MC.MonadState (Sym.Tokenizers meta ts) (P.ParsecT e s m)
 , Sym.Gram_Term_AtomsR meta ts ts (P.ParsecT e s m)
 ) => Sym.Gram_Term ts meta (P.ParsecT e s m) where
	term_tokenizers (Gram.CF mf) = Gram.CF $ mf >>= MC.gets
	g_term_abst_args_body (Gram.CF args) (Gram.CF body) = Gram.CF $ do
		as <- args
		bo <- do
			toks :: Sym.Tokenizers meta ts <- MC.get
			MC.put $
				Sym.Tokenizers
				 { Sym.tokenizers_prefix  = del (Sym.tokenizers_prefix  toks) as
				 , Sym.tokenizers_infix   = del (Sym.tokenizers_infix   toks) as
				 , Sym.tokenizers_postfix = del (Sym.tokenizers_postfix toks) as
				 }
			body <* MC.put toks
		return (as, bo)
		where del = foldr $ \(n, _) -> Map.adjust (Map.delete n) []
instance -- Gram_Error
 ParsecC e s =>
 Sym.Gram_Error (P.ParsecT e s m) where
	term_unError (Gram.CF me) = Gram.CF $ do
		e <- me
		case e of
		 Left err -> fail $ show err
		 Right a -> return a
instance -- Gram_Meta
 ParsecC e s =>
 Sym.Gram_Meta Meta (P.ParsecT e s m) where
	metaG = (($ ()) <$>)
instance -- Gram_Type
 ( ParsecC e s
 , Gram_Meta meta (P.ParsecT e s m)
 ) => Sym.Gram_Type meta (P.ParsecT e s m)
instance -- Gram_Name
 ParsecC e s =>
 Sym.Gram_Name (P.ParsecT e s m)
instance -- Gram_Term_Type
 ( ParsecC e s
 , Gram.Gram_Meta meta (P.ParsecT e s m)
 ) => Sym.Gram_Term_Type meta (P.ParsecT e s m)

-- * Type 'Context_Read'
data Context_Read j
 =   Context_Read
 {   context_read_year          :: !Year
 ,   context_read_style_amounts :: !Style_Amounts
 ,   context_read_chart         :: !Chart
 ,   context_read_unit          :: !(S.Maybe Unit)
 ,   context_read_journals      :: !(Journals j)
 ,   context_read_journal       :: !(NonEmpty (Journal j))
 ,   context_read_canonfiles    :: !(NonEmpty CanonFile)
 ,   context_read_warnings      :: ![At Warning_Journal]
 ,   context_read_section       :: !Section
 } deriving (Eq, Show)

type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (Sym.Tokenizers Meta is)) = 'False

context_read :: Monoid j => Context_Read j
context_read =
	Context_Read
	 { context_read_year          = Year $ H.date_year (H.date_epoch::Date)
	 , context_read_style_amounts = mempty
	 , context_read_chart         = mempty
	 , context_read_unit          = S.Nothing
	 , context_read_journals      = Journals Map.empty
	 , context_read_journal       = journal :| []
	 , context_read_canonfiles    = CanonFile "" :| []
	 , context_read_warnings      = []
	 , context_read_section       = Section_Chart
	 }

-- * Type 'Context_Sym'
data Context_Sym cs is
 =   Context_Sym
 {   context_sym_tokenizers :: !(Sym.Tokenizers Meta is)
 ,   context_sym_env        :: !(Env cs is)
 }
type Meta = ()

context_sym
 :: Sym.Tokenize Meta is
 => Context_Sym cs is
context_sym =
	Context_Sym
	 { context_sym_tokenizers = Sym.tokenizers
	 , context_sym_env        = Map.empty
	 }

-- Sym.Tokenizers
type instance MC.CanDo (S.StateT (Context_Sym cs is) m)
                       (MC.EffState (Sym.Tokenizers Meta is)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (Sym.Tokenizers Meta is) (S.StateT (Context_Sym cs is) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_sym_tokenizers = a})
		 <$> f (context_sym_tokenizers ctx)

-- Env
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (Env cs is)) = 'False
type instance MC.CanDo (S.StateT (Context_Sym cs is) m) (MC.EffState (Env cs is)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (Env cs is) (S.StateT (Context_Sym cs is) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_sym_env = a})
		 <$> f (context_sym_env ctx)

-- Context_Read
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (Context_Read j)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (Context_Read j) (S.StateT (Context_Read j) m) where
	stateN _px = S.StateT . SS.state
-- S.Maybe Unit
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (S.Maybe Unit)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (S.Maybe Unit) (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_read_unit = a})
		 <$> f (context_read_unit ctx)
-- Chart
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState Chart) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero Chart (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_read_chart = a})
		 <$> f (context_read_chart ctx)
-- Year
newtype Year = Year (H.Date_Year Date)
 deriving (Eq, Show)
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState Year) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero Year (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_read_year = a})
		 <$> f (context_read_year ctx)
-- Section
data Section
 =   Section_Chart
 |   Section_Transaction
 deriving (Eq, Show)
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState Section) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero Section (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_read_section = a})
		 <$> f (context_read_section ctx)
-- Journals
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (Journals j)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (Journals j) (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\a -> ctx{context_read_journals = a})
		 <$> f (context_read_journals ctx)
-- Journal
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState (Journal j)) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero (Journal j) (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx@Context_Read{context_read_journal = j:|js} ->
		(\a -> ctx{context_read_journal = a:|js}) <$> f j
-- * Style_Amounts
type instance MC.CanDo (S.StateT (Context_Read j) m)
                       (MC.EffState Style_Amounts) = 'True
instance Monad m => MC.MonadStateN 'MC.Zero Style_Amounts (S.StateT (Context_Read j) m) where
	stateN _px f = S.StateT $ SS.state $ \ctx ->
		(\s -> ctx{context_read_style_amounts = s})
		 <$> f (context_read_style_amounts ctx)

-- * Type 'Error_Date'
data Error_Date
 =   Error_Date_Day_invalid (Integer, Int, Int)
 |   Error_Date_TimeOfDay_invalid (Int, Int, Int)
 |   Error_Date_TimeZone_unknown Text
 deriving (Eq, Show)
-- * Type 'Error_Posting'
data Error_Posting
 =   Error_Posting_Account_Ref_unknown Tag_Path
 |   Error_Posting_Account_Ref_multiple Tag_Path (Map Account ())
 |   Error_Postings_not_equilibrated Postings
 deriving (Eq, Show)
-- * Type 'Error_Transaction'
data Error_Transaction
 =   Error_Transaction_Date Error_Date
 |   Error_Transaction_Posting Error_Posting
 |   Error_Transaction_not_equilibrated
      Transaction
      [( Unit
       , H.SumByUnit (NonNull [Account_Section]) (H.Polarized Quantity)
       )]
 deriving (Eq, Show)
-- * Type 'Error_Chart'
data Error_Chart
 =   Error_Chart
 deriving (Eq, Show)
-- * Type 'Error_Journal'
data Error_Journal cs is
 =   Error_Journal_Transaction Error_Transaction
 |   Error_Journal_Read PathFile Exn.IOException
 |   Error_Journal_Include_loop CanonFile
 |   Error_Journal_Chart Error_Chart
 |   Error_Journal_Section Section Section
 |   Error_Journal_Term (Sym.Error_Term Meta cs is)
deriving instance Eq_Token Meta is => Eq (Error_Journal cs is)
deriving instance -- Show
 ( Show_Token Meta is
 , Sym.Show_TyConst cs
 ) => Show (Error_Journal cs is)
-- * Type 'Warning_Journal'
data Warning_Journal
 =   Warning_Journal_Include_multiple CanonFile
 deriving (Eq, Show)

-- * Class 'Gram_IO'
class Gram_IO g where
	g_canonfile
	 :: g PathFile
	 -> g (PathFile, Either Exn.IOException CanonFile)
	g_read
	 :: g (S.Either (Error_Journal cs is) PathFile)
	 -> g (S.Either [At (Error_Journal cs is)] (CanonFile, a))
	 -> g (S.Either [At (Error_Journal cs is)] (CanonFile, a))
deriving instance Gram_IO g => Gram_IO (CF g)

-- * Class 'Gram_Count'
class
 ( Applicative g
 , Alt g
 ) => Gram_Count g where
	count :: Int -> CF g a -> CF g [a]
	count n p
		| n <= 0    = pure []
		| otherwise = sequenceA $ List.replicate n p
	count' :: Int -> Int -> CF g a -> CF g [a]
	count' m n p
	 | n <= 0 || m > n = pure []
	 | m > 0 = (:) <$> p <*> count' (pred m) (pred n) p
	 | otherwise =
		let f t ts = maybe [] (:ts) t
		in f <$> optional p <*> count' 0 (pred n) p

-- * Class 'Gram_Char'
class
 ( Gram_Lexer g
 , Try g
 ) => Gram_Char g where
	g_eol :: CF g ()
	g_eol = rule "EOL" $ void (char '\n') <+> void (string "\r\n")
	g_tab :: CF g ()
	g_tab = rule "Tab" $ void $ char '\t'
	g_space :: CF g Char
	g_space = rule "Space" $ char ' '
	g_spaces :: CF g Text
	g_spaces = Text.pack <$> many g_space
	g_spaces1 :: CF g ()
	g_spaces1 = void $ some g_space
	g_char :: CF g Char
	g_char = g_char_passive <+> g_char_active
	g_char_passive :: CF g Char
	g_char_passive = choice $ unicat <$> [Unicat_Letter, Unicat_Number, Unicat_Mark]
	g_char_active :: CF g Char
	g_char_active = choice $ unicat <$> [Unicat_Punctuation, Unicat_Symbol]
	g_char_attribute :: Reg lr g Char
	g_char_attribute = choice $ char <$> "#/:;@~="
	g_word :: CF g Text
	g_word = rule "Word" $ Text.pack <$> some g_char
	g_words :: CF g Text
	g_words = Text.concat <$> many (try $ (<>) <$> g_spaces <*> g_word)
	g_09 :: CF g Char
	g_09 = range ('0', '9')
	g_19 :: CF g Char
	g_19 = range ('1', '9')
	g_sign :: Num int => CF g (int -> int)
	g_sign =
		(negate <$ char '-') <+>
		(id     <$ char '+')

-- * Class 'Gram_Date'
class
 ( Gram_State Year g
 , Gram_At g
 , Gram_Char g
 , Gram_Count g
 , Try g
 ) => Gram_Date g where
	g_date :: CF g (S.Either (At Error_Date) Date)
	g_date = rule "Date" $
		(liftA2 $ \day (tod, tz) ->
			Time.localTimeToUTC tz $
			Time.LocalTime day tod)
		 <$> g_ymd
		 <*> option
			 (S.Right (Time.midnight, Time.utc))
			 (liftA2 (,)
				 <$ char '_'
				 <*> g_tod
				 <*> option (S.Right Time.utc) g_timezone)
	g_ymd :: CF g (S.Either (At Error_Date) Time.Day)
	g_ymd = rule "YMD" $
		g_at $
		try (mk_ymd
		 <$> g_year
		 <*  char char_ymd_sep
		 <*> g_month
		 <*  char char_ymd_sep
		 <*> g_dom)
		<+>
		mk_ymd
		 <$> g_get (pure $ \(Year y) -> y)
		 <*> g_month
		 <*  char char_ymd_sep
		 <*> g_dom
		where
		mk_ymd y m d at =
			case Time.fromGregorianValid y m d of
			 Nothing  -> S.Left $ at $ Error_Date_Day_invalid (y, m, d)
			 Just day -> S.Right day
	g_tod :: CF g (S.Either (At Error_Date) Time.TimeOfDay)
	g_tod = rule "TimeOfDay" $
		g_at $
		(\hr (mn, sc) at ->
			case Time.makeTimeOfDayValid hr mn (fromInteger $ toInteger sc) of
			 Nothing -> S.Left $ at $ Error_Date_TimeOfDay_invalid (hr, mn, sc)
			 Just tod -> S.Right $ tod)
		 <$> g_hour
		 <*> option (0, 0)
			((,)
			 <$> (char char_tod_sep *> g_minute)
			 <*> option 0 (char char_tod_sep *> g_second))
	g_year :: CF g Integer
	g_year = rule "Year" $
		(\sg y -> sg $ integer_of_digits 10 y)
		 <$> option id (negate <$ char '-')
		 <*> some g_09
	g_month :: CF g Int
	g_month = rule "Month" $ int_of_digits 10 <$> count' 1 2 g_09
	g_dom :: CF g Int
	g_dom = rule "DayOfMonth" $ int_of_digits 10 <$> count' 1 2 g_09
	g_hour :: CF g Int
	g_hour = rule "Hour" $ int_of_digits 10 <$> count' 1 2 g_09
	g_minute :: CF g Int
	g_minute = rule "Minute" $ int_of_digits 10 <$> count' 1 2 g_09
	g_second :: CF g Int
	g_second = rule "Second" $ int_of_digits 10 <$> count' 1 2 g_09
	
	g_timezone :: CF g (S.Either (At Error_Date) TimeZone)
	g_timezone = rule "TimeZone" $
		-- DOC: http://www.timeanddate.com/time/zones/
		-- TODO: only a few time zones are suported below.
		-- TODO: check the timeZoneSummerOnly values
		(S.Right <$> g_timezone_digits) <+>
		(g_at $ read_tz <$ char '_' <*> some (range ('A', 'Z')))
		where
		read_tz n at = case n of
		 "AST"  -> S.Right $ TimeZone (- 4 * 60) False n
		 "ADT"  -> S.Right $ TimeZone (- 3 * 60) True  n
		 "A"    -> S.Right $ TimeZone (- 1 * 60) False n
		 "BST"  -> S.Right $ TimeZone (-11 * 60) False n
		 "BDT"  -> S.Right $ TimeZone (-10 * 60) True  n
		 "CET"  -> S.Right $ TimeZone (  1 * 60) True  n
		 "CEST" -> S.Right $ TimeZone (  2 * 60) False n
		 "CST"  -> S.Right $ TimeZone (- 6 * 60) False n
		 "CDT"  -> S.Right $ TimeZone (- 5 * 60) True  n
		 "EST"  -> S.Right $ TimeZone (- 5 * 60) False n
		 "EDT"  -> S.Right $ TimeZone (- 4 * 60) True  n
		 "GMT"  -> S.Right $ TimeZone    0       False n
		 "HST"  -> S.Right $ TimeZone (-10 * 60) False n
		 "HDT"  -> S.Right $ TimeZone (- 9 * 60) True  n
		 "MST"  -> S.Right $ TimeZone (- 7 * 60) False n
		 "MDT"  -> S.Right $ TimeZone (- 6 * 60) True  n
		 "M"    -> S.Right $ TimeZone (-12 * 60) False n
		 "NST"  -> S.Right $ TimeZone (- 3 * 60 - 30) False n
		 "N"    -> S.Right $ TimeZone (  1 * 60) False n
		 "PST"  -> S.Right $ TimeZone (- 8 * 60) False n
		 "PDT"  -> S.Right $ TimeZone (- 7 * 60) True  n
		 "YST"  -> S.Right $ TimeZone (- 9 * 60) False n
		 "YDT"  -> S.Right $ TimeZone (- 8 * 60) True  n
		 "Y"    -> S.Right $ TimeZone ( 12 * 60) False n
		 "Z"    -> S.Right $ TimeZone    0       False n
		 _      -> S.Left  $ at $ Error_Date_TimeZone_unknown (Text.pack n)
	g_timezone_digits :: CF g TimeZone
	g_timezone_digits = do
		(\sg hr mn ->
			let tz =
				TimeZone
				 { timeZoneMinutes    = sg $ hr * 60 + mn
				 , timeZoneSummerOnly = False
				 , timeZoneName       = Time.timeZoneOffsetString tz
				 }
			in tz)
		 <$> g_sign
		 <*> g_hour
		 <*> option 0 (optional (char char_tod_sep) *> g_minute)

-- * Class 'Gram_Tag'
class
 ( Gram_Char g
 , Gram_Terminal g
 , Try g
 ) => Gram_Tag g where
	g_tag :: CF g Tag
	g_tag = Tag
		 <$  char char_tag_prefix
		 <*> g_tag_path
		 <*> option (Tag_Data "")
			 ( try $ g_spaces
			 *> char char_tag_data_prefix
			 *> g_spaces
			 *> g_tag_value )
	g_tag_path :: CF g Tag_Path
	g_tag_path =
		(\x xs -> Tag_Path $ NonNull.ncons x xs)
		 <$> g_tag_section
		 <*> many (try $ char char_tag_sep *> g_tag_section)
	g_tag_section :: CF g Tag_Path_Section
	g_tag_section =
		Name . Text.pack
		 <$> some (g_char `minus` g_char_attribute)
	g_tag_value :: CF g Tag_Data
	g_tag_value = Tag_Data <$> g_words

-- * Class 'Gram_Comment'
class
 ( Gram_Terminal g
 , Gram_Char g
 ) => Gram_Comment g where
	g_comment :: CF g Comment
	g_comment = rule "Comment" $
		Comment <$ char ';' <* g_spaces <*> g_words

-- * Class 'Gram_Account'
class
 ( Gram_At g
 , Gram_Char g
 , Gram_Lexer g
 , Gram_Tag g
 , Try g
 ) => Gram_Account g where
	g_account_section :: CF g Account_Section
	g_account_section =
		Name . Text.pack
		 <$> some (g_char `minus` g_char_attribute)
	g_account :: CF g Account
	g_account = rule "Account" $
		Account . NonNull.impureNonNull
		 <$> some (try $ char '/' *> g_account_section)
	g_account_tag :: CF g Account_Tag
	g_account_tag =
		(Account_Tag <$>) $
		Tag
		 <$  char char_account_tag_prefix
		 <*> g_tag_path
		 <*> option (Tag_Data "")
			 (try $ g_spaces
			 *> char char_tag_data_prefix
			 *> g_spaces
			 *> g_tag_value )
	g_account_tag_path :: CF g Tag_Path
	g_account_tag_path = rule "Tag_Path" $
		char char_account_tag_prefix
		 *> g_tag_path
	{-
	g_anchor_section :: CF g Anchor_Section
	g_anchor_section = rule "Anchor_Section" $
		Name . Text.pack
		 <$> some (g_char `minus` g_char_attribute)
	-}

-- * Class 'Gram_Amount'
class
 ( Gram_Char g
 , Gram_Terminal g
 ) => Gram_Amount g where
	g_unit :: CF g Unit
	g_unit = rule "Unit" $
		Unit . Text.singleton
		 <$> unicat (Unicat Char.CurrencySymbol)
	g_quantity :: CF g (Quantity, Style_Amount)
	g_quantity = rule "Quantity" $
		(\(i, f, fr, gi, gf) ->
			let int  = concat i in
			let frac = concat f in
			let precision = length frac in
			-- guard (precision <= 255)
			let mantissa = integer_of_digits 10 $ int <> frac in
			( Decimal
				 (fromIntegral precision)
				 mantissa
			, mempty
				 { style_amount_fractioning=fr
				 , style_amount_grouping_integral=gi
				 , style_amount_grouping_fractional=gf
				 }
			))
		 <$> choice (try <$>
			 [ g_qty '_' ',' '_' <* (pure () `minus` choice (char <$> ",._"))
			 , g_qty '_' '.' '_' <* (pure () `minus` choice (char <$> ",._"))
			 , g_qty ',' '.' '_' <* (pure () `minus` choice (char <$> ",._"))
			 , g_qty '.' ',' '_' <* (pure () `minus` choice (char <$> ",._"))
			 ])
	g_qty
	 :: Char -- ^ Integral grouping separator.
	 -> Char -- ^ Fractioning separator.
	 -> Char -- ^ Fractional grouping separator.
	 -> CF g
	 ( [String] -- integral
	 , [String] -- fractional
	 , S.Maybe Style_Amount_Fractioning -- fractioning
	 , S.Maybe Style_Amount_Grouping -- grouping_integral
	 , S.Maybe Style_Amount_Grouping -- grouping_fractional
	 )
	g_qty int_group_sep frac_sep frac_group_sep = do
		(\int mf ->
			case mf of
			 Nothing ->
				( int
				, []
				, S.Nothing
				, grouping_of_digits int_group_sep int
				, S.Nothing
				)
			 Just (fractioning, frac) ->
				( int
				, frac
				, S.Just fractioning
				, grouping_of_digits int_group_sep int
				, grouping_of_digits frac_group_sep $ List.reverse frac
				))
		 <$> ((:)
			 <$> some g_09
			 <*> option [] (many $ try $ char int_group_sep *> some g_09))
		 <*> option Nothing (Just <$> ((,)
			 <$> char frac_sep
			 <*> ((:)
				 <$> many g_09
				 <*> option [] (many $ try $ char frac_group_sep *> some g_09))))
		where
			grouping_of_digits :: Char -> [String] -> S.Maybe Style_Amount_Grouping
			grouping_of_digits group_sep digits =
				case digits of
				 []  -> S.Nothing
				 [_] -> S.Nothing
				 _   -> S.Just $
					Style_Amount_Grouping group_sep $
					canonicalize_grouping $
					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
	
	g_amount :: CF g (Styled_Amount Amount)
	g_amount = rule "Amount" $ g_amount_minus <+> g_amount_plus
	g_amount_minus :: CF g (Styled_Amount Amount)
	g_amount_minus =
		char '-' *> (
			mk_amount L
			 <$> ((,) <$> g_unit <*> g_spaces)
			 <*> g_quantity
			<+>
			flip (mk_amount R)
			 <$> g_quantity
			 <*> option ("", H.unit_empty)
				 (try $ flip (,) <$> g_spaces <*> g_unit) )
		<+>
		try (mk_amount L
		 <$> ((,) <$> g_unit <*> g_spaces)
		 <*  char '-'
		 <*> g_quantity)
		where
		mk_amount :: LR -> (Unit, Text) -> (Quantity, Style_Amount) -> (Style_Amount, Amount)
		mk_amount side (unit, sp) (qty, sty) =
			( case unit of
			 Unit "" -> sty
			 _ -> sty
				{ style_amount_unit_side   = S.Just side
				, style_amount_unit_spaced = S.Just $ not $ Text.null sp
				}
			, Amount
				{ amount_quantity = negate qty
				, amount_unit     = unit
				}
			)
	g_amount_plus :: CF g (Styled_Amount Amount)
	g_amount_plus =
		char '+' *> (
			mk_amount L
			 <$> ((,) <$> g_unit <*> g_spaces)
			 <*> g_quantity
			<+>
			flip (mk_amount R)
			 <$> g_quantity
			 <*> option ("", H.unit_empty)
				 (try $ flip (,) <$> g_spaces <*> g_unit) )
		<+>
		mk_amount L
		 <$> ((,) <$> g_unit <*> g_spaces)
		 <*  optional (char '+')
		 <*> g_quantity
		<+>
		flip (mk_amount R)
		 <$> g_quantity
		 <*> option ("", H.unit_empty)
			 (try $ flip (,) <$> g_spaces <*> g_unit)
		where
		mk_amount :: LR -> (Unit, Text) -> (Quantity, Style_Amount) -> (Style_Amount, Amount)
		mk_amount side (unit, sp) (qty, sty) =
			( case unit of
			 Unit "" -> sty
			 _ -> sty
				{ style_amount_unit_side   = S.Just side
				, style_amount_unit_spaced = S.Just $ not $ Text.null sp
				}
			, Amount
				{ amount_quantity = qty
				, amount_unit     = unit
				}
			)

-- * Class 'Gram_Posting'
class
 ( Gram_Account g
 , Gram_Amount g
 , Gram_Char g
 , Gram_Comment g
 , Gram_Reader P.SourcePos g
 , Gram_State (S.Maybe Unit) g
 , Gram_State Chart g
 , Gram_State Style_Amounts g
 , Gram_Terminal g
 ) => Gram_Posting g where
	g_postings :: CF g (S.Either (At Error_Posting) [Posting])
	g_postings =
		fmap sequenceA $
		many $ try $
			many (try $ g_spaces *> g_eol) *>
			g_spaces1 *> g_posting
	g_posting :: CF g (S.Either (At Error_Posting) Posting)
	g_posting = rule "Posting" $
		g_state $ g_get $ g_ask_before $
		(\lr_acct
		 may_amt attrs
		  posting_sourcepos ctx_unit
		 (Style_Amounts ctx_stys) -> do
			let (posting_tags, posting_comments) = attrs
			let (stys, posting_amounts) =
				case may_amt of
				 Nothing -> (Style_Amounts ctx_stys, mempty)
				 Just (sty, amt) ->
					let ctx =
						Style_Amounts $
						Map.insertWith (flip (<>))
						 (amount_unit amt)
						 sty ctx_stys in
					let unit =
						case amount_unit amt of
						 u | u == H.unit_empty -> S.fromMaybe u ctx_unit
						 u -> u in
					(ctx,) $
						Amounts $
						Map.singleton unit $
						amount_quantity amt
			(stys,) $ do
				(posting_account, posting_account_ref) <- lr_acct
				S.Right $
					Posting
					 { posting_account
					 , posting_account_ref
					 , posting_amounts
					 , posting_tags
					 , posting_comments
					 , posting_dates = []
					 , posting_sourcepos
					 })
		 <$> g_posting_account
		 <*> optional (try $ g_spaces1 *> g_amount)
		 <*> g_posting_attrs
	g_posting_account
	 :: CF g (S.Either (At Error_Posting)
	                   (Account, S.Maybe (S.Pair Tag_Path (S.Maybe Account))))
	g_posting_account = rule "Posting_Account" $
		(S.Right . (, S.Nothing) <$> g_account) <+>
		(mk_posting_account
			 <$> (g_at $ g_get $ expand_tag_path <$> g_account_tag_path)
			 <*> option S.Nothing (S.Just <$> g_account))
		where
		mk_posting_account path acct =
			(\(p, a) ->
				(,)
				 (S.maybe a (a <>) acct)
				 (S.Just (p S.:!: acct)) )
			 <$> path
		expand_tag_path tag chart at =
			case Map.lookup tag $ chart_tags chart of
			 Just accts | Map.size accts > 0 ->
				if Map.size accts == 1
				then
					let acct = fst $ Map.elemAt 0 accts in
					S.Right (tag, acct)
				else S.Left $ at $ Error_Posting_Account_Ref_multiple tag accts
			 _ ->  S.Left $ at $ Error_Posting_Account_Ref_unknown tag
	g_posting_tag :: CF g Posting_Tag
	g_posting_tag = rule "Posting_Tag" $ Posting_Tag <$> g_tag
	g_posting_attrs :: CF g (Posting_Tags, [Comment])
	g_posting_attrs =
		foldr ($) mempty . Compose
		 <$> (many $ try $
			many (try $ g_spaces *> g_eol *> g_spaces1) *>
			some (try $
				g_spaces *>
				choice
				 [ add_tag     <$> g_posting_tag
				 , add_comment <$> g_comment
				 ]))
		where
		add_tag (Posting_Tag (Tag (Tag_Path p) v)) =
			\(Posting_Tags (Tags tags), cmts) ->
				( Posting_Tags (Tags (TreeMap.insert (<>) p [v] tags))
				, cmts )
		add_comment c =
			\(tags, cmts) ->
				(tags, c:cmts)

-- * Class 'Gram_Transaction'
class
 ( Gram_Account g
 , Gram_Amount g
 , Gram_Char g
 , Gram_Comment g
 , Gram_Date g
 , Gram_Posting g
 , Gram_Terminal g
 , Gram_State Section g
 ) => Gram_Transaction g where
	g_transaction :: CF g (S.Either (At Error_Transaction) Transaction)
	g_transaction = rule "Transaction" $
		g_put $ ((Section_Transaction,) <$>) $
		g_state $ (update_year <$>) $
		g_at $ g_ask_before $
		(\lr_date
		 transaction_wording
		 ( transaction_tags
		 , transaction_comments )
		 lr_posts
		 transaction_sourcepos at -> do
			date  <- fmap Error_Transaction_Date    `S.left` lr_date
			posts <- fmap Error_Transaction_Posting `S.left` lr_posts
			let postsByAcct = postings_by_account posts
			let txn =
				Transaction
				 { transaction_tags
				 , transaction_comments
				 , transaction_dates = NonNull.ncons date []
				 , transaction_wording
				 , transaction_postings = Postings postsByAcct
				 , transaction_sourcepos
				 }
			case H.equilibrium postsByAcct of
			 (_, Left ko) -> S.Left $ at $ Error_Transaction_not_equilibrated txn ko
			 (_bal, Right ok) -> S.Right txn{transaction_postings = Postings ok}
		 )
		 <$> g_date
		 <*  g_spaces1
		 <*> g_wording
		 <*> g_transaction_attrs
		 <*> g_postings
		where
		update_year lr_txn y =
			(,lr_txn) $
			case lr_txn of
			 S.Right txn -> Year $ H.date_year $ NonNull.head $ transaction_dates txn
			 _ -> y
	g_wording :: CF g Wording
	g_wording = rule "Wording" $
		Wording . Text.concat
		 <$> many (try $
			(<>)
			 <$> g_spaces
			 <*> (Text.pack
				 <$> some (g_char `minus` char char_tag_prefix)))
	g_transaction_tag :: CF g Transaction_Tag
	g_transaction_tag = rule "Transaction_Tag" $ Transaction_Tag <$> g_tag
	g_transaction_attrs :: CF g (Transaction_Tags, [Comment])
	g_transaction_attrs =
		foldr ($) mempty
		 <$> many (
			choice (try <$>
			 [ add_tag     <$ many (try $ g_spaces *> g_eol *> g_spaces1) <*> g_transaction_tag
			 , add_comment <$ many (try $ g_spaces *> g_eol *> g_spaces)  <*> g_comment
			 ]))
		where
		add_tag (Transaction_Tag (Tag (Tag_Path p) v)) =
			\(Transaction_Tags (Tags tags), cmts) ->
				( Transaction_Tags (Tags (TreeMap.insert (<>) p [v] tags))
				, cmts )
		add_comment c =
			\(tags, cmts) ->
				(tags, c:cmts)

-- * Class 'Gram_File'
class
 ( Gram_Char g
 , Gram_Rule g
 , Gram_Terminal g
 , Try g
 ) => Gram_File g where
	g_pathfile :: CF g PathFile
	g_pathfile = rule "PathFile" $
		PathFile . concat
		 <$> some (try $ (:) <$> char '/' <*> some (g_char `minus` char '/'))

-- * Class 'Gram_Chart'
class
 ( Gram_Account g
 , Gram_At g
 , Gram_Comment g
 , Gram_Lexer g
 , Gram_State Chart g
 , Gram_State Section g
 , Try g
 ) => Gram_Chart g where
	g_chart_entry :: CF g (S.Either (At (Error_Journal cs is)) Chart)
	g_chart_entry = rule "Chart" $
		g_get $ g_at $
		(\acct attrs at section ->
			let (tags, tags2, _comments) = attrs in
			if case section of
				 Section_Transaction -> False
				 Section_Chart -> True
			then S.Right
				Chart
				 { chart_accounts = TreeMap.singleton (H.get acct) tags
				 , chart_tags     = Map.singleton acct () <$ tags2
				 }
			else S.Left $ at $ Error_Journal_Section section Section_Chart
		 )
		 <$> g_account
		 <*> g_chart_attrs
	g_chart_attrs :: CF g (Account_Tags, Map Tag_Path (), [Comment])
	g_chart_attrs =
		foldr ($) mempty
		 <$> (many $ try $
			many (try $ g_spaces *> g_eol) *>
			choice
			 [ add_tag     <$ g_spaces1 <*> g_account_tag
			 , add_comment <$ g_spaces  <*> g_comment
			 ])
		where
		add_tag (Account_Tag (Tag (Tag_Path p) v)) =
			\(Account_Tags (Tags tags), tags2, cmts) ->
				( Account_Tags (Tags (TreeMap.insert (<>) p [v] tags))
				, Map.insert (Tag_Path p) () tags2
				, cmts )
		add_comment c =
			\(tags, tags2, cmts) ->
				(tags, tags2, c:cmts)

{-
tokenizer :: forall is m.
 ( Inj_Tokens Meta is [Proxy (->), Proxy Integer]
 , Sym.Gram_Term is Meta (P.ParsecT P.Dec Text (SS.StateT (Sym.Tokenizers Meta is) m))
 , Sym.Tokenize Meta is
 , Monad m
 ) => Text -> m (Either (P.ParseError Char P.Dec) (EToken Meta is))
tokenizer inp =
	-- runIdentity $
	MC.evalStateStrict (Sym.tokenizers::Sym.Tokenizers Meta is) $
	P.runParserT g "" inp
	where g = Gram.unCF $ Sym.g_term <* Gram.eoi
-}

-- * Class 'Gram_Term'
class
 ( Sym.Gram_Term is Meta g
 , Sym.Compile cs is
 , Sym.Inj_Token Meta is (->)
 , Gram_At g
 , Gram_State (Env cs is) g
 ) => Gram_Term cs is {-meta-} g where
	g_term
	 :: CF g ( Sym.TeName
	         , Either (At (Sym.Error_Term Meta cs is))
	                  (Sym.ETerm cs is) )
	g_term =
		g_at $ g_get $
		(\n v env at ->
			(n,) $
			(at `left`) $
			Sym.closeContext $
			Sym.withContext (Map.toList (env::Env cs is)) $
			Sym.compileO v
		 )
		 <$> Sym.g_term_name
		 -- TODO: <*> many Sym.term_abst_decl
		 <*  Sym.symbol "="
		 <*> Sym.g_term

instance -- Gram_Term
 ( ParsecC e s
 , MC.MonadState (Sym.Tokenizers Meta is) m
 , MC.MonadState (Env cs is) m
 , P.MonadParsec e Text (P.ParsecT e s m)
 , Sym.Gram_Term_AtomsR Meta is is (P.ParsecT e s m)
 , Sym.Compile cs is
 , Sym.Inj_Token Meta is (->)
 , Monad m
 ) => Gram_Term cs is (P.ParsecT e s m) where

-- ** Type 'Env'
type Env cs is = Map Sym.TeName (Sym.ETerm cs is)

-- * Class 'Gram_Journal'
class
 ( Gram_Account g
 , Gram_At g
 , Gram_Chart g
 , Gram_File g
 , Gram_IO g
 , Gram_Lexer g
 , Gram_Reader (S.Either Exn.IOException CanonFile) g
 , Gram_State (Context_Read j) g
 , Gram_State (Journal j) g
 , Gram_State (Journals j) g
 , Gram_State (Env cs is) g
 , Gram_Transaction g
 , Gram_Term cs is g
 , Sym.Compile cs is
 , Sym.Inj_Token Meta is (->)
 , Try g
 , Monoid j
 ) => Gram_Journal cs is j g where
	g_journal
	 :: (Transaction -> j -> j)
	 -> CF g (S.Either [At (Error_Journal cs is)]
	                   (CanonFile, Journal j))
	g_journal cons_txn = rule "Journal" $
		g_state $ g_ask_before $
		mk_journal
		 <$> (g_state $ g_at $ g_ask_before $ g_ask_before $ pure init_journal)
		 <*> many (choice
			 [ g_state $ mk_include <$> g_include @cs @is cons_txn
			 -- NOTE: g_include must be the first choice
			 -- in order to have Megaparsec reporting the errors
			 -- of the included journal.
			 , g_state $ mk_transaction <$> g_transaction
			 , g_state $ mk_chart <$> g_chart_entry
			 , g_state $ mk_term <$> g_term
			 , [] <$ try (g_spaces <* g_eol)
			 ])
		where
		init_journal
		 P.SourcePos{P.sourceName=jf} lr_cf at
		 (ctx@Context_Read
			 { context_read_journals   = Journals js
			 , context_read_journal    = jnls
			 , context_read_canonfiles = cfs
			 }::Context_Read j) =
			case lr_cf of
			 S.Left e -> (ctx, S.Left $ at $ Error_Journal_Read (PathFile jf) e)
			 S.Right cf ->
				let jnl = journal{journal_file=PathFile jf} in
				(,S.Right ())
				ctx
				 { context_read_journals   = Journals $ Map.insert cf jnl js
				 , context_read_journal    = jnl <| jnls
				 , context_read_canonfiles = cf <| cfs
				 }
		mk_journal err errs
		 P.SourcePos{P.sourceName=jf}
		 (ctx@Context_Read
			 { context_read_journals   = Journals js
			 , context_read_journal    = jnl :| jnls
			 , context_read_canonfiles = cf :| cfs
			 }::Context_Read j) =
			case concat $ S.either (pure . pure) (const []) err <> errs of
			 [] ->
				let jnl' = jnl{journal_file=PathFile jf} in
				(,S.Right (cf, jnl'))
				ctx
				 { context_read_journals   = Journals $ Map.insert cf jnl' js
				 , context_read_journal    = NonEmpty.fromList jnls
				 , context_read_canonfiles = NonEmpty.fromList cfs
				 }
			 es -> (ctx, S.Left es)
		mk_transaction lr_txn jnl@Journal{journal_content=j} =
			case lr_txn of
			 S.Left err  -> (jnl, [Error_Journal_Transaction <$> err])
			 S.Right txn -> (jnl{ journal_content = txn `cons_txn` j }, [])
		mk_include lr_inc (jnl::Journal j) =
			case lr_inc of
			 S.Left errs -> (jnl, errs)
			 S.Right (cf, _inc) -> (jnl{ journal_includes = journal_includes jnl <> [cf] }, [])
		mk_chart lr_ch chart =
			case lr_ch of
			 S.Left err -> (chart, [err])
			 S.Right ch -> (chart <> ch, [])
		mk_term (n, lr_te) terms =
			case lr_te of
			 Left err -> (terms, [Error_Journal_Term <$> err])
			 Right (te::Sym.ETerm cs is) -> (insert_term n te terms, [])
			where
			insert_term
			 :: Sym.TeName
			 -> Sym.ETerm cs is
			 -> Env cs is
			 -> Env cs is
			insert_term = Map.insert
	g_include
	 :: (Transaction -> j -> j)
	 -> CF g (S.Either [At (Error_Journal cs is)]
	                   (CanonFile, Journal j))
	g_include cons_txn = rule "Include" $
		g_read g_path (g_journal @cs @is cons_txn <* eoi)
		where
		g_path =
			g_state $ g_at $ check_path
			 <$> (g_canonfile $ g_ask_before $ fmap mk_path $
				(\d (PathFile p) -> PathFile $ d:p)
				 <$> char '.' <*> g_pathfile)
		mk_path (PathFile fp) P.SourcePos{P.sourceName=fp_old} =
			PathFile $
			FilePath.normalise $
			FilePath.takeDirectory fp_old </> fp
		check_path (fp, lr_cf) at
		 (ctx@Context_Read
			 { context_read_journals   = Journals js
			 , context_read_canonfiles = cfs
			 , context_read_warnings   = warns
			 }::Context_Read j) =
			case lr_cf of
			 Left e -> (ctx, S.Left $ Error_Journal_Read fp e)
			 Right cf ->
				if cf `Map.member` js
				then
					if cf `elem` cfs
					then (ctx, S.Left $ Error_Journal_Include_loop cf)
					else
						(,S.Right fp) $
						if isJust $ (`List.find` warns) $ \case
						 At{atItem=Warning_Journal_Include_multiple cf'} -> cf' `elem` cf<|cfs
						then ctx
						else ctx
						 { context_read_warnings =
							at (Warning_Journal_Include_multiple cf) : warns }
				else (ctx, S.Right fp)

-- * Integers

-- | Return the 'Integer' obtained by multiplying the given digits
--   with the power of the given base respective to their rank.
integer_of_digits
 :: Integer -- ^ Base.
 -> String  -- ^ Digits (MUST be recognised by 'Char.digitToInt').
 -> Integer
integer_of_digits base =
	foldl' (\x d -> base*x + toInteger (Char.digitToInt d)) 0

-- | Return the 'Int' obtained by multiplying the given digits
--   with the power of the given base respective to their rank.
int_of_digits
 :: Int -- ^ Base.
 -> String -- ^ Digits (MUST be recognised by 'Char.digitToInt').
 -> Int
int_of_digits base =
	foldl' (\x d -> base*x + Char.digitToInt d) 0

-- * Chars
char_account_sep :: Char
char_account_sep = '/'
char_account_tag_prefix :: Char
char_account_tag_prefix = '~'
char_ymd_sep :: Char
char_ymd_sep = '-'
char_tod_sep :: Char
char_tod_sep = ':'
char_comment_prefix :: Char
char_comment_prefix = ';'
char_tag_prefix :: Char
char_tag_prefix = '#'
char_tag_sep :: Char
char_tag_sep = ':'
char_tag_data_prefix :: Char
char_tag_data_prefix = '='
char_transaction_date_sep :: Char
char_transaction_date_sep = '='

read
 :: forall is j cs e m a.
 ( Monoid j
 , Gram_File (P.ParsecT P.Dec Text m)
 , Sym.Tokenize Meta is
 , m ~ S.StateT (Context_Read j) (S.StateT (Context_Sym cs is) IO)
 , e ~ P.ParseError Char P.Dec
 , cs ~ Sym.TyConsts_of_Ifaces is
 )
 => CF (P.ParsecT P.Dec Text m) a
 -> FilePath
 -> Text
 -> IO ((Either e a, Context_Read j), Context_Sym cs is)
read g fp inp =
	S.runState context_sym $
	S.runState context_read $
	P.runParserT (unCF $ g <* eoi) (FilePath.normalise fp) inp

read_file :: FilePath -> (FilePath -> Text -> IO a) -> IO a
read_file fp f = do
	content <- Enc.decodeUtf8 <$> BS.readFile fp
	f fp content


{-
read_file
 :: (Consable c j, Monoid j)
 => Context_Read c j
 -> FilePath
 -> ExceptT [R.Error Error_Read] IO (Journal j)
read_file ctx path =
	ExceptT
	 (Exn.catch
		 (Right <$> Text.IO.readFile path) $
		 \ko -> return $ Left $
			 [R.Error_Custom (R.initialPos path) $
				Error_Read_reading_file path ko])
	>>= liftIO . R.runParserTWithError
	 (read_journal path) ctx path
	>>= \x -> case x of
	 Left  ko -> throwE $ ko
	 Right ok -> ExceptT $ return $ Right ok
-}