--- * -*- outline-regexp:"--- *"; -*-
--- ** doc
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
{-|

A reader for hledger's journal file format
(<http://hledger.org/hledger.html#the-journal-file>).  hledger's journal
format is a compatible subset of c++ ledger's
(<http://ledger-cli.org/3.0/doc/ledger3.html#Journal-Format>), so this
reader should handle many ledger files as well. Example:

@
2012\/3\/24 gift
    expenses:gifts  $10
    assets:cash
@

Journal format supports the include directive which can read files in
other formats, so the other file format readers need to be importable
and invocable here.

Some important parts of journal parsing are therefore kept in
Hledger.Read.Common, to avoid import cycles.

-}

--- ** language

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NoMonoLocalBinds    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}

--- ** exports
module Hledger.Read.JournalReader (

  -- * Reader-finding utils
  findReader,
  splitReaderPrefix,

  -- * Reader
  reader,

  -- * Parsing utils
  parseAndFinaliseJournal,
  runJournalParser,
  rjp,
  runErroringJournalParser,
  rejp,

  -- * Parsers used elsewhere
  getParentAccount,
  journalp,
  directivep,
  defaultyeardirectivep,
  marketpricedirectivep,
  datetimep,
  datep,
  modifiedaccountnamep,
  tmpostingrulep,
  statusp,
  emptyorcommentlinep,
  followingcommentp,
  accountaliasp

  -- * Tests
  ,tests_JournalReader
)
where

--- ** imports
import qualified Control.Monad.Fail as Fail (fail)
import qualified Control.Exception as C
import Control.Monad (forM_, when, void, unless)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.State.Strict (evalStateT,get,modify',put)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower)
import Data.Either (isRight, lefts)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Data.String
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Safe
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Printf
import System.FilePath
import "Glob" System.FilePath.Glob hiding (match)

import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils

import qualified Hledger.Read.CsvReader as CsvReader (reader)
import qualified Hledger.Read.RulesReader as RulesReader (reader)
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
import System.Directory (canonicalizePath)

--- ** doctest setup
-- $setup
-- >>> :set -XOverloadedStrings
--
--- ** parsing utilities

-- | Run a journal parser in some monad. See also: parseWithState.
runJournalParser, rjp
  :: Monad m
  => JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser :: forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser JournalParser m a
p = ParsecT HledgerParseErrorData Text m a
-> String -> Text -> m (Either HledgerParseErrors a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (JournalParser m a
-> Journal -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JournalParser m a
p Journal
nulljournal) String
""
rjp :: forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp = JournalParser m a -> Text -> m (Either HledgerParseErrors a)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser

-- | Run an erroring journal parser in some monad. See also: parseWithState.
runErroringJournalParser, rejp
  :: Monad m
  => ErroringJournalParser m a
  -> Text
  -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser :: forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser ErroringJournalParser m a
p Text
t =
  ExceptT FinalParseError m (Either HledgerParseErrors a)
-> m (Either FinalParseError (Either HledgerParseErrors a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FinalParseError m (Either HledgerParseErrors a)
 -> m (Either FinalParseError (Either HledgerParseErrors a)))
-> ExceptT FinalParseError m (Either HledgerParseErrors a)
-> m (Either FinalParseError (Either HledgerParseErrors a))
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) a
-> String
-> Text
-> ExceptT FinalParseError m (Either HledgerParseErrors a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ErroringJournalParser m a
-> Journal
-> ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser m a
p Journal
nulljournal) String
"" Text
t
rejp :: forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
rejp = ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser


--- ** reader finding utilities
-- Defined here rather than Hledger.Read so that we can use them in includedirectivep below.

-- The available journal readers, each one handling a particular data format.
readers' :: MonadIO m => [Reader m]
readers' :: forall (m :: * -> *). MonadIO m => [Reader m]
readers' = [
  Reader m
forall (m :: * -> *). MonadIO m => Reader m
reader
 ,Reader m
forall (m :: * -> *). MonadIO m => Reader m
TimeclockReader.reader
 ,Reader m
forall (m :: * -> *). MonadIO m => Reader m
TimedotReader.reader
 ,Reader m
forall (m :: * -> *). MonadIO m => Reader m
RulesReader.reader
 ,SepFormat -> Reader m
forall (m :: * -> *). MonadIO m => SepFormat -> Reader m
CsvReader.reader SepFormat
Csv
 ,SepFormat -> Reader m
forall (m :: * -> *). MonadIO m => SepFormat -> Reader m
CsvReader.reader SepFormat
Tsv
 ,SepFormat -> Reader m
forall (m :: * -> *). MonadIO m => SepFormat -> Reader m
CsvReader.reader SepFormat
Ssv
--  ,LedgerReader.reader
 ]

readerNames :: [String]
readerNames :: [String]
readerNames = (Reader IO -> String) -> [Reader IO] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (StorageFormat -> String
forall a. Show a => a -> String
show (StorageFormat -> String)
-> (Reader IO -> StorageFormat) -> Reader IO -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader IO -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat) ([Reader IO]
forall (m :: * -> *). MonadIO m => [Reader m]
readers'::[Reader IO])

-- | @findReader mformat mpath@
--
-- Find the reader named by @mformat@, if provided.
-- ("ssv" and "tsv" are recognised as alternate names for the csv reader,
-- which also handles those formats.)
-- Or, if a file path is provided, find the first reader that handles
-- its file extension, if any.
findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m)
findReader :: forall (m :: * -> *).
MonadIO m =>
Maybe StorageFormat -> Maybe String -> Maybe (Reader m)
findReader Maybe StorageFormat
Nothing Maybe String
Nothing     = Maybe (Reader m)
forall a. Maybe a
Nothing
findReader (Just StorageFormat
fmt) Maybe String
_        = [Reader m] -> Maybe (Reader m)
forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- [Reader m]
forall (m :: * -> *). MonadIO m => [Reader m]
readers', let rname :: StorageFormat
rname = Reader m -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat Reader m
r, StorageFormat
rname StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== StorageFormat
fmt]
findReader Maybe StorageFormat
Nothing (Just String
path) =
  case Maybe StorageFormat
prefix of
    Just StorageFormat
fmt -> [Reader m] -> Maybe (Reader m)
forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- [Reader m]
forall (m :: * -> *). MonadIO m => [Reader m]
readers', Reader m -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat Reader m
r StorageFormat -> StorageFormat -> Bool
forall a. Eq a => a -> a -> Bool
== StorageFormat
fmt]
    Maybe StorageFormat
Nothing  -> [Reader m] -> Maybe (Reader m)
forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- [Reader m]
forall (m :: * -> *). MonadIO m => [Reader m]
readers', String
ext String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Reader m -> [String]
forall (m :: * -> *). Reader m -> [String]
rExtensions Reader m
r]
  where
    (Maybe StorageFormat
prefix,String
path') = String -> (Maybe StorageFormat, String)
splitReaderPrefix String
path
    ext :: String
ext            = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
path'

-- | A file path optionally prefixed by a reader name and colon
-- (journal:, csv:, timedot:, etc.).
type PrefixedFilePath = FilePath

-- | If a filepath is prefixed by one of the reader names and a colon,
-- split that off. Eg "csv:-" -> (Just "csv", "-").
-- These reader prefixes can be used to force a specific reader,
-- overriding the file extension. 
splitReaderPrefix :: PrefixedFilePath -> (Maybe StorageFormat, FilePath)
splitReaderPrefix :: String -> (Maybe StorageFormat, String)
splitReaderPrefix String
f =
  let 
  candidates :: [(Maybe String, String)]
candidates = [(String -> Maybe String
forall a. a -> Maybe a
Just String
r, Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
f) | String
r <- [String]
readerNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"ssv",String
"tsv"], (String
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f]
  (Maybe String
strPrefix, String
newF) = (Maybe String, String)
-> [(Maybe String, String)] -> (Maybe String, String)
forall a. a -> [a] -> a
headDef (Maybe String
forall a. Maybe a
Nothing, String
f) [(Maybe String, String)]
candidates
  in case Maybe String
strPrefix of
  Just String
"csv" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just (SepFormat -> StorageFormat
Sep SepFormat
Csv), String
newF)
  Just String
