--- * -*- 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/MANUAL.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 CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

  -- * Reader-finding utils
  findReader,
  splitReaderPrefix,

  -- * Reader
  reader,

  -- * Parsing utils
  genericSourcePos,
  parseAndFinaliseJournal,
  runJournalParser,
  rjp,

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

  -- * Tests
  ,tests_JournalReader
)
where

--- ** imports
-- import qualified Prelude (fail)
-- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import qualified Control.Exception as C
import Control.Monad (forM_, when, void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.State.Strict (get,modify',put)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower)
import Data.Either (isRight)
import qualified Data.Map.Strict as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
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.Megaparsec.Custom
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.TimedotReader as TimedotReader (reader)
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
import qualified Hledger.Read.CsvReader as CsvReader (reader)

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

--- ** 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' :: [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
CsvReader.reader
--  ,LedgerReader.reader
 ]

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

-- | @findReader mformat mpath@
--
-- Find the reader named by @mformat@, if provided.
-- 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 :: Maybe String -> Maybe String -> Maybe (Reader m)
findReader Maybe String
Nothing Maybe String
Nothing     = Maybe (Reader m)
forall a. Maybe a
Nothing
findReader (Just String
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', Reader m -> String
forall (m :: * -> *). Reader m -> String
rFormat Reader m
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fmt]
findReader Maybe String
Nothing (Just String
path) =
  case Maybe String
prefix of
    Just String
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 -> String
forall (m :: * -> *). Reader m -> String
rFormat Reader m
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fmt]
    Maybe String
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 (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 String
prefix,String
path') = String -> (Maybe String, 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", "-").
splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
splitReaderPrefix :: String -> (Maybe String, String)
splitReaderPrefix String
f =
  (Maybe String, String)
-> [(Maybe String, String)] -> (Maybe String, String)
forall a. a -> [a] -> a
headDef (Maybe String
forall a. Maybe a
Nothing, String
f)
  [(String -> Maybe String
forall a. a -> Maybe a
Just String
r, Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> 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
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
f]

--- ** reader

reader :: MonadIO m => Reader m
reader :: Reader m
reader = Reader :: forall (m :: * -> *).
String
-> [String]
-> (InputOpts -> String -> Text -> ExceptT String IO Journal)
-> (MonadIO m => ErroringJournalParser m Journal)
-> Reader m
Reader
  {rFormat :: String
rFormat     = String
"journal"
  ,rExtensions :: [String]
rExtensions = [String
"journal", String
"j", String
"hledger", String
"ledger"]
  ,rReadFn :: InputOpts -> String -> Text -> ExceptT String IO Journal
rReadFn     = InputOpts -> String -> Text -> ExceptT String IO Journal
parse
  ,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser    = 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 = ErroringJournalParser IO Journal
-> InputOpts -> String -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
journalp' InputOpts
iopts
  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 CustomErr Text (ExceptT FinalParseError IO)) ())
-> [AccountAlias]
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AccountAlias
-> StateT
     Journal (ParsecT CustomErr 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  with 1 transactions, 1 accounts)
--
journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
journalp :: ErroringJournalParser m Journal
journalp = do
  StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) ()
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
addJournalItemP
  StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  ErroringJournalParser 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 :: ErroringJournalParser m ()
addJournalItemP =
  -- all journal line types can be distinguished by the first
  -- character, can use choice without backtracking
  [ErroringJournalParser m ()] -> ErroringJournalParser m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
      ErroringJournalParser 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 -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal) -> ErroringJournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal) -> ErroringJournalParser m ())
-> (Transaction -> Journal -> Journal)
-> Transaction
-> ErroringJournalParser 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 -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal) -> ErroringJournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal) -> ErroringJournalParser m ())
-> (TransactionModifier -> Journal -> Journal)
-> TransactionModifier
-> ErroringJournalParser 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 -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal) -> ErroringJournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal) -> ErroringJournalParser m ())
-> (PeriodicTransaction -> Journal -> Journal)
-> PeriodicTransaction
-> ErroringJournalParser 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 -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> Journal) -> ErroringJournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal) -> ErroringJournalParser m ())
-> (PriceDirective -> Journal -> Journal)
-> PriceDirective
-> ErroringJournalParser m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Journal -> Journal
addPriceDirective
    , ErroringJournalParser m () -> ErroringJournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text (ExceptT FinalParseError m) ()
-> ErroringJournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text (ExceptT FinalParseError m) ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
    , ErroringJournalParser m () -> ErroringJournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text (ExceptT FinalParseError m) ()
-> ErroringJournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text (ExceptT FinalParseError m) ()
forall (m :: * -> *). TextParser m ()
multilinecommentp)
    ] ErroringJournalParser m () -> String -> ErroringJournalParser 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/manual.html#directives,
-- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
directivep :: MonadIO m => ErroringJournalParser m ()
directivep :: ErroringJournalParser m ()
directivep = (do
  StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Char
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT
   Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Char
 -> StateT
      Journal
      (ParsecT CustomErr Text (ExceptT FinalParseError m))
      (Maybe Char))
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Char
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'!'
  [ErroringJournalParser m ()] -> ErroringJournalParser m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
    ErroringJournalParser m ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
aliasdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
endaliasesdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
applyaccountdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
commoditydirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
endapplyaccountdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
tagdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep
   ,ErroringJournalParser m ()
forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep
   ]
  ) ErroringJournalParser m () -> String -> ErroringJournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"directive"

-- | Parse an include directive. include's argument is an optionally
-- file-format-prefixed file path or glob pattern. In the latter case,
-- the prefix is applied to each matched path. Examples:
-- foo.j, foo/bar.j, timedot:foo/2020*.md
includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep :: ErroringJournalParser m ()
includedirectivep = do
  Tokens Text
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"include"
  ParsecT CustomErr Text (ExceptT FinalParseError m) ()
-> ErroringJournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text (ExceptT FinalParseError m) ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  String
prefixedglob <- Text -> String
T.unpack (Text -> String)
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Text
-> StateT
     Journal (ParsecT CustomErr 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 CustomErr 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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') -- don't consume newline yet
  Int
parentoff <- StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  SourcePos
parentpos <- StateT
  Journal
  (ParsecT CustomErr Text (ExceptT FinalParseError m))
  SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  let (Maybe String
mprefix,String
glob) = String -> (Maybe String, String)
splitReaderPrefix String
prefixedglob
  [String]
paths <- Int
-> SourcePos
-> String
-> JournalParser (ExceptT FinalParseError m) [String]
forall (m :: * -> *).
MonadIO m =>
Int -> SourcePos -> String -> JournalParser m [String]
getFilePaths Int
parentoff SourcePos
parentpos String
glob
  let prefixedpaths :: [String]
prefixedpaths = case Maybe String
mprefix of
        Maybe String
Nothing  -> [String]
paths
        Just String
fmt -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
fmtString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":")String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
paths
  [String]