"tsv" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just (SepFormat -> StorageFormat
Sep SepFormat
Tsv), String
newF)
  Just String
"ssv" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just (SepFormat -> StorageFormat
Sep SepFormat
Ssv), String
newF)
  Just String
"journal" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
Journal', String
newF)
  Just String
"timeclock" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
Timeclock, String
newF)
  Just String
"timedot" -> (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just StorageFormat
Timedot, String
newF)
  Maybe String
_ -> (Maybe StorageFormat
forall a. Maybe a
Nothing, String
f)

--- ** reader

reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
  {rFormat :: StorageFormat
rFormat     = StorageFormat
Journal'
  ,rExtensions :: [String]
rExtensions = [String
"journal", String
"j", String
"hledger", String
"ledger"]
  ,rReadFn :: InputOpts -> String -> Handle -> ExceptT String IO Journal
rReadFn     = (InputOpts -> String -> Text -> ExceptT String IO Journal)
-> InputOpts -> String -> Handle -> ExceptT String IO Journal
handleReadFnToTextReadFn InputOpts -> String -> Text -> ExceptT String IO Journal
parse
  ,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser    = ErroringJournalParser m Journal
MonadIO m => ErroringJournalParser m Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp  -- no need to add command line aliases like journalp'
                           -- when called as a subparser I think
  }

-- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error.
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> String -> Text -> ExceptT String IO Journal
parse InputOpts
iopts String
f = ErroringJournalParser IO Journal
-> InputOpts -> String -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
journalp' InputOpts
iopts String
f
  where
    journalp' :: ErroringJournalParser IO Journal
journalp' = do
      -- reverse parsed aliases to ensure that they are applied in order given on commandline
      (AccountAlias
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
      ())
-> [AccountAlias]
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AccountAlias
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
     ()
forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias ([AccountAlias] -> [AccountAlias]
forall a. [a] -> [a]
reverse ([AccountAlias] -> [AccountAlias])
-> [AccountAlias] -> [AccountAlias]
forall a b. (a -> b) -> a -> b
$ InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
      ErroringJournalParser IO Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp

--- ** parsers
--- *** journal

-- | A journal parser. Accumulates and returns a "ParsedJournal",
-- which should be finalised/validated before use.
--
-- >>> rejp (journalp <* eof) "2015/1/1\n a  0\n"
-- Right (Right Journal (unknown) with 1 transactions, 1 accounts)
--
journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
journalp :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp = do
  StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
addJournalItemP
  StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  Journal
forall s (m :: * -> *). MonadState s m => m s
get

-- | A side-effecting parser; parses any kind of journal item
-- and updates the parse state accordingly.
addJournalItemP :: MonadIO m => ErroringJournalParser m ()
addJournalItemP :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
addJournalItemP =
  -- all journal line types can be distinguished by the first
  -- character, can use choice without backtracking
  [StateT
   Journal
   (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
   ()]
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
      StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep
    , JournalParser (ExceptT FinalParseError m) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp          JournalParser (ExceptT FinalParseError m) Transaction
-> (Transaction
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall a b.
StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  a
-> (a
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         b)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
      ())
-> (Transaction -> Journal -> Journal)
-> Transaction
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Journal -> Journal
addTransaction
    , JournalParser (ExceptT FinalParseError m) TransactionModifier
forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp  JournalParser (ExceptT FinalParseError m) TransactionModifier
-> (TransactionModifier
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall a b.
StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  a
-> (a
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         b)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
      ())
-> (TransactionModifier -> Journal -> Journal)
-> TransactionModifier
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionModifier -> Journal -> Journal
addTransactionModifier
    , JournalParser (ExceptT FinalParseError m) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp  JournalParser (ExceptT FinalParseError m) PeriodicTransaction
-> (PeriodicTransaction
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall a b.
StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  a
-> (a
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         b)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
      ())
-> (PeriodicTransaction -> Journal -> Journal)
-> PeriodicTransaction
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction
    , JournalParser (ExceptT FinalParseError m) PriceDirective
forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep JournalParser (ExceptT FinalParseError m) PriceDirective
-> (PriceDirective
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall a b.
StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  a
-> (a
    -> StateT
         Journal
         (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
         b)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
      ())
-> (PriceDirective -> Journal -> Journal)
-> PriceDirective
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Journal -> Journal
addPriceDirective
    , StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
    , StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
forall (m :: * -> *). TextParser m ()
multilinecommentp)
    ] StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
-> String
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"transaction or directive"

--- *** directives

-- | Parse any journal directive and update the parse state accordingly.
-- Cf http://hledger.org/hledger.html#directives,
-- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
directivep :: MonadIO m => ErroringJournalParser m ()
directivep :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep = (do
  StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  (Token Text)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT
   Journal
   (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
   (Token Text)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
      (Maybe (Token Text)))
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Token Text)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Maybe (Token Text))
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'!',Char
'@']
  [StateT
   Journal
   (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
   ()]
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
    StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
aliasdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endaliasesdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
applyaccountdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
applyfixeddirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
applytagdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
assertdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
bucketdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
capturedirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
checkdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
commandlineflagdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
commoditydirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
decimalmarkdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
definedirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endapplyaccountdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endapplyfixeddirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endapplytagdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endapplyyeardirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
evaldirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
exprdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
pythondirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
tagdirectivep
   ,StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
forall (m :: * -> *). JournalParser m ()
valuedirectivep
   ]
  ) StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  ()
-> String
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"

-- | Parse an include directive, and the file(s) it refers to, possibly recursively.
-- include's argument is a file path or glob pattern, optionally with a file type prefix.
-- ~ at the start is expanded to the user's home directory.
-- Relative paths are relative to the current file.
-- Examples: foo.j, ../foo/bar.j, timedot:/foo/2020*, *.journal
includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep = do
  Tokens Text
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"include"
  ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m) ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  prefixedglob <- String -> String
rstrip (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     Text
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n') -- don't consume newline yet
  parentoff <- getOffset
  parentpos <- getSourcePos
  let (mprefix,glb) = splitReaderPrefix prefixedglob
  paths <- getFilePaths parentoff parentpos glb
  let prefixedpaths = case Maybe StorageFormat
mprefix of
        Maybe StorageFormat
Nothing  -> [String]
paths
        Just StorageFormat
fmt -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((StorageFormat -> String
forall a. Show a => a -> String
show StorageFormat
fmtString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":")String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
paths
  forM_ prefixedpaths $ parseChild parentpos
  void newline

  where
    getFilePaths
      :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
    getFilePaths :: forall (m :: * -> *).
MonadIO m =>
Int -> SourcePos -> String -> JournalParser m [String]
getFilePaths Int
parseroff SourcePos
parserpos String
fileglobpattern = do
        -- Expand a ~ at the start of the glob pattern, if any.
        fileglobpattern' <- ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m String
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) String)
-> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b. (a -> b) -> a -> b
$ String -> IO String
expandHomePath String
fileglobpattern
                         IO String -> String -> ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *) a.
MonadIO m =>
IO a -> String -> TextParser m a
`orRethrowIOError` (SourcePos -> String
forall a. Show a => a -> String
show SourcePos
parserpos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" locating " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fileglobpattern)
        -- Compile the glob pattern.
        fileglob <- case tryCompileWith compDefault{errorRecovery=False} fileglobpattern' of
            Right Pattern
x -> Pattern
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Pattern
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
x
            Left String
e -> HledgerParseErrorData
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Pattern
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Pattern)
-> HledgerParseErrorData
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Pattern
forall a b. (a -> b) -> a -> b
$ Int -> String -> HledgerParseErrorData
parseErrorAt Int
parseroff (String -> HledgerParseErrorData)
-> String -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$ String
"Invalid glob pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
        -- Get the directory of the including file. This will be used to resolve relative paths.
        let parentfilepath = SourcePos -> String
sourceName SourcePos
parserpos
        realparentfilepath <- liftIO $ canonicalizePath parentfilepath   -- Follow a symlink. If the path is already absolute, the operation never fails. 
        let curdir = String -> String
takeDirectory String
realparentfilepath
        -- Find all matched files, in lexicographic order mimicking the output of 'ls'.
        filepaths <- liftIO $ sort <$> globDir1 fileglob curdir
        if (not . null) filepaths
            then pure filepaths
            else customFailure $ parseErrorAt parseroff $
                   "No existing files match pattern: " ++ fileglobpattern

    parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()
    parseChild :: forall (m :: * -> *).
MonadIO m =>
SourcePos -> String -> ErroringJournalParser m ()
parseChild SourcePos
parentpos String
prefixedpath = do
      let (Maybe StorageFormat
_mprefix,String
filepath) = String -> (Maybe StorageFormat, String)
splitReaderPrefix String
prefixedpath

      parentj <- StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
  Journal
forall s (m :: * -> *). MonadState s m => m s
get
      let parentfilestack = Journal -> [String]
jincludefilestack Journal
parentj
      when (filepath `elem` parentfilestack) $
        Fail.fail ("Cyclic include: " ++ filepath)

      childInput <-
        traceOrLogAt 6 ("parseChild: "++takeFileName filepath) $
        lift $ readFilePortably filepath
          `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
      let initChildj = String -> Journal -> Journal
newJournalWithParseStateFrom String
filepath Journal
parentj

      -- Choose a reader/parser based on the file path prefix or file extension,
      -- defaulting to JournalReader. Duplicating readJournal a bit here.
      let r = Reader m -> Maybe (Reader m) -> Reader m
forall a. a -> Maybe a -> a
fromMaybe Reader m
forall (m :: * -> *). MonadIO m => Reader m
reader (Maybe (Reader m) -> Reader m) -> Maybe (Reader m) -> Reader m
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat -> Maybe String -> Maybe (Reader m)
forall (m :: * -> *).
MonadIO m =>
Maybe StorageFormat -> Maybe String -> Maybe (Reader m)
findReader Maybe StorageFormat
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
prefixedpath)
          parser = Reader m
-> MonadIO m =>
   StateT
     Journal
     (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
     Journal
forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser Reader m
r
      dbg6IO "parseChild: trying reader" (rFormat r)

      -- Parse the file (of whichever format) to a Journal, with file path and source text attached.
      updatedChildj <- journalAddFile (filepath, childInput) <$>
                        parseIncludeFile parser initChildj filepath childInput

      -- Merge this child journal into the parent journal
      -- (with debug logging for troubleshooting account display order).
      -- The parent journal is the second argument to journalConcat; this means
      -- its parse state is kept, and its lists are appended to child's (which
      -- ultimately produces the right list order, because parent's and child's
      -- lists are in reverse order at this stage. Cf #1909).
      let
        parentj' =
          String -> Journal -> Journal
dbgJournalAcctDeclOrder (String
"parseChild: child " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
childfilename String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" acct decls: ") Journal
updatedChildj
          Journal -> Journal -> Journal
`journalConcat`
          String -> Journal -> Journal
dbgJournalAcctDeclOrder (String
"parseChild: parent " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
parentfilename String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" acct decls: ") Journal
parentj

          where
            childfilename :: String
childfilename = String -> String
takeFileName String
filepath
            parentfilename :: String
parentfilename = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(unknown)" String -> String
takeFileName (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
headMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Journal -> [String]
jincludefilestack Journal
parentj  -- XXX more accurate than journalFilePath for some reason

      -- Update the parse state.
      put parentj'

    newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
    newJournalWithParseStateFrom :: String -> Journal -> Journal
newJournalWithParseStateFrom String
filepath Journal
j = Journal
nulljournal{
      jparsedefaultyear      = jparsedefaultyear j
      ,jparsedefaultcommodity = jparsedefaultcommodity j
      ,jparseparentaccounts   = jparseparentaccounts j
      ,jparsedecimalmark      = jparsedecimalmark j
      ,jparsealiases          = jparsealiases j
      ,jdeclaredcommodities           = jdeclaredcommodities j
      -- ,jparsetransactioncount = jparsetransactioncount j
      ,jparsetimeclockentries = jparsetimeclockentries j
      ,jincludefilestack      = filepath : jincludefilestack j
      }

-- | Lift an IO action into the exception monad, rethrowing any IO
-- error with the given message prepended.
orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
orRethrowIOError :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> String -> TextParser m a
orRethrowIOError IO a
io String
msg = do
  eResult <- IO (Either String a)
-> ParsecT HledgerParseErrorData Text m (Either String a)
forall a. IO a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String a)
 -> ParsecT HledgerParseErrorData Text m (Either String a))
-> IO (Either String a)
-> ParsecT HledgerParseErrorData Text m (Either String a)
forall a b. (a -> b) -> a -> b
$ (a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> IO a -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
io) IO (Either String a)
-> (IOException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` \(IOException
e::C.IOException) -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s:\n%s" String
msg (IOException -> String
forall a. Show a => a -> String
show IOException
e)
  case eResult of
    Right a
res -> a -> ParsecT HledgerParseErrorData Text m a
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
    Left String
errMsg -> String -> ParsecT HledgerParseErrorData Text m a
forall a. String -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
errMsg

-- Parse an account directive, adding its info to the journal's
-- list of account declarations.
accountdirectivep :: JournalParser m ()
accountdirectivep :: forall (m :: * -> *). JournalParser m ()
accountdirectivep = do
  off <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset -- XXX figure out a more precise position later
  pos <- getSourcePos

  string "account"
  lift skipNonNewlineSpaces1

  -- the account name, possibly modified by preceding alias or apply account directives
  acct <- (notFollowedBy (char '(' <|> char '[') <?> "account name without brackets") >>
          modifiedaccountnamep

  -- maybe a comment, on this and/or following lines
  (cmt, tags) <- lift transactioncommentp

  -- maybe Ledger-style subdirectives (ignored)
  skipMany indentedlinep

  -- an account type may have been set by account type code or a tag;
  -- the latter takes precedence
  let
    metype = Text -> Either String AccountType
parseAccountTypeCode (Text -> Either String AccountType)
-> Maybe Text -> Maybe (Either String AccountType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Tag] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
accountTypeTagName [Tag]
tags

  -- update the journal
  addAccountDeclaration (acct, cmt, tags, pos)
  unless (null tags) $ addDeclaredAccountTags acct tags
  case metype of
    Maybe (Either String AccountType)
Nothing         -> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Right AccountType
t)  -> Text
-> AccountType
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
t
    Just (Left String
err) -> HledgerParseErrorData
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> HledgerParseErrorData
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> HledgerParseErrorData
parseErrorAt Int
off String
err

-- The special tag used for declaring account type. XXX change to "class" ?
accountTypeTagName :: Text
accountTypeTagName = Text
"type"

parseAccountTypeCode :: Text -> Either String AccountType
parseAccountTypeCode :: Text -> Either String AccountType
parseAccountTypeCode Text
s =
  case Text -> Text
T.toLower Text
s of
    Text
"asset"      -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Asset
    Text
"a"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Asset
    Text
"liability"  -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Liability
    Text
"l"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Liability
    Text
"equity"     -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Equity
    Text
"e"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Equity
    Text
"revenue"    -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Revenue
    Text
"r"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Revenue
    Text
"expense"    -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Expense
    Text
"x"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Expense
    Text
"cash"       -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Cash
    Text
"c"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Cash
    Text
"conversion" -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Conversion
    Text
"v"          -> AccountType -> Either String AccountType
forall a b. b -> Either a b
Right AccountType
Conversion
    Text
_            -> String -> Either String AccountType
forall a b. a -> Either a b
Left String
err
  where
    err :: String
err = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"invalid account type code "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
sText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
", should be one of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text -> [Text] -> Text
T.intercalate Text
", " [Text
"A",Text
"L",Text
"E",Text
"R",Text
"X",Text
"C",Text
"V",Text
"Asset",Text
"Liability",Text
"Equity",Text
"Revenue",Text
"Expense",Text
"Cash",Text
"Conversion"]

-- Add an account declaration to the journal, auto-numbering it.
addAccountDeclaration :: (AccountName,Text,[Tag],SourcePos) -> JournalParser m ()
addAccountDeclaration :: forall (m :: * -> *).
(Text, Text, [Tag], SourcePos) -> JournalParser m ()
addAccountDeclaration (Text
a,Text
cmt,[Tag]
tags,SourcePos
pos) = do
  (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j ->
             let
               decls :: [(Text, AccountDeclarationInfo)]
decls = Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
               d :: (Text, AccountDeclarationInfo)
d     = (Text
a, AccountDeclarationInfo
nullaccountdeclarationinfo{
                              adicomment          = cmt
                             ,aditags             = tags
                             ,adideclarationorder = length decls + 1  -- gets renumbered when Journals are finalised or merged
                             ,adisourcepos        = pos
                             })
             in
               Journal
j{jdeclaredaccounts = d:decls})