-> (String -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
prefixedpaths ((String -> ErroringJournalParser m ())
 -> ErroringJournalParser m ())
-> (String -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> String -> ErroringJournalParser m ()
forall (m :: * -> *).
MonadIO m =>
SourcePos -> String -> ErroringJournalParser m ()
parseChild SourcePos
parentpos
  StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Char
-> ErroringJournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

  where
    getFilePaths
      :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
    getFilePaths :: Int -> SourcePos -> String -> JournalParser m [String]
getFilePaths Int
parseroff SourcePos
parserpos String
filename = do
        let curdir :: String
curdir = String -> String
takeDirectory (SourcePos -> String
sourceName SourcePos
parserpos)
        String
filename' <- ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m String
 -> StateT Journal (ParsecT CustomErr Text m) String)
-> ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall a b. (a -> b) -> a -> b
$ String -> IO String
expandHomePath String
filename
                         IO String -> String -> ParsecT CustomErr 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
filename)
        -- Compiling filename as a glob pattern works even if it is a literal
        Pattern
fileglob <- case CompOptions -> String -> Either String Pattern
tryCompileWith CompOptions
compDefault{errorRecovery :: Bool
errorRecovery=Bool
False} String
filename' of
            Right Pattern
x -> Pattern -> StateT Journal (ParsecT CustomErr Text m) Pattern
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
x
            Left String
e -> CustomErr -> StateT Journal (ParsecT CustomErr Text m) Pattern
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> StateT Journal (ParsecT CustomErr Text m) Pattern)
-> CustomErr -> StateT Journal (ParsecT CustomErr Text m) Pattern
forall a b. (a -> b) -> a -> b
$
                        Int -> String -> CustomErr
parseErrorAt Int
parseroff (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$ String
"Invalid glob pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
        -- Get all matching files in the current working directory, sorting in
        -- lexicographic order to simulate the output of 'ls'.
        [String]
filepaths <- IO [String] -> JournalParser m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> JournalParser m [String])
-> IO [String] -> JournalParser m [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> String -> IO [String]
globDir1 Pattern
fileglob String
curdir
        if (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
filepaths
            then [String] -> JournalParser m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
filepaths
            else CustomErr -> JournalParser m [String]
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m [String])
-> CustomErr -> JournalParser m [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
parseroff (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$
                   String
"No existing files match pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filename

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

      Journal
parentj <- StateT
  Journal
  (ParsecT CustomErr Text (ExceptT FinalParseError m))
  Journal
forall s (m :: * -> *). MonadState s m => m s
get
      let parentfilestack :: [String]
parentfilestack = Journal -> [String]
jincludefilestack Journal
parentj
      Bool -> ErroringJournalParser m () -> ErroringJournalParser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
filepath String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
parentfilestack) (ErroringJournalParser m () -> ErroringJournalParser m ())
-> ErroringJournalParser m () -> ErroringJournalParser m ()
forall a b. (a -> b) -> a -> b
$
        String -> ErroringJournalParser m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String
"Cyclic include: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filepath)

      Text
childInput <- ParsecT CustomErr Text (ExceptT FinalParseError m) Text
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text (ExceptT FinalParseError m) Text
 -> StateT
      Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Text)
-> ParsecT CustomErr Text (ExceptT FinalParseError m) Text
-> StateT
     Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFilePortably String
filepath
                            IO Text
-> String
-> ParsecT CustomErr Text (ExceptT FinalParseError m) Text
forall (m :: * -> *) a.
MonadIO m =>
IO a -> String -> TextParser m a
`orRethrowIOError` (SourcePos -> String
forall a. Show a => a -> String
show SourcePos
parentpos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filepath)
      let initChildj :: Journal
initChildj = String -> Journal -> Journal
newJournalWithParseStateFrom String
filepath Journal
parentj

      -- Choose a reader/format based on the file path, or fall back
      -- on journal. Duplicating readJournal a bit here.
      let r :: Reader m
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 String -> Maybe String -> Maybe (Reader m)
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> Maybe (Reader m)
findReader Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
prefixedpath)
          parser :: StateT
  Journal
  (ParsecT CustomErr Text (ExceptT FinalParseError m))
  Journal
parser = Reader m
-> MonadIO m =>
   StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     Journal
forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser Reader m
r
      String -> String -> ErroringJournalParser m ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"trying reader" (Reader m -> String
forall (m :: * -> *). Reader m -> String
rFormat Reader m
r)
      Journal
updatedChildj <- (String, Text) -> Journal -> Journal
journalAddFile (String
filepath, Text
childInput) (Journal -> Journal)
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     Journal
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        StateT
  Journal
  (ParsecT CustomErr Text (ExceptT FinalParseError m))
  Journal
-> Journal
-> String
-> Text
-> StateT
     Journal
     (ParsecT CustomErr Text (ExceptT FinalParseError m))
     Journal
forall (m :: * -> *) st a.
Monad m =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-> st
-> String
-> Text
-> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
parseIncludeFile StateT
  Journal
  (ParsecT CustomErr Text (ExceptT FinalParseError m))
  Journal
parser Journal
initChildj String
filepath Text
childInput

      -- discard child's parse info,  combine other fields
      Journal -> ErroringJournalParser m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Journal -> ErroringJournalParser m ())
-> Journal -> ErroringJournalParser m ()
forall a b. (a -> b) -> a -> b
$ Journal
updatedChildj Journal -> Journal -> Journal
forall a. Semigroup a => a -> a -> a
<> Journal
parentj

    newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
    newJournalWithParseStateFrom :: String -> Journal -> Journal
newJournalWithParseStateFrom String
filepath Journal
j = Journal
nulljournal{
      jparsedefaultyear :: Maybe Year
jparsedefaultyear      = Journal -> Maybe Year
jparsedefaultyear Journal
j
      ,jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity Journal
j
      ,jparseparentaccounts :: [Text]
jparseparentaccounts   = Journal -> [Text]
jparseparentaccounts Journal
j
      ,jparsealiases :: [AccountAlias]
jparsealiases          = Journal -> [AccountAlias]
jparsealiases Journal
j
      ,jcommodities :: Map Text Commodity
jcommodities           = Journal -> Map Text Commodity
jcommodities Journal
j
      -- ,jparsetransactioncount = jparsetransactioncount j
      ,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j
      ,jincludefilestack :: [String]
jincludefilestack      = String
filepath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Journal -> [String]
jincludefilestack Journal
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 :: IO a -> String -> TextParser m a
orRethrowIOError IO a
io String
msg = do
  Either String a
eResult <- IO (Either String a) -> ParsecT CustomErr Text m (Either String a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String a)
 -> ParsecT CustomErr Text m (Either String a))