-- Add a payee declaration to the journal.
addPayeeDeclaration :: (Payee,Text,[Tag]) -> JournalParser m ()
addPayeeDeclaration :: forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addPayeeDeclaration (Text
p, Text
cmt, [Tag]
tags) =
  (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j@Journal{[(Text, PayeeDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jdeclaredpayees} -> Journal
j{jdeclaredpayees=d:jdeclaredpayees})
             where
               d :: (Text, PayeeDeclarationInfo)
d = (Text
p
                   ,PayeeDeclarationInfo
nullpayeedeclarationinfo{
                     pdicomment = cmt
                    ,pditags    = tags
                    })

-- Add a tag declaration to the journal.
addTagDeclaration :: (TagName,Text) -> JournalParser m ()
addTagDeclaration :: forall (m :: * -> *). Tag -> JournalParser m ()
addTagDeclaration (Text
t, Text
cmt) =
  (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j@Journal{[(Text, TagDeclarationInfo)]
jdeclaredtags :: [(Text, TagDeclarationInfo)]
jdeclaredtags :: Journal -> [(Text, TagDeclarationInfo)]
jdeclaredtags} -> Journal
j{jdeclaredtags=tagandinfo:jdeclaredtags})
  where
    tagandinfo :: (Text, TagDeclarationInfo)
tagandinfo = (Text
t, TagDeclarationInfo
nulltagdeclarationinfo{tdicomment=cmt})

indentedlinep :: JournalParser m String
indentedlinep :: forall (m :: * -> *). JournalParser m String
indentedlinep = ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String
rstrip (String -> String)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline)

-- | Parse a one-line or multi-line commodity directive.
--
-- >>> Right _ <- rjp commoditydirectivep "commodity $1.00"
-- >>> Right _ <- rjp commoditydirectivep "commodity $\n  format $1.00"
-- >>> Right _ <- rjp commoditydirectivep "commodity $\n\n" -- a commodity with no format
-- >>> Right _ <- rjp commoditydirectivep "commodity $1.00\n  format $1.00" -- both, what happens ?
commoditydirectivep :: JournalParser m ()
commoditydirectivep :: forall (m :: * -> *). JournalParser m ()
commoditydirectivep = JournalParser m ()
forall (m :: * -> *). JournalParser m ()
commoditydirectiveonelinep JournalParser m () -> JournalParser m () -> JournalParser m ()
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> JournalParser m ()
forall (m :: * -> *). JournalParser m ()
commoditydirectivemultilinep

-- | Parse a one-line commodity directive.
--
-- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00"
-- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep :: forall (m :: * -> *). JournalParser m ()
commoditydirectiveonelinep = do
  (off, Amount{acommodity,astyle}) <- StateT Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount)
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT
   Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount)
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount))
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Int, Amount)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
    ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
    off <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    amt <- amountp
    pure $ (off, amt)
  lift skipNonNewlineSpaces
  _ <- lift followingcommentp
  let comm = Commodity{csymbol :: Text
csymbol=Text
acommodity, cformat :: Maybe AmountStyle
cformat=AmountStyle -> Maybe AmountStyle
forall a. a -> Maybe a
Just (AmountStyle -> Maybe AmountStyle)
-> AmountStyle -> Maybe AmountStyle
forall a b. (a -> b) -> a -> b
$ String -> AmountStyle -> AmountStyle
forall a. Show a => String -> a -> a
dbg6 String
"style from commodity directive" AmountStyle
astyle}
  if isNothing $ asdecimalmark astyle
  then customFailure $ parseErrorAt off pleaseincludedecimalpoint
  else modify' (\Journal
j -> Journal
j{jdeclaredcommodities=M.insert acommodity comm $ jdeclaredcommodities j})

pleaseincludedecimalpoint :: String
pleaseincludedecimalpoint :: String
pleaseincludedecimalpoint = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
   String
"Please include a decimal point or decimal comma in commodity directives,"
  ,String
"to help us parse correctly. It may be followed by zero or more decimal digits."
  ,String
"Examples:"
  ,String
"commodity $1000.            ; no thousands mark, decimal period, no decimals"
  ,String
"commodity 1.234,00 ARS      ; period at thousands, decimal comma, 2 decimals"
  ,String
"commodity EUR 1 000,000     ; space at thousands, decimal comma, 3 decimals"
  ,String
"commodity INR1,23,45,678.0  ; comma at thousands/lakhs/crores, decimal period, 1 decimal"
  ]

-- | Parse a multi-line commodity directive, containing 0 or more format subdirectives.
--
-- >>> Right _ <- rjp commoditydirectivemultilinep "commodity $ ; blah \n  format $1.00 ; blah"
commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep :: forall (m :: * -> *). JournalParser m ()
commoditydirectivemultilinep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  sym <- ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
commoditysymbolp
  _ <- lift followingcommentp
  -- read all subdirectives, saving format subdirectives as Lefts
  subdirectives <- many $ indented (eitherP (formatdirectivep sym) (lift restofline))
  let mfmt = [AmountStyle] -> Maybe AmountStyle
forall a. [a] -> Maybe a
lastMay ([AmountStyle] -> Maybe AmountStyle)
-> [AmountStyle] -> Maybe AmountStyle
forall a b. (a -> b) -> a -> b
$ [Either AmountStyle String] -> [AmountStyle]
forall a b. [Either a b] -> [a]
lefts [Either AmountStyle String]
subdirectives
  let comm = Commodity{csymbol :: Text
csymbol=Text
sym, cformat :: Maybe AmountStyle
cformat=Maybe AmountStyle
mfmt}
  modify' (\Journal
j -> Journal
j{jdeclaredcommodities=M.insert sym comm $ jdeclaredcommodities j})
  where
    indented :: StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
indented = (ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)

-- | Parse a format (sub)directive, throwing a parse error if its
-- symbol does not match the one given.
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep :: forall (m :: * -> *). Text -> JournalParser m AmountStyle
formatdirectivep Text
expectedsym = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"format"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  off <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Amount{acommodity,astyle} <- amountp
  _ <- lift followingcommentp
  if acommodity==expectedsym
    then
      if isNothing $ asdecimalmark astyle
      then customFailure $ parseErrorAt off pleaseincludedecimalpoint
      else return $ dbg6 "style from format subdirective" astyle
    else customFailure $ parseErrorAt off $
         printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity

-- More Ledger directives, ignore for now:
-- apply fixed, apply tag, assert, bucket, A, capture, check, define, expr
applyfixeddirectivep, endapplyfixeddirectivep, applytagdirectivep, endapplytagdirectivep,
  assertdirectivep, bucketdirectivep, capturedirectivep, checkdirectivep, 
  endapplyyeardirectivep, definedirectivep, exprdirectivep, valuedirectivep,
  evaldirectivep, pythondirectivep, commandlineflagdirectivep
  :: JournalParser m ()
applyfixeddirectivep :: forall (m :: * -> *). JournalParser m ()
applyfixeddirectivep    = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply fixed" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplyfixeddirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyfixeddirectivep = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply fixed" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applytagdirectivep :: forall (m :: * -> *). JournalParser m ()
applytagdirectivep      = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply tag" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplytagdirectivep :: forall (m :: * -> *). JournalParser m ()
endapplytagdirectivep   = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply tag" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplyyeardirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyyeardirectivep  = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply year" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertdirectivep :: forall (m :: * -> *). JournalParser m ()
assertdirectivep        = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"assert"  StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
bucketdirectivep :: forall (m :: * -> *). JournalParser m ()
bucketdirectivep        = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"A " StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"bucket " StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
capturedirectivep :: forall (m :: * -> *). JournalParser m ()
capturedirectivep       = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"capture" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkdirectivep :: forall (m :: * -> *). JournalParser m ()
checkdirectivep         = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"check"   StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
definedirectivep :: forall (m :: * -> *). JournalParser m ()
definedirectivep        = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"define"  StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
exprdirectivep :: forall (m :: * -> *). JournalParser m ()
exprdirectivep          = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"expr"    StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
valuedirectivep :: forall (m :: * -> *). JournalParser m ()
valuedirectivep         = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"value"   StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
evaldirectivep :: forall (m :: * -> *). JournalParser m ()
evaldirectivep          = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"eval"   StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
commandlineflagdirectivep :: forall (m :: * -> *). JournalParser m ()
commandlineflagdirectivep = do Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pythondirectivep :: forall (m :: * -> *). JournalParser m ()
pythondirectivep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"python" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline
  StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT Journal (ParsecT HledgerParseErrorData Text m) String
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) [String])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [String]
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) String
indentedline StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Journal (ParsecT HledgerParseErrorData Text m) String
blankline
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    indentedline :: StateT Journal (ParsecT HledgerParseErrorData Text m) String
indentedline = ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline
    blankline :: StateT Journal (ParsecT HledgerParseErrorData Text m) String