-> IO (Either String a)
-> ParsecT CustomErr 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 (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 Either String a
eResult of
    Right a
res -> a -> TextParser m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
    Left String
errMsg -> String -> TextParser 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 :: JournalParser m ()
accountdirectivep = do
  Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset -- XXX figure out a more precise position later

  Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"account"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1

  -- the account name, possibly modified by preceding alias or apply account directives
  Text
acct <- StateT Journal (ParsecT CustomErr Text m) Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep

  -- maybe an account type code (ALERX) after two or more spaces
  -- XXX added in 1.11, deprecated in 1.13, remove in 1.14
  Maybe Char
mtypecode :: Maybe Char <- ParsecT CustomErr Text m (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe Char)
 -> StateT Journal (ParsecT CustomErr Text m) (Maybe Char))
-> ParsecT CustomErr Text m (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Char
 -> ParsecT CustomErr Text m (Maybe Char))
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char)
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ do
    ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 -- at least one more space in addition to the one consumed by modifiedaccountp
    [ParsecT CustomErr Text m Char] -> ParsecT CustomErr Text m Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT CustomErr Text m Char] -> ParsecT CustomErr Text m Char)
-> [ParsecT CustomErr Text m Char] -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT CustomErr Text m Char)
-> String -> [ParsecT CustomErr Text m Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char String
"ALERX"

  -- maybe a comment, on this and/or following lines
  (Text
cmt, [Tag]
tags) <- ParsecT CustomErr Text m (Text, [Tag])
-> StateT Journal (ParsecT CustomErr Text m) (Text, [Tag])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp

  -- maybe Ledger-style subdirectives (ignored)
  StateT Journal (ParsecT CustomErr Text m) String
-> JournalParser m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany StateT Journal (ParsecT CustomErr Text m) String
forall (m :: * -> *). JournalParser m String
indentedlinep

  -- an account type may have been set by account type code or a tag;
  -- the latter takes precedence
  let
    Maybe Text
mtypecode' :: Maybe Text = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Char -> Text
T.singleton (Char -> Text) -> Maybe Char -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
mtypecode)
      Text -> Maybe Text
forall a. a -> Maybe a
Just
      (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Tag] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
accountTypeTagName [Tag]
tags
    metype :: Maybe (Either String AccountType)
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
<$> Maybe Text
mtypecode'

  -- update the journal
  (Text, Text, [Tag]) -> JournalParser m ()
forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addAccountDeclaration (Text
acct, Text
cmt, [Tag]
tags)
  case Maybe (Either String AccountType)
metype of
    Maybe (Either String AccountType)
Nothing         -> () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Right AccountType
t)  -> Text -> AccountType -> JournalParser m ()
forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
t
    Just (Left String
err) -> CustomErr -> JournalParser m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m ())
-> CustomErr -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
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
_           -> 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
"Asset",Text
"Liability",Text
"Equity",Text
"Revenue",Text
"Expense",Text
"Cash"]

-- Add an account declaration to the journal, auto-numbering it.
addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()
addAccountDeclaration :: (Text, Text, [Tag]) -> JournalParser m ()
addAccountDeclaration (Text
a,Text
cmt,[Tag]
tags) =
  (Journal -> Journal) -> JournalParser 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 :: Text
adicomment          = Text
cmt
                             ,aditags :: [Tag]
aditags             = [Tag]
tags
                             ,adideclarationorder :: Int
adideclarationorder = [(Text, AccountDeclarationInfo)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, AccountDeclarationInfo)]
decls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                             })
             in
               Journal
j{jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredaccounts = (Text, AccountDeclarationInfo)
d(Text, AccountDeclarationInfo)
-> [(Text, AccountDeclarationInfo)]
-> [(Text, AccountDeclarationInfo)]
forall a. a -> [a] -> [a]
:[(Text, AccountDeclarationInfo)]
decls})

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

indentedlinep :: JournalParser m String
indentedlinep :: JournalParser m String
indentedlinep = ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT CustomErr Text m) ()
-> JournalParser m String -> JournalParser m String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String
rstrip (String -> String)
-> JournalParser m String -> JournalParser m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m String -> JournalParser m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr 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 :: JournalParser m ()
commoditydirectivep = JournalParser m ()
forall (m :: * -> *). JournalParser m ()
commoditydirectiveonelinep JournalParser m () -> JournalParser m () -> JournalParser m ()
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 :: JournalParser m ()
commoditydirectiveonelinep = do
  (Int
off, Amount{Text
acommodity :: Amount -> Text
acommodity :: Text
acommodity,AmountStyle
astyle :: Amount -> AmountStyle
astyle :: AmountStyle
astyle}) <- StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
-> StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
 -> StateT Journal (ParsecT CustomErr Text m) (Int, Amount))
-> StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
-> StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
    ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
    Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Amount
amount <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
    (Int, Amount)
-> StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Amount)
 -> StateT Journal (ParsecT CustomErr Text m) (Int, Amount))
-> (Int, Amount)
-> StateT Journal (ParsecT CustomErr Text m) (Int, Amount)
forall a b. (a -> b) -> a -> b
$ (Int
off, Amount
amount)
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Text
_ <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
followingcommentp
  let comm :: Commodity
comm = Commodity :: Text -> Maybe AmountStyle -> Commodity
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 AmountStyle -> Maybe Char
asdecimalpoint AmountStyle
astyle Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
forall a. Maybe a
Nothing
  then CustomErr -> JournalParser m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m ())
-> CustomErr -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
off String
pleaseincludedecimalpoint
  else (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jcommodities :: Map Text Commodity
jcommodities=Text -> Commodity -> Map Text Commodity -> Map Text Commodity
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
acommodity Commodity
comm (Map Text Commodity -> Map Text Commodity)
-> Map Text Commodity -> Map Text Commodity
forall a b. (a -> b) -> a -> b
$ Journal -> Map Text Commodity
jcommodities Journal
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 :: JournalParser m ()
commoditydirectivemultilinep = do
  Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Text
sym <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
commoditysymbolp
  Text
_ <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
followingcommentp
  Maybe AmountStyle
mformat <- [AmountStyle] -> Maybe AmountStyle
forall a. [a] -> Maybe a
lastMay ([AmountStyle] -> Maybe AmountStyle)
-> StateT Journal (ParsecT CustomErr Text m) [AmountStyle]
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) AmountStyle
-> StateT Journal (ParsecT CustomErr Text m) [AmountStyle]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT Journal (ParsecT CustomErr Text m) AmountStyle
-> StateT Journal (ParsecT CustomErr Text m) AmountStyle
forall b.
StateT Journal (ParsecT CustomErr Text m) b
-> StateT Journal (ParsecT CustomErr Text m) b
indented (StateT Journal (ParsecT CustomErr Text m) AmountStyle
 -> StateT Journal (ParsecT CustomErr Text m) AmountStyle)
-> StateT Journal (ParsecT CustomErr Text m) AmountStyle
-> StateT Journal (ParsecT CustomErr Text m) AmountStyle
forall a b. (a -> b) -> a -> b
$ Text -> StateT Journal (ParsecT CustomErr Text m) AmountStyle
forall (m :: * -> *). Text -> JournalParser m AmountStyle
formatdirectivep Text
sym)
  let comm :: Commodity
comm = Commodity :: Text -> Maybe AmountStyle -> Commodity
Commodity{csymbol :: Text
csymbol=Text
sym, cformat :: Maybe AmountStyle
cformat=Maybe AmountStyle
mformat}
  (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jcommodities :: Map Text Commodity
jcommodities=Text -> Commodity -> Map Text Commodity -> Map Text Commodity
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
sym Commodity
comm (Map Text Commodity -> Map Text Commodity)
-> Map Text Commodity -> Map Text Commodity
forall a b. (a -> b) -> a -> b
$ Journal -> Map Text Commodity
jcommodities Journal
j})
  where
    indented :: StateT Journal (ParsecT CustomErr Text m) b
-> StateT Journal (ParsecT CustomErr Text m) b
indented = (ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 JournalParser m ()
-> StateT Journal (ParsecT CustomErr Text m) b
-> StateT Journal (ParsecT CustomErr 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 :: Text -> JournalParser m AmountStyle
formatdirectivep Text
expectedsym = do
  Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"format"
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Amount{Text
acommodity :: Text
acommodity :: Amount -> Text
acommodity,AmountStyle
astyle :: AmountStyle
astyle :: Amount -> AmountStyle
astyle} <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  Text
_ <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
followingcommentp
  if Text
acommodityText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
expectedsym
    then
      if AmountStyle -> Maybe Char
asdecimalpoint AmountStyle
astyle Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
forall a. Maybe a
Nothing
      then CustomErr -> JournalParser m AmountStyle
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m AmountStyle)
-> CustomErr -> JournalParser m AmountStyle
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
off String
pleaseincludedecimalpoint
      else AmountStyle -> JournalParser m AmountStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (AmountStyle -> JournalParser m AmountStyle)
-> AmountStyle -> JournalParser m AmountStyle
forall a b. (a -> b) -> a -> b
$ String -> AmountStyle -> AmountStyle
forall a. Show a => String -> a -> a
dbg6 String
"style from format subdirective" AmountStyle
astyle
    else CustomErr -> JournalParser m AmountStyle
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m AmountStyle)
-> CustomErr -> JournalParser m AmountStyle
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
off (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$
         String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" Text
expectedsym Text
acommodity

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

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

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

applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep :: 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 CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Text
parent <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
accountnamep
  StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  Text -> JournalParser m ()
forall (m :: * -> *). Text -> JournalParser m ()
pushParentAccount Text
parent

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

endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep :: 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 :: JournalParser m ()
tagdirectivep = do
  Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag" StateT Journal (ParsecT CustomErr Text m) Text
-> String -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"tag directive"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  String
_ <- ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m String
 -> StateT Journal (ParsecT CustomErr Text m) String)
-> ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text m Char
forall (m :: * -> *). TextParser m Char
nonspace
  ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m String
forall (m :: * -> *). TextParser m String
restofline
  () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

endtagdirectivep :: JournalParser m ()
endtagdirectivep :: JournalParser m ()
endtagdirectivep = do
  (String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
keywordsp String
"end tag" JournalParser m () -> JournalParser m () -> JournalParser m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
keywordp String
"pop") JournalParser m () -> String -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end tag or pop directive"
  ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m String
forall (m :: * -> *). TextParser m String
restofline
  () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

payeedirectivep :: JournalParser m ()
payeedirectivep :: JournalParser m ()
payeedirectivep = do
  Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"payee" StateT Journal (ParsecT CustomErr Text m) Text
-> String -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"payee directive"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Text
payee <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp  -- all text until ; or \n
  (Text
comment, [Tag]
tags) <- ParsecT CustomErr Text m (Text, [Tag])
-> StateT Journal (ParsecT CustomErr Text m) (Text, [Tag])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
  (Text, Text, [Tag]) -> JournalParser m ()
forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addPayeeDeclaration (Text
payee, Text
comment, [Tag]
tags)
  () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep = do
  Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'Y' StateT Journal (ParsecT CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"default year"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Year -> JournalParser m ()
forall (m :: * -> *). Year -> JournalParser m ()
setYear (Year -> JournalParser m ())
-> StateT Journal (ParsecT CustomErr Text m) Year
-> JournalParser m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT CustomErr Text m Year
-> StateT Journal (ParsecT CustomErr Text m) Year
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Year
forall (m :: * -> *). TextParser m Year
yearp

defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep = do
  Token Text
-> StateT Journal (ParsecT CustomErr 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 CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"default commodity"
  ParsecT CustomErr Text m () -> JournalParser m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Amount{Text
acommodity :: Text
acommodity :: Amount -> Text
acommodity,AmountStyle
astyle :: AmountStyle
astyle :: Amount -> AmountStyle
astyle} <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m String
forall (m :: * -> *). TextParser m String
restofline
  if AmountStyle -> Maybe Char
asdecimalpoint AmountStyle
astyle Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
forall a. Maybe a
Nothing
  then CustomErr -> JournalParser m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m ())
-> CustomErr -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
off String
pleaseincludedecimalpoint
  else (Text, AmountStyle) -> JournalParser m ()
forall (m :: * -> *). (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle (Text
acommodity, AmountStyle
astyle)

marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep = do
  Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'P' StateT Journal (ParsecT CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"market price"
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Day
date <- StateT Journal (ParsecT CustomErr Text m) Day
-> StateT Journal (ParsecT CustomErr Text m) Day
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do {LocalTime Day
d TimeOfDay
_ <- JournalParser m LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep; Day -> StateT Journal (ParsecT CustomErr Text m) Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
d}) StateT Journal (ParsecT CustomErr Text m) Day
-> StateT Journal (ParsecT CustomErr Text m) Day
-> StateT Journal (ParsecT CustomErr Text m) Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Journal (ParsecT CustomErr Text m) Day
forall (m :: * -> *). JournalParser m Day
datep -- a time is ignored
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  Text
symbol <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
commoditysymbolp
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Amount
price <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  ParsecT CustomErr Text m String
-> StateT Journal (ParsecT CustomErr Text m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m String
forall (m :: * -> *). TextParser m String
restofline
  PriceDirective -> JournalParser m PriceDirective
forall (m :: * -> *) a. Monad m => a -> m a
return (PriceDirective -> JournalParser m PriceDirective)
-> PriceDirective -> JournalParser m PriceDirective
forall a b. (a -> b) -> a -> b
$ Day -> Text -> Amount -> PriceDirective
PriceDirective Day
date Text
symbol Amount
price

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

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

--- *** transactions

-- | Parse a transaction modifier (auto postings) rule.
transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp = do
  Token Text
-> StateT Journal (ParsecT CustomErr 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 CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"modifier transaction"
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Text
querytxt <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Text
 -> StateT Journal (ParsecT CustomErr Text m) Text)
-> ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp
  (Text
_comment, [Tag]
_tags) <- ParsecT CustomErr Text m (Text, [Tag])
-> StateT Journal (ParsecT CustomErr Text m) (Text, [Tag])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp   -- TODO apply these to modified txns ?
  [Posting]
postings <- Maybe Year -> JournalParser m [Posting]
forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp Maybe Year
forall a. Maybe a
Nothing
  TransactionModifier -> JournalParser m TransactionModifier
forall (m :: * -> *) a. Monad m => a -> m a
return (TransactionModifier -> JournalParser m TransactionModifier)
-> TransactionModifier -> JournalParser m TransactionModifier
forall a b. (a -> b) -> a -> b
$ Text -> [Posting] -> TransactionModifier
TransactionModifier Text
querytxt [Posting]
postings

-- | 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 :: JournalParser m PeriodicTransaction
periodictransactionp = do

  -- first line
  Token Text
-> StateT Journal (ParsecT CustomErr 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 CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"periodic transaction"
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m ()
 -> StateT Journal (ParsecT CustomErr Text m) ())
-> ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  -- a period expression
  Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset

  -- if there's a default year in effect, use Y/1/1 as base for partial/relative dates
  Day
today <- IO Day -> StateT Journal (ParsecT CustomErr Text m) Day
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
  Maybe Year
mdefaultyear <- JournalParser m (Maybe Year)
forall (m :: * -> *). JournalParser m (Maybe Year)
getYear
  let refdate :: Day
refdate = case Maybe Year
mdefaultyear of
                  Maybe Year
Nothing -> Day
today
                  Just Year
y  -> Year -> Int -> Int -> Day
fromGregorian Year
y Int
1 Int
1
  SourceExcerpt
periodExcerpt <- ParsecT CustomErr Text m SourceExcerpt
-> StateT Journal (ParsecT CustomErr Text m) SourceExcerpt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m SourceExcerpt
 -> StateT Journal (ParsecT CustomErr Text m) SourceExcerpt)
-> ParsecT CustomErr Text m SourceExcerpt
-> StateT Journal (ParsecT CustomErr Text m) SourceExcerpt
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m SourceExcerpt
forall (m :: * -> *) a.
MonadParsec CustomErr Text m =>
m a -> m SourceExcerpt
excerpt_ (ParsecT CustomErr Text m Text
 -> ParsecT CustomErr Text m SourceExcerpt)
-> ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m SourceExcerpt
forall a b. (a -> b) -> a -> b
$
                    (Char -> Bool) -> ParsecT CustomErr Text m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfyingp (\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
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
interval, DateSpan
span) <- ParsecT CustomErr Text m (Interval, DateSpan)
-> StateT Journal (ParsecT CustomErr Text m) (Interval, DateSpan)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Interval, DateSpan)
 -> StateT Journal (ParsecT CustomErr Text m) (Interval, DateSpan))
-> ParsecT CustomErr Text m (Interval, DateSpan)
-> StateT Journal (ParsecT CustomErr Text m) (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ SourceExcerpt
-> ParsecT CustomErr Text m (Interval, DateSpan)
-> ParsecT CustomErr Text m (Interval, DateSpan)
forall (m :: * -> *) a.
Monad m =>
SourceExcerpt
-> ParsecT CustomErr Text m a -> ParsecT CustomErr Text m a
reparseExcerpt SourceExcerpt
periodExcerpt (ParsecT CustomErr Text m (Interval, DateSpan)
 -> ParsecT CustomErr Text m (Interval, DateSpan))
-> ParsecT CustomErr Text m (Interval, DateSpan)
-> ParsecT CustomErr Text m (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ do
    (Interval, DateSpan)
pexp <- Day -> ParsecT CustomErr Text m (Interval, DateSpan)
forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
periodexprp Day
refdate
    ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ParsecT CustomErr Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ do
      Int
offset1 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT CustomErr Text m Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest
      Int
offset2 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> String -> CustomErr
parseErrorAtRegion Int
offset1 Int
offset2 (String -> CustomErr) -> String -> CustomErr
forall a b. (a -> b) -> a -> b
$
           String
"remainder of period expression cannot be parsed"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nperhaps you need to terminate the period expression with a double space?"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\na double space is required between period expression and description/comment"
    (Interval, DateSpan)
-> ParsecT CustomErr Text m (Interval, DateSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval, DateSpan)
pexp

  -- In periodic transactions, the period expression has an additional constraint:
  case Interval -> DateSpan -> Text -> Maybe String
checkPeriodicTransactionStartDate Interval
interval DateSpan
span Text
periodtxt of
    Just String
e -> CustomErr -> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> StateT Journal (ParsecT CustomErr Text m) ())
-> CustomErr -> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> CustomErr
parseErrorAt Int
off String
e
    Maybe String
Nothing -> () -> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  Status
status <- ParsecT CustomErr Text m Status
-> StateT Journal (ParsecT CustomErr Text m) Status
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Status
forall (m :: * -> *). TextParser m Status
statusp StateT Journal (ParsecT CustomErr Text m) Status
-> String -> StateT Journal (ParsecT CustomErr Text m) Status
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"cleared status"
  Text
code <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
codep StateT Journal (ParsecT CustomErr Text m) Text
-> String -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"transaction code"
  Text
description <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Text
 -> StateT Journal (ParsecT CustomErr Text m) Text)
-> ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp
  (Text
comment, [Tag]
tags) <- ParsecT CustomErr Text m (Text, [Tag])
-> StateT Journal (ParsecT CustomErr Text m) (Text, [Tag])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
  -- next lines; use same year determined above
  [Posting]
postings <- Maybe Year -> JournalParser m [Posting]
forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp (Year -> Maybe Year
forall a. a -> Maybe a
Just (Year -> Maybe Year) -> Year -> Maybe Year
forall a b. (a -> b) -> a -> b
$ (Year, Int, Int) -> Year
forall a b c. (a, b, c) -> a
first3 ((Year, Int, Int) -> Year) -> (Year, Int, Int) -> Year
forall a b. (a -> b) -> a -> b
$ Day -> (Year, Int, Int)
toGregorian Day
refdate)

  PeriodicTransaction -> JournalParser m PeriodicTransaction
forall (m :: * -> *) a. Monad m => a -> m a
return (PeriodicTransaction -> JournalParser m PeriodicTransaction)
-> PeriodicTransaction -> JournalParser m PeriodicTransaction
forall a b. (a -> b) -> a -> b
$ PeriodicTransaction
nullperiodictransaction{
     ptperiodexpr :: Text
ptperiodexpr=Text
periodtxt
    ,ptinterval :: Interval
ptinterval=Interval
interval
    ,ptspan :: DateSpan
ptspan=DateSpan
span
    ,ptstatus :: Status
ptstatus=Status
status
    ,ptcode :: Text
ptcode=Text
code
    ,ptdescription :: Text
ptdescription=Text
description
    ,ptcomment :: Text
ptcomment=Text
comment
    ,pttags :: [Tag]
pttags=[Tag]
tags
    ,ptpostings :: [Posting]
ptpostings=[Posting]
postings
    }

-- | Parse a (possibly unbalanced) transaction.
transactionp :: JournalParser m Transaction
transactionp :: JournalParser m Transaction
transactionp = do
  -- dbgparse 0 "transactionp"
  SourcePos
startpos <- StateT Journal (ParsecT CustomErr Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Day
date <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep JournalParser m Day -> String -> JournalParser m Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"transaction"
  Maybe Day
edate <- JournalParser m Day
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Day)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Day -> JournalParser m Day
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Day -> JournalParser m Day)
-> ParsecT CustomErr Text m Day -> JournalParser m Day
forall a b. (a -> b) -> a -> b
$ Day -> ParsecT CustomErr Text m Day
forall (m :: * -> *). Day -> TextParser m Day
secondarydatep Day
date) StateT Journal (ParsecT CustomErr Text m) (Maybe Day)
-> String -> StateT Journal (ParsecT CustomErr Text m) (Maybe Day)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"secondary date"
  StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT CustomErr Text m Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) StateT Journal (ParsecT CustomErr Text m) Char
-> String -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"whitespace or newline"
  Status
status <- ParsecT CustomErr Text m Status
-> StateT Journal (ParsecT CustomErr Text m) Status
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Status
forall (m :: * -> *). TextParser m Status
statusp StateT Journal (ParsecT CustomErr Text m) Status
-> String -> StateT Journal (ParsecT CustomErr Text m) Status
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"cleared status"
  Text
code <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
codep StateT Journal (ParsecT CustomErr Text m) Text
-> String -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"transaction code"
  Text
description <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Text
 -> StateT Journal (ParsecT CustomErr Text m) Text)
-> ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp
  (Text
comment, [Tag]
tags) <- ParsecT CustomErr Text m (Text, [Tag])
-> StateT Journal (ParsecT CustomErr Text m) (Text, [Tag])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
  let year :: Year
year = (Year, Int, Int) -> Year
forall a b c. (a, b, c) -> a
first3 ((Year, Int, Int) -> Year) -> (Year, Int, Int) -> Year
forall a b. (a -> b) -> a -> b
$ Day -> (Year, Int, Int)
toGregorian Day
date
  [Posting]
postings <- Maybe Year -> JournalParser m [Posting]
forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp (Year -> Maybe Year
forall a. a -> Maybe a
Just Year
year)
  SourcePos
endpos <- StateT Journal (ParsecT CustomErr Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  let sourcepos :: GenericSourcePos
sourcepos = SourcePos -> SourcePos -> GenericSourcePos
journalSourcePos SourcePos
startpos SourcePos
endpos
  Transaction -> JournalParser m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return (Transaction -> JournalParser m Transaction)
-> Transaction -> JournalParser m Transaction
forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Year
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction Year
0 Text
"" GenericSourcePos
sourcepos Day
date Maybe Day
edate Status
status Text
code Text
description Text
comment [Tag]
tags [Posting]
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 :: Maybe Year -> JournalParser m [Posting]
postingsp Maybe Year
mTransactionYear = StateT Journal (ParsecT CustomErr Text m) Posting
-> JournalParser m [Posting]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Maybe Year -> StateT Journal (ParsecT CustomErr Text m) Posting
forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp Maybe Year
mTransactionYear) JournalParser m [Posting] -> String -> JournalParser 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 :: Maybe Year -> JournalParser m Posting
postingp Maybe Year
mTransactionYear = do
  -- lift $ dbgparse 0 "postingp"
  (Status
status, Text
account) <- StateT Journal (ParsecT CustomErr Text m) (Status, Text)
-> StateT Journal (ParsecT CustomErr Text m) (Status, Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text m) (Status, Text)
 -> StateT Journal (ParsecT CustomErr Text m) (Status, Text))
-> StateT Journal (ParsecT CustomErr Text m) (Status, Text)
-> StateT Journal (ParsecT CustomErr Text m) (Status, Text)
forall a b. (a -> b) -> a -> b
$ do
    ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
    Status
status <- ParsecT CustomErr Text m Status
-> StateT Journal (ParsecT CustomErr Text m) Status
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Status
forall (m :: * -> *). TextParser m Status
statusp
    ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
    Text
account <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
    (Status, Text)