blankline = ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
StateT Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" StateT Journal (ParsecT HledgerParseErrorData Text m) String
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"blank line"

keywordp :: String -> JournalParser m ()
keywordp :: forall (m :: * -> *). String -> JournalParser m ()
keywordp = StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT
   Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> (String
    -> StateT
         Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text))
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text))
-> (String -> Tokens Text)
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Tokens Text
forall a. IsString a => String -> a
fromString

spacesp :: JournalParser m ()
spacesp :: forall (m :: * -> *). JournalParser m ()
spacesp = StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1

-- | Backtracking parser similar to string, but allows varying amount of space between words
keywordsp :: String -> JournalParser m ()
keywordsp :: forall (m :: * -> *). String -> JournalParser m ()
keywordsp = StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> (String
    -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> (String
    -> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()])
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
-> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
forall a. a -> [a] -> [a]
intersperse StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spacesp ([StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
 -> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()])
-> (String
    -> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()])
-> String
-> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> [String]
-> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). String -> JournalParser m ()
keywordp ([String]
 -> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()])
-> (String -> [String])
-> String
-> [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep :: forall (m :: * -> *). JournalParser m ()
applyaccountdirectivep = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
keywordsp String
"apply account" JournalParser m () -> String -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"apply account directive"
  ParsecT HledgerParseErrorData Text m () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  parent <- ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
accountnamep
  newline
  pushParentAccount parent

endapplyaccountdirectivep :: JournalParser m ()
endapplyaccountdirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyaccountdirectivep = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
keywordsp String
"end apply account" JournalParser m () -> String -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end apply account directive"
  JournalParser m ()
forall (m :: * -> *). JournalParser m ()
popParentAccount

aliasdirectivep :: JournalParser m ()
aliasdirectivep :: forall (m :: * -> *). JournalParser m ()
aliasdirectivep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"alias"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  alias <- ParsecT HledgerParseErrorData Text m AccountAlias
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) AccountAlias
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m AccountAlias
forall (m :: * -> *). TextParser m AccountAlias
accountaliasp
  addAccountAlias alias

endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep :: forall (m :: * -> *). JournalParser m ()
endaliasesdirectivep = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
keywordsp String
"end aliases" JournalParser m () -> String -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end aliases directive"
  JournalParser m ()
forall (m :: * -> *). MonadState Journal m => m ()
clearAccountAliases

tagdirectivep :: JournalParser m ()
tagdirectivep :: forall (m :: * -> *). JournalParser m ()
tagdirectivep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"tag directive"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  tagname <- ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m Text
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> ParsecT HledgerParseErrorData Text m String
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT HledgerParseErrorData Text m Char
forall (m :: * -> *). TextParser m Char
nonspace
  (comment, _) <- lift transactioncommentp
  skipMany indentedlinep
  addTagDeclaration (tagname,comment)
  return ()

-- end tag or end apply tag
endtagdirectivep :: JournalParser m ()
endtagdirectivep :: forall (m :: * -> *). JournalParser m ()
endtagdirectivep = (do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe ()))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ) StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end tag or end apply tag directive"

payeedirectivep :: JournalParser m ()
payeedirectivep :: forall (m :: * -> *). JournalParser m ()
payeedirectivep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"payee" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"payee directive"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  payee <- ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m Text
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
doublequotedtextp ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
noncommenttext1p)
  (comment, tags) <- lift transactioncommentp
  skipMany indentedlinep
  addPayeeDeclaration (payee, comment, tags)
  return ()

defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep :: forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep = do
  (Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Y" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"year" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply year") StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"default year"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Integer -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). Integer -> JournalParser m ()
setYear (Integer
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT HledgerParseErrorData Text m Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Integer
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Integer
forall (m :: * -> *). TextParser m Integer
yearp

defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep :: forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep = do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'D' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"default commodity"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  off <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Amount{acommodity,astyle} <- amountp
  lift restofline
  if isNothing $ asdecimalmark astyle
  then customFailure $ parseErrorAt off pleaseincludedecimalpoint
  else setDefaultCommodityAndStyle (acommodity, astyle)

marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep :: forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep = do
  pos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  char 'P' <?> "market price"
  lift skipNonNewlineSpaces
  date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
  lift skipNonNewlineSpaces1
  symbol <- lift commoditysymbolp
  lift skipNonNewlineSpaces1
  price <- amountp
  lift restofline
  return $ PriceDirective pos date symbol price

ignoredpricecommoditydirectivep :: JournalParser m ()
ignoredpricecommoditydirectivep :: forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep = do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'N' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ignored-price commodity"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
commoditysymbolp
  ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep :: forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep = do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'C' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"commodity conversion"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  ParsecT HledgerParseErrorData Text m String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) String
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *). TextParser m String
restofline
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Read a valid decimal mark from the decimal-mark directive e.g
--
-- decimal-mark ,
decimalmarkdirectivep :: JournalParser m ()
decimalmarkdirectivep :: forall (m :: * -> *). JournalParser m ()
decimalmarkdirectivep = do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"decimal-mark" StateT Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"decimal mark"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  mark <- (Token Text -> Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDecimalMark
  modify' $ \Journal
j -> Journal
j{jparsedecimalmark=Just mark}
  lift restofline
  return ()

--- *** transactions

-- | Parse a transaction modifier (auto postings) rule.
transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp :: forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp = do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"modifier transaction"
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  querytxt <- ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m Text
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp
  (_comment, _tags) <- lift transactioncommentp   -- TODO apply these to modified txns ?
  postingrules <- tmpostingrulesp Nothing
  return $ TransactionModifier querytxt postingrules

-- | Parse a periodic transaction rule.
--
-- This reuses periodexprp which parses period expressions on the command line.
-- This is awkward because periodexprp supports relative and partial dates,
-- which we don't really need here, and it doesn't support the notion of a
-- default year set by a Y directive, which we do need to consider here.
-- We resolve it as follows: in periodic transactions' period expressions,
-- if there is a default year Y in effect, partial/relative dates are calculated
-- relative to Y/1/1. If not, they are calculated related to today as usual.
periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction
periodictransactionp :: forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp = do
  startpos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos

  -- first line
  char '~' <?> "periodic transaction"
  lift $ skipNonNewlineSpaces

  -- if there's a default year in effect, use Y/1/1 as base for partial/relative dates
  today <- liftIO getCurrentDay
  mdefaultyear <- getYear
  let refdate = case Maybe Integer
mdefaultyear of
                  Maybe Integer
Nothing -> Day
today
                  Just Integer
y  -> Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
1 Int
1
  periodExcerpt <- lift $ excerpt_ $
                    singlespacedtextsatisfying1p (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  let periodtxt = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SourceExcerpt -> Text
getExcerptText SourceExcerpt
periodExcerpt

  -- first parsing with 'singlespacedtextp', then "re-parsing" with
  -- 'periodexprp' saves 'periodexprp' from having to respect the single-
  -- and double-space parsing rules
  (interval, spn) <- lift $ reparseExcerpt periodExcerpt $ do
    pexp <- periodexprp refdate
    (<|>) eof $ do
      offset1 <- getOffset
      void takeRest
      offset2 <- getOffset
      customFailure $ parseErrorAtRegion offset1 offset2 $
           "remainder of period expression cannot be parsed"
        <> "\nperhaps you need to terminate the period expression with a double space?"
        <> "\na double space is required between period expression and description/comment"
    pure pexp

  status <- lift statusp <?> "cleared status"
  code <- lift codep <?> "transaction code"
  description <- lift $ T.strip <$> descriptionp
  (comment, tags) <- lift transactioncommentp
  -- next lines; use same year determined above
  postings <- postingsp (Just $ first3 $ toGregorian refdate)

  endpos <- getSourcePos
  let sourcepos = (SourcePos
startpos, SourcePos
endpos)

  return $ nullperiodictransaction{
     ptperiodexpr=periodtxt
    ,ptinterval=interval
    ,ptspan=spn
    ,ptsourcepos=sourcepos
    ,ptstatus=status
    ,ptcode=code
    ,ptdescription=description
    ,ptcomment=comment
    ,pttags=tags
    ,ptpostings=postings
    }

-- | Parse a (possibly unbalanced) transaction.
transactionp :: JournalParser m Transaction
transactionp :: forall (m :: * -> *). JournalParser m Transaction
transactionp = do
  -- dbgparse 0 "transactionp"
  startpos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  date <- datep <?> "transaction"
  edate <- optional (lift $ secondarydatep date) <?> "secondary date"
  lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
  status <- lift statusp <?> "cleared status"
  code <- lift codep <?> "transaction code"
  description <- lift $ T.strip <$> descriptionp
  (comment, tags) <- lift transactioncommentp
  let year = (Integer, Int, Int) -> Integer
forall {a} {b} {c}. (a, b, c) -> a
first3 ((Integer, Int, Int) -> Integer) -> (Integer, Int, Int) -> Integer
forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
date
  postings <- postingsp (Just year)
  endpos <- getSourcePos
  let sourcepos = (SourcePos
startpos, SourcePos
endpos)
  return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings

--- *** postings

-- Parse the following whitespace-beginning lines as postings, posting
-- tags, and/or comments (inferring year, if needed, from the given date).
postingsp :: Maybe Year -> JournalParser m [Posting]
postingsp :: forall (m :: * -> *). Maybe Integer -> JournalParser m [Posting]
postingsp Maybe Integer
mTransactionYear = StateT Journal (ParsecT HledgerParseErrorData Text m) Posting
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
mTransactionYear) StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"postings"

-- linebeginningwithspaces :: JournalParser m String
-- linebeginningwithspaces = do
--   sp <- lift skipNonNewlineSpaces1
--   c <- nonspace
--   cs <- lift restofline
--   return $ sp ++ (c:cs) ++ "\n"

postingp :: Maybe Year -> JournalParser m Posting
postingp :: forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp = ((Posting, Bool) -> Posting)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Posting
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Posting, Bool) -> Posting
forall a b. (a, b) -> a
fst (StateT
   Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Posting)