-> StateT Journal (ParsecT CustomErr Text m) (Status, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
status, Text
account)
  let (PostingType
ptype, Text
account') = (Text -> PostingType
accountNamePostingType Text
account, Text -> Text
textUnbracket Text
account)
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  MixedAmount
amount <- MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option MixedAmount
missingmixedamt (StateT Journal (ParsecT CustomErr Text m) MixedAmount
 -> StateT Journal (ParsecT CustomErr Text m) MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall a b. (a -> b) -> a -> b
$ [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]) (Amount -> MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *). JournalParser m Amount
amountp
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  Maybe BalanceAssertion
massertion <- StateT Journal (ParsecT CustomErr Text m) BalanceAssertion
-> StateT
     Journal (ParsecT CustomErr Text m) (Maybe BalanceAssertion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT Journal (ParsecT CustomErr Text m) BalanceAssertion
forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
  (Text
comment,[Tag]
tags,Maybe Day
mdate,Maybe Day
mdate2) <- ParsecT CustomErr Text m (Text, [Tag], Maybe Day, Maybe Day)
-> StateT
     Journal
     (ParsecT CustomErr Text m)
     (Text, [Tag], Maybe Day, Maybe Day)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Text, [Tag], Maybe Day, Maybe Day)
 -> StateT
      Journal
      (ParsecT CustomErr Text m)
      (Text, [Tag], Maybe Day, Maybe Day))
-> ParsecT CustomErr Text m (Text, [Tag], Maybe Day, Maybe Day)
-> StateT
     Journal
     (ParsecT CustomErr Text m)
     (Text, [Tag], Maybe Day, Maybe Day)
forall a b. (a -> b) -> a -> b
$ Maybe Year
-> ParsecT CustomErr Text m (Text, [Tag], Maybe Day, Maybe Day)
forall (m :: * -> *).
Maybe Year -> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
postingcommentp Maybe Year
mTransactionYear
  Posting -> JournalParser m Posting
forall (m :: * -> *) a. Monad m => a -> m a
return Posting
posting
   { pdate :: Maybe Day
pdate=Maybe Day
mdate
   , pdate2 :: Maybe Day
pdate2=Maybe Day
mdate2
   , pstatus :: Status
pstatus=Status
status
   , paccount :: Text
paccount=Text
account'
   , pamount :: MixedAmount
pamount=MixedAmount
amount
   , pcomment :: Text
pcomment=Text
comment
   , ptype :: PostingType
ptype=PostingType
ptype
   , ptags :: [Tag]
ptags=[Tag]
tags
   , pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
massertion
   }

--- ** tests

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

   let p :: JournalParser IO Text
p = ParsecT CustomErr Text IO Text -> JournalParser IO Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text IO Text
forall (m :: * -> *). TextParser m Text
accountnamep :: JournalParser IO AccountName in
   String -> [TestTree] -> TestTree
tests String
"accountnamep" [
     String -> Assertion -> TestTree
test String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ JournalParser IO Text -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse JournalParser IO Text
p Text
"a:b:c"
    -- ,test "empty inner component" $ assertParseError p "a::c" ""  -- TODO
    -- ,test "empty leading component" $ assertParseError p ":b:c" "x"
    -- ,test "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
tests String
"datep" [
     String -> Assertion -> TestTree
test String
"YYYY/MM/DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day
-> Text -> Day -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018/01/01" (Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
1 Int
1)
    ,String -> Assertion -> TestTree
test String
"YYYY-MM-DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018-01-01"
    ,String -> Assertion -> TestTree
test String
"YYYY.MM.DD" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018.01.01"
    ,String -> Assertion -> TestTree
test String
"yearless date with no default year" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day
-> String -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> String -> String -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep String
"1/1" String
"current year is unknown"
    ,String -> Assertion -> TestTree
test 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"
      Either (ParseErrorBundle Text CustomErr) Day
ep <- Journal
-> StateT Journal (ParsecT CustomErr Text IO) Day
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) Day)
forall (m :: * -> *) st a.
Monad m =>
st
-> StateT st (ParsecT CustomErr Text m) a
-> Text
-> m (Either (ParseErrorBundle Text CustomErr) a)
parseWithState Journal
nulljournal{jparsedefaultyear :: Maybe Year
jparsedefaultyear=Year -> Maybe Year
forall a. a -> Maybe a
Just Year
2018} StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
s
      (ParseErrorBundle Text CustomErr -> Assertion)
-> (Day -> Assertion)
-> Either (ParseErrorBundle Text CustomErr) Day
-> Assertion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"parse error at "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty) (Assertion -> Day -> Assertion
forall a b. a -> b -> a
const (Assertion -> Day -> Assertion) -> Assertion -> Day -> Assertion
forall a b. (a -> b) -> a -> b
$ () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Either (ParseErrorBundle Text CustomErr) Day
ep
    ,String -> Assertion -> TestTree
test String
"no leading zero" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep Text
"2018/1/1"
    ]
  ,String -> Assertion -> TestTree
test String
"datetimep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     let
       good :: Text -> Assertion
good = StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep
       bad :: String -> Assertion
bad  = (\String
t -> StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> String -> String -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> String -> String -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep String
t String
"")
     Text -> Assertion
good Text
"2011/1/1 00:00"
     Text -> Assertion
good Text
"2011/1/1 23:59:59"
     String -> Assertion
bad String
"2011/1/1"
     String -> Assertion
bad String
"2011/1/1 24:00:00"
     String -> Assertion
bad String
"2011/1/1 00:60:00"
     String -> Assertion
bad String
"2011/1/1 00:00:60"
     String -> Assertion
bad String
"2011/1/1 3:5:7"
     -- timezone is parsed but ignored
     let t :: LocalTime
t = Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
1 Int
1) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0)
     StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> Text -> LocalTime -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00-0800" LocalTime
t
     StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> Text -> LocalTime -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00+1234" LocalTime
t

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

    String -> Assertion -> TestTree
test String
"more period text in comment after one space" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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 :: Text
ptperiodexpr  = Text
"monthly from 2018/6"
        ,ptinterval :: Interval
ptinterval    = Int -> Interval
Months Int
1
        ,ptspan :: DateSpan
ptspan        = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
6 Int
1) Maybe Day
forall a. Maybe a
Nothing
        ,ptdescription :: Text
ptdescription = Text
""
        ,ptcomment :: Text
ptcomment     = Text
"In 2019 we will change this\n"
        }

    ,String -> Assertion -> TestTree
test String
"more period text in description after two spaces" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) PeriodicTransaction
-> Text -> PeriodicTransaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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 :: Text
ptperiodexpr  = Text
"monthly from 2018/6"
        ,ptinterval :: Interval
ptinterval    = Int -> Interval
Months Int
1
        ,ptspan :: DateSpan
ptspan        = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
6 Int
1) Maybe Day
forall a. Maybe a
Nothing
        ,ptdescription :: Text