-> (Maybe Integer
    -> StateT
         Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool))
-> Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Posting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Maybe Integer
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
forall (m :: * -> *).
Bool -> Maybe Integer -> JournalParser m (Posting, Bool)
postingphelper Bool
False

-- Parse the following whitespace-beginning lines as transaction posting rules, posting
-- tags, and/or comments (inferring year, if needed, from the given date).
tmpostingrulesp :: Maybe Year -> JournalParser m [TMPostingRule]
tmpostingrulesp :: forall (m :: * -> *).
Maybe Integer -> JournalParser m [TMPostingRule]
tmpostingrulesp Maybe Integer
mTransactionYear = StateT Journal (ParsecT HledgerParseErrorData Text m) TMPostingRule
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) [TMPostingRule]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Maybe Integer
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) TMPostingRule
forall (m :: * -> *).
Maybe Integer -> JournalParser m TMPostingRule
tmpostingrulep Maybe Integer
mTransactionYear) StateT
  Journal (ParsecT HledgerParseErrorData Text m) [TMPostingRule]
-> String
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) [TMPostingRule]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"posting rules"

tmpostingrulep :: Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep :: forall (m :: * -> *).
Maybe Integer -> JournalParser m TMPostingRule
tmpostingrulep = ((Posting, Bool) -> TMPostingRule)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) TMPostingRule
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Posting -> Bool -> TMPostingRule)
-> (Posting, Bool) -> TMPostingRule
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Posting -> Bool -> TMPostingRule
TMPostingRule) (StateT
   Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) TMPostingRule)
-> (Maybe Integer
    -> StateT
         Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool))
-> Maybe Integer
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) TMPostingRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Maybe Integer
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Posting, Bool)
forall (m :: * -> *).
Bool -> Maybe Integer -> JournalParser m (Posting, Bool)
postingphelper Bool
True

-- Parse a Posting, and return a flag with whether a multiplier has been detected.
-- The multiplier is used in TMPostingRules.
postingphelper :: Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper :: forall (m :: * -> *).
Bool -> Maybe Integer -> JournalParser m (Posting, Bool)
postingphelper Bool
isPostingRule Maybe Integer
mTransactionYear = do
    -- lift $ dbgparse 0 "postingp"
    (status, account) <- StateT
  Journal (ParsecT HledgerParseErrorData Text m) (Status, Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Status, Text)
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT
   Journal (ParsecT HledgerParseErrorData Text m) (Status, Text)
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Status, Text))
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Status, Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Status, Text)
forall a b. (a -> b) -> a -> b
$ do
      ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
      status <- ParsecT HledgerParseErrorData Text m Status
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Status
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Status
forall (m :: * -> *). TextParser m Status
statusp
      lift skipNonNewlineSpaces
      account <- modifiedaccountnamep
      return (status, account)
    let (ptype, account') = (accountNamePostingType account, textUnbracket account)
    lift skipNonNewlineSpaces
    mult <- if isPostingRule then multiplierp else pure False
    amt <- optional $ amountp' mult
    lift skipNonNewlineSpaces
    massertion <- optional balanceassertionp
    lift skipNonNewlineSpaces
    (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
    let p = Posting
posting
            { pdate=mdate
            , pdate2=mdate2
            , pstatus=status
            , paccount=account'
            , pamount=maybe missingmixedamt mixedAmount amt
            , pcomment=comment
            , ptype=ptype
            , ptags=tags
            , pbalanceassertion=massertion
            }
    return (p, mult)
  where
    multiplierp :: StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
multiplierp = Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'

--- ** tests

tests_JournalReader :: TestTree
tests_JournalReader = String -> [TestTree] -> TestTree
testGroup String
"JournalReader" [

   let p :: JournalParser IO Text
p = ParsecT HledgerParseErrorData Text IO Text -> JournalParser IO Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text IO Text
forall (m :: * -> *). TextParser m Text
accountnamep :: JournalParser IO AccountName in
   String -> [TestTree] -> TestTree
testGroup String
"accountnamep" [
     String -> Assertion -> TestTree
testCase String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ JournalParser IO Text -> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse JournalParser IO Text
p Text
"a:b:c"
    -- ,testCase "empty inner component" $ assertParseError p "a::c" ""  -- TODO
    -- ,testCase "empty leading component" $ assertParseError p ":b:c" "x"
    -- ,testCase "empty trailing component" $ assertParseError p "a:b:" "x"
    ]

  -- "Parse a date in YYYY/MM/DD format.
  -- Hyphen (-) and period (.) are also allowed as separators.
  -- The year may be omitted if a default year has been set.
  -- Leading zeroes may be omitted."
  ,String -> [TestTree] -> TestTree
testGroup String
"datep" [
     String -> Assertion -> TestTree
testCase String
"YYYY/MM/DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text -> Day -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018/01/01" (Integer -> Int -> Int -> Day
fromGregorian Integer
2018 Int
1 Int
1)
    ,String -> Assertion -> TestTree
testCase String
"YYYY-MM-DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018-01-01"
    ,String -> Assertion -> TestTree
testCase String
"YYYY.MM.DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018.01.01"
    ,String -> Assertion -> TestTree
testCase String
"yearless date with no default year" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> String -> Assertion
assertParseError StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"1/1" String
"current year is unknown"
    ,String -> Assertion -> TestTree
testCase String
"yearless date with default year" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      let s :: Text
s = Text
"1/1"
      ep <- Journal
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text
-> IO (Either HledgerParseErrors Day)
forall (m :: * -> *) st a.
Monad m =>
st
-> StateT st (ParsecT HledgerParseErrorData Text m) a
-> Text
-> m (Either HledgerParseErrors a)
parseWithState Journal
nulljournal{jparsedefaultyear=Just 2018} StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
s
      either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
    ,String -> Assertion -> TestTree
testCase String
"no leading zero" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018/1/1"
    ]
  ,String -> Assertion -> TestTree
testCase String
"datetimep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     let
       good :: Text -> Assertion
good  = StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep
       bad :: Text -> Assertion
bad Text
t = StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
-> Text -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> String -> Assertion
assertParseError StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
t String
""
     Text -> Assertion
good Text
"2011/1/1 00:00"
     Text -> Assertion
good Text
"2011/1/1 23:59:59"
     Text -> Assertion
bad Text
"2011/1/1"
     Text -> Assertion
bad Text
"2011/1/1 24:00:00"
     Text -> Assertion
bad Text
"2011/1/1 00:60:00"
     Text -> Assertion
bad Text
"2011/1/1 00:00:60"
     Text -> Assertion
bad Text
"2011/1/1 3:5:7"
     -- timezone is parsed but ignored
     let t :: LocalTime
t = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2018 Int
1 Int
1) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0)
     StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
-> Text -> LocalTime -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00-0800" LocalTime
t
     StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
-> Text -> LocalTime -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00+1234" LocalTime
t

  ,String -> [TestTree] -> TestTree
testGroup String
"periodictransactionp" [

    String -> Assertion -> TestTree
testCase String
"more period text in comment after one space" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
      Text
"~ monthly from 2018/6 ;In 2019 we will change this\n"
      PeriodicTransaction
nullperiodictransaction {
         ptperiodexpr  = "monthly from 2018/6"
        ,ptinterval    = Months 1
        ,ptspan        = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
        ,ptsourcepos   = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
        ,ptdescription = ""
        ,ptcomment     = "In 2019 we will change this\n"
        }

    ,String -> Assertion -> TestTree
testCase String
"more period text in description after two spaces" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
      Text
"~ monthly from 2018/6   In 2019 we will change this\n"
      PeriodicTransaction
nullperiodictransaction {
         ptperiodexpr  = "monthly from 2018/6"
        ,ptinterval    = Months 1
        ,ptspan        = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
        ,ptsourcepos   = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
        ,ptdescription = "In 2019 we will change this"
        ,ptcomment     = ""
        }

    ,String -> Assertion -> TestTree
testCase String
"Next year in description" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
      Text
"~ monthly  Next year blah blah\n"
      PeriodicTransaction
nullperiodictransaction {
         ptperiodexpr  = "monthly"
        ,ptinterval    = Months 1
        ,ptspan        = DateSpan Nothing Nothing
        ,ptsourcepos   = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
        ,ptdescription = "Next year blah blah"
        ,ptcomment     = ""
        }

    ,String -> Assertion -> TestTree
testCase String
"Just date, no description" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
      Text
"~ 2019-01-04\n"
      PeriodicTransaction
nullperiodictransaction {
         ptperiodexpr  = "2019-01-04"
        ,ptinterval    = NoInterval
        ,ptspan        = DateSpan (Just $ Exact $ fromGregorian 2019 1 4) (Just $ Exact $ fromGregorian 2019 1 5)
        ,ptsourcepos   = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
        ,ptdescription = ""
        ,ptcomment     = ""
        }

    ,String -> Assertion -> TestTree
testCase String
"Just date, no description + empty transaction comment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PeriodicTransaction
forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
      Text
"~ 2019-01-04\n  ;\n  a  1\n  b\n"

    ]

  ,String -> [TestTree] -> TestTree
testGroup String
"postingp" [
     String -> Assertion -> TestTree
testCase String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Posting -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing)
      Text
"  expenses:food:dining  $10.00   ; a: a a \n   ; b: b b \n"
      Posting
posting{
        paccount="expenses:food:dining",
        pamount=mixedAmount (usd 10),
        pcomment="a: a a\nb: b b\n",
        ptags=[("a","a a"), ("b","b b")]
        }

    ,String -> Assertion -> TestTree
testCase String
"posting dates" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Posting -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing)
      Text
" a  1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
      Posting
nullposting{
         paccount="a"
        ,pamount=mixedAmount (num 1)
        ,pcomment="date:2012/11/28, date2=2012/11/29,b:b\n"
        ,ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")] -- TODO tag name parsed too greedily
        ,pdate=Just $ fromGregorian 2012 11 28
        ,pdate2=Nothing  -- Just $ fromGregorian 2012 11 29
        }

    ,String -> Assertion -> TestTree
testCase String
"posting dates bracket syntax" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Posting -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing)
      Text
" a  1. ; [2012/11/28=2012/11/29]\n"
      Posting
nullposting{
         paccount="a"
        ,pamount=mixedAmount (num 1)
        ,pcomment="[2012/11/28=2012/11/29]\n"
        ,ptags=[]
        ,pdate= Just $ fromGregorian 2012 11 28
        ,pdate2=Just $ fromGregorian 2012 11 29
        }

    ,String -> Assertion -> TestTree
testCase String
"quoted commodity symbol with digits" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1 \"DE123\"\n"

    ,String -> Assertion -> TestTree
testCase String
"only lot price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A {1B}\n"
    ,String -> Assertion -> TestTree
testCase String
"fixed lot price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A {=1B}\n"
    ,String -> Assertion -> TestTree
testCase String
"total lot price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A {{1B}}\n"
    ,String -> Assertion -> TestTree
testCase String
"fixed total lot price, and spaces" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A {{  =  1B }}\n"
    ,String -> Assertion -> TestTree
testCase String
"lot price before transaction price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A {1B} @ 1B\n"
    ,String -> Assertion -> TestTree
testCase String
"lot price after transaction price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A @ 1B {1B}\n"
    ,String -> Assertion -> TestTree
testCase String
"lot price after balance assertion not allowed" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> String -> Assertion
assertParseError (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A @ 1B = 1A {1B}\n" String
"unexpected '{'"
    ,String -> Assertion -> TestTree
testCase String
"only lot date" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A [2000-01-01]\n"
    ,String -> Assertion -> TestTree
testCase String
"transaction price, lot price, lot date" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A @ 1B {1B} [2000-01-01]\n"
    ,String -> Assertion -> TestTree
testCase String
"lot date, lot price, transaction price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  1A [2000-01-01] {1B} @ 1B\n"

    ,String -> Assertion -> TestTree
testCase String
"balance assertion over entire contents of account" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (Maybe Integer
-> StateT Journal (ParsecT HledgerParseErrorData Text IO) Posting
forall (m :: * -> *). Maybe Integer -> JournalParser m Posting
postingp Maybe Integer
forall a. Maybe a
Nothing) Text
"  a  $1 == $1\n"
    ]

  ,String -> [TestTree] -> TestTree
testGroup String
"transactionmodifierp" [

    String -> Assertion -> TestTree
testCase String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) TransactionModifier
-> Text -> TransactionModifier -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) TransactionModifier
forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp
      Text
"= (some value expr)\n some:postings  1.\n"
      TransactionModifier
nulltransactionmodifier {
        tmquerytxt = "(some value expr)"
       ,tmpostingrules = [TMPostingRule nullposting{paccount="some:postings", pamount=mixedAmount (num 1)} False]
      }
    ]

  ,String -> [TestTree] -> TestTree
testGroup String
"transactionp" [

     String -> Assertion -> TestTree
testCase String
"just a date" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
-> Text -> Transaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp Text
"2015/1/1\n" Transaction
nulltransaction{tdate=fromGregorian 2015 1 1}

    ,String -> Assertion -> TestTree
testCase String
"more complex" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
-> Text -> Transaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp
      ([Text] -> Text
T.unlines [
        Text
"2012/05/14=2012/05/15 (code) desc  ; tcomment1",
        Text
"    ; tcomment2",
        Text
"    ; ttag1: val1",
        Text
"    * a         $1.00  ; pcomment1",
        Text
"    ; pcomment2",
        Text
"    ; ptag1: val1",
        Text
"    ; ptag2: val2"
        ])
      Transaction
nulltransaction{
        tsourcepos=(SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 8) (mkPos 1)),  -- 8 because there are 7 lines
        tprecedingcomment="",
        tdate=fromGregorian 2012 5 14,
        tdate2=Just $ fromGregorian 2012 5 15,
        tstatus=Unmarked,
        tcode="code",
        tdescription="desc",
        tcomment="tcomment1\ntcomment2\nttag1: val1\n",
        ttags=[("ttag1","val1")],
        tpostings=[
          nullposting{
            pdate=Nothing,
            pstatus=Cleared,
            paccount="a",
            pamount=mixedAmount (usd 1),
            pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
            ptype=RegularPosting,
            ptags=[("ptag1","val1"),("ptag2","val2")],
            ptransaction=Nothing
            }
          ]
      }

    ,String -> Assertion -> TestTree