ptdescription = Text
"In 2019 we will change this"
        ,ptcomment :: Text
ptcomment     = Text
""
        }

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

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

    ,String -> Assertion -> TestTree
test String
"Just date, no description + empty transaction comment" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) PeriodicTransaction
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr 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
tests String
"postingp" [
     String -> Assertion -> TestTree
test String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Posting
-> Text -> Posting -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq (Maybe Year -> StateT Journal (ParsecT CustomErr Text IO) Posting
forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp Maybe Year
forall a. Maybe a
Nothing)
      Text
"  expenses:food:dining  $10.00   ; a: a a \n   ; b: b b \n"
      Posting
posting{
        paccount :: Text
paccount=Text
"expenses:food:dining",
        pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
usd DecimalRaw Year
10],
        pcomment :: Text
pcomment=Text
"a: a a\nb: b b\n",
        ptags :: [Tag]
ptags=[(Text
"a",Text
"a a"), (Text
"b",Text
"b b")]
        }

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

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

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

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

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

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

    String -> Assertion -> TestTree
test String
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) TransactionModifier
-> Text -> TransactionModifier -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) TransactionModifier
forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp
      Text
"= (some value expr)\n some:postings  1.\n"
      TransactionModifier
nulltransactionmodifier {
        tmquerytxt :: Text
tmquerytxt = Text
"(some value expr)"
       ,tmpostingrules :: [Posting]
tmpostingrules = [Posting
nullposting{paccount :: Text
paccount=Text
"some:postings", pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed[DecimalRaw Year -> Amount
num DecimalRaw Year
1]}]
      }
    ]

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

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

    ,String -> Assertion -> TestTree
test String
"more complex" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Transaction
-> Text -> Transaction -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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 :: GenericSourcePos
tsourcepos=String -> (Int, Int) -> GenericSourcePos
JournalSourcePos String
"" (Int
1,Int
7),  -- XXX why 7 here ?
        tprecedingcomment :: Text
tprecedingcomment=Text
"",
        tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
5 Int
14,
        tdate2 :: Maybe Day
tdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
5 Int
15,
        tstatus :: Status
tstatus=Status
Unmarked,
        tcode :: Text
tcode=Text
"code",
        tdescription :: Text
tdescription=Text
"desc",
        tcomment :: Text
tcomment=Text
"tcomment1\ntcomment2\nttag1: val1\n",
        ttags :: [Tag]
ttags=[(Text
"ttag1",Text
"val1")],
        tpostings :: [Posting]
tpostings=[
          Posting
nullposting{
            pdate :: Maybe Day
pdate=Maybe Day
forall a. Maybe a
Nothing,
            pstatus :: Status
pstatus=Status
Cleared,
            paccount :: Text
paccount=Text
"a",
            pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
usd DecimalRaw Year
1],
            pcomment :: Text
pcomment=Text
"pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
            ptype :: PostingType
ptype=PostingType
RegularPosting,
            ptags :: [Tag]
ptags=[(Text
"ptag1",Text
"val1"),(Text
"ptag2",Text
"val2")],
            ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing
            }
          ]
      }

    ,String -> Assertion -> TestTree
test 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 (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either (ParseErrorBundle Text CustomErr) Transaction)
 -> Bool)
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text
 -> Either
      Any (Either (ParseErrorBundle Text CustomErr) Transaction))
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) 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
test 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 CustomErr Text IO) Transaction
-> Text -> (Transaction -> Text) -> Text -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT Journal (ParsecT CustomErr 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
test 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 (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either (ParseErrorBundle Text CustomErr) Transaction)
 -> Bool)
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text
 -> Either
      Any (Either (ParseErrorBundle Text CustomErr) Transaction))
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) 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
test 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 (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. Either a b -> Bool
isRight (Either Any (Either (ParseErrorBundle Text CustomErr) Transaction)
 -> Bool)
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
-> Bool
forall a b. (a -> b) -> a -> b
$ JournalParser (Either Any) Transaction
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) Transaction)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
rjp JournalParser (Either Any) Transaction
forall (m :: * -> *). JournalParser m Transaction
transactionp (Text
 -> Either
      Any (Either (ParseErrorBundle Text CustomErr) Transaction))
-> Text
-> Either
     Any (Either (ParseErrorBundle Text CustomErr) 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
test String
"comments everywhere, two postings parsed" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      StateT Journal (ParsecT CustomErr Text IO) Transaction
-> Text -> (Transaction -> Int) -> Int -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT Journal (ParsecT CustomErr 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 (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
tests String
"directivep" [
    String -> Assertion -> TestTree
test String
"supports !" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> Assertion
assertParseE StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!account a\n"
        StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> Assertion
assertParseE StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!D 1.0\n"
     ]

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

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

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

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

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

  ,String -> [TestTree] -> TestTree
tests String
"includedirectivep" [
      String -> Assertion -> TestTree
test String
"include" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> String -> Assertion
forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> String -> Assertion
assertParseErrorE StateT
  Journal (ParsecT CustomErr 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
test String
"glob" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
  Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> String -> Assertion
forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> String -> Assertion
assertParseErrorE StateT
  Journal (ParsecT CustomErr 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
test String
"marketpricedirectivep" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) PriceDirective
-> Text -> PriceDirective -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) PriceDirective
forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep
    Text
"P 2017/01/30 BTC $922.83\n"
    PriceDirective :: Day -> Text -> Amount -> PriceDirective
PriceDirective{
      pddate :: Day
pddate      = Year -> Int -> Int -> Day
fromGregorian Year
2017 Int
1 Int
30,
      pdcommodity :: Text
pdcommodity = Text
"BTC",
      pdamount :: Amount
pdamount    = DecimalRaw Year -> Amount
usd DecimalRaw Year
922.83
      }

  ,String -> [TestTree] -> TestTree
tests String
"payeedirectivep" [
       String -> Assertion -> TestTree
test String
"simple"             (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) () -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo\n"
       ,String -> Assertion -> TestTree
test String
"with-comment"       (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) () -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo ; comment\n"
       ]

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

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

  ,String -> [TestTree] -> TestTree
tests String
"journalp" [
    String -> Assertion -> TestTree
test 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 CustomErr 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
test String
"parseAndFinaliseJournal" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Either String Journal
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 Journal
j = Either String Journal
ej
      String -> [String] -> [String] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"" [String
""] ([String] -> Assertion) -> [String] -> Assertion
forall a b. (a -> b) -> a -> b
$ Journal -> [String]
journalFilePaths Journal
j

  ]