testCase String
"parses a well-formed transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either HledgerParseErrors Transaction) -> Bool)
-> Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text -> Either Any (Either HledgerParseErrors Transaction))
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
        [Text
"2007/01/28 coopportunity"
        ,Text
"    expenses:food:groceries                   $47.18"
        ,Text
"    assets:checking                          $-47.18"
        ,Text
""
        ]

    ,String -> Assertion -> TestTree
testCase String
"does not parse a following comment as part of the description" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
-> Text -> (Transaction -> Text) -> Text -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp Text
"2009/1/1 a ;comment\n b 1\n" Transaction -> Text
tdescription Text
"a"

    ,String -> Assertion -> TestTree
testCase String
"parses a following whitespace line" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either HledgerParseErrors Transaction) -> Bool)
-> Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text -> Either Any (Either HledgerParseErrors Transaction))
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
        [Text
"2012/1/1"
        ,Text
"  a  1"
        ,Text
"  b"
        ,Text
" "
        ]

    ,String -> Assertion -> TestTree
testCase String
"parses an empty transaction comment following whitespace line" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either HledgerParseErrors Transaction) -> Bool)
-> Either Any (Either HledgerParseErrors Transaction) -> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text -> Either Any (Either HledgerParseErrors Transaction))
-> Text -> Either Any (Either HledgerParseErrors Transaction)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
        [Text
"2012/1/1"
        ,Text
"  ;"
        ,Text
"  a  1"
        ,Text
"  b"
        ,Text
" "
        ]

    ,String -> Assertion -> TestTree
testCase String
"comments everywhere, two postings parsed" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
-> Text -> (Transaction -> Int) -> Int -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT Journal (ParsecT HledgerParseErrorData Text IO) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp
        ([Text] -> Text
T.unlines
          [Text
"2009/1/1 x  ; transaction comment"
          ,Text
" a  1  ; posting 1 comment"
          ,Text
" ; posting 1 comment 2"
          ,Text
" b"
          ,Text
" ; posting 2 comment"
          ])
        ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Posting] -> Int)
-> (Transaction -> [Posting]) -> Transaction -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings)
        Int
2

    ]

  -- directives

  ,String -> [TestTree] -> TestTree
testGroup String
"directivep" [
    String -> Assertion -> TestTree
testCase String
"supports !" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT
  st
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  a
-> Text -> Assertion
assertParseE StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!account a\n"
        StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT
  st
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  a
-> Text -> Assertion
assertParseE StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!D 1.0\n"
     ]

  ,String -> [TestTree] -> TestTree
testGroup String
"accountdirectivep" [
       String -> Assertion -> TestTree
testCase String
"with-comment"       (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b  ; a comment\n"
      ,String -> Assertion -> TestTree
testCase String
"does-not-support-!" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> String -> Assertion
assertParseError StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"!account a:b\n" String
""
      ,String -> Assertion -> TestTree
testCase String
"account-type-code"  (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b  ; type:A\n"
      ,String -> Assertion -> TestTree
testCase String
"account-type-tag"   (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text
-> (Journal -> [(Text, AccountDeclarationInfo)])
-> [(Text, AccountDeclarationInfo)]
-> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (st -> b) -> b -> Assertion
assertParseStateOn StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b  ; type:asset\n"
        Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts
        [(Text
"a:b", AccountDeclarationInfo{adicomment :: Text
adicomment          = Text
"type:asset\n"
                                       ,aditags :: [Tag]
aditags             = [(Text
"type",Text
"asset")]
                                       ,adideclarationorder :: Int
adideclarationorder = Int
1
                                       ,adisourcepos :: SourcePos
adisourcepos        = SourcePos
nullsourcepos
                                       })
        ]
      ]

  ,String -> Assertion -> TestTree
testCase String
"commodityconversiondirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep Text
"C 1h = $50.00\n"

  ,String -> Assertion -> TestTree
testCase String
"defaultcommoditydirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep Text
"D $1,000.0\n"
      StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> String -> Assertion
assertParseError StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep Text
"D $1000\n" String
"Please include a decimal point or decimal comma"

  ,String -> [TestTree] -> TestTree
testGroup String
"defaultyeardirectivep" [
      String -> Assertion -> TestTree
testCase String
"1000" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep Text
"Y 1000" -- XXX no \n like the others
     -- ,testCase "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number"
     ,String -> Assertion -> TestTree
testCase String
"12345" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep Text
"Y 12345"
     ]

  ,String -> Assertion -> TestTree
testCase String
"ignoredpricecommoditydirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep Text
"N $\n"

  ,String -> [TestTree] -> TestTree
testGroup String
"includedirectivep" [
      String -> Assertion -> TestTree
testCase String
"include" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
-> Text -> String -> Assertion
forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
  st
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  a
-> Text -> String -> Assertion
assertParseErrorE StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep Text
"include nosuchfile\n" String
"No existing files match pattern: nosuchfile"
     ,String -> Assertion -> TestTree
testCase String
"glob" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
-> Text -> String -> Assertion
forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
  st
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  a
-> Text -> String -> Assertion
assertParseErrorE StateT
  Journal
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep Text
"include nosuchfile*\n" String
"No existing files match pattern: nosuchfile*"
     ]

  ,String -> Assertion -> TestTree
testCase String
"marketpricedirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PriceDirective
-> Text -> PriceDirective -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT
  Journal (ParsecT HledgerParseErrorData Text IO) PriceDirective
forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep
    Text
"P 2017/01/30 BTC $922.83\n"
    PriceDirective{
      pdsourcepos :: SourcePos
pdsourcepos = SourcePos
nullsourcepos,
      pddate :: Day
pddate      = Integer -> Int -> Int -> Day
fromGregorian Integer
2017 Int
1 Int
30,
      pdcommodity :: Text
pdcommodity = Text
"BTC",
      pdamount :: Amount
pdamount    = DecimalRaw Integer -> Amount
usd DecimalRaw Integer
922.83
      }

  ,String -> [TestTree] -> TestTree
testGroup String
"payeedirectivep" [
        String -> Assertion -> TestTree
testCase String
"simple"             (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo\n"
       ,String -> Assertion -> TestTree
testCase String
"with-comment"       (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo ; comment\n"
       ,String -> Assertion -> TestTree
testCase String
"double-quoted"      (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee \"a b\"\n"
       ,String -> Assertion -> TestTree
testCase String
"empty        "      (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee \"\"\n"
       ]

  ,String -> Assertion -> TestTree
testCase String
"tagdirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
tagdirectivep Text
"tag foo \n"

  ,String -> Assertion -> TestTree
testCase String
"endtagdirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep Text
"end tag \n"
      StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep Text
"end apply tag \n"

  ,String -> [TestTree] -> TestTree
testGroup String
"journalp" [
    String -> Assertion -> TestTree
testCase String
"empty file" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ErroringJournalParser IO Journal -> Text -> Journal -> Assertion
forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
  st
  (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
  a
-> Text -> a -> Assertion
assertParseEqE ErroringJournalParser IO Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp Text
"" Journal
nulljournal
    ]

   -- these are defined here rather than in Common so they can use journalp
  ,String -> Assertion -> TestTree
testCase String
"parseAndFinaliseJournal" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      ej <- ExceptT String IO Journal -> IO (Either String Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Journal -> IO (Either String Journal))
-> ExceptT String IO Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ ErroringJournalParser IO Journal
-> InputOpts -> String -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp InputOpts
definputopts String
"" Text
"2019-1-1\n"
      let Right j = ej
      assertEqual "" [""] $ journalFilePaths j

  ]