{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings, PackageImports #-}
module Hledger.Read.JournalReader (
reader,
genericSourcePos,
parseAndFinaliseJournal,
runJournalParser,
rjp,
getParentAccount,
journalp,
directivep,
defaultyeardirectivep,
marketpricedirectivep,
datetimep,
datep,
modifiedaccountnamep,
postingp,
statusp,
emptyorcommentlinep,
followingcommentp,
accountaliasp
,tests_JournalReader
)
where
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 qualified Data.Map.Strict as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import Data.String
import Data.List
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.Read.TimeclockReader (timeclockfilep)
import Hledger.Read.TimedotReader (timedotfilep)
import Hledger.Utils
reader :: Reader
reader :: Reader
reader = Reader :: StorageFormat
-> [StorageFormat]
-> (InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal)
-> Bool
-> Reader
Reader
{rFormat :: StorageFormat
rFormat = "journal"
,rExtensions :: [StorageFormat]
rExtensions = ["journal", "j", "hledger", "ledger"]
,rParser :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
rParser = InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse
,rExperimental :: Bool
rExperimental = Bool
False
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse iopts :: InputOpts
iopts = ErroringJournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
journalp' InputOpts
iopts
where
journalp' :: ErroringJournalParser IO Journal
journalp' = do
(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
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts = (StorageFormat -> AccountAlias)
-> [StorageFormat] -> [AccountAlias]
forall a b. (a -> b) -> [a] -> [b]
map (\a :: StorageFormat
a -> Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias
forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse (Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias)
-> Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr Text AccountAlias
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) AccountAlias
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser Parsec CustomErr Text AccountAlias
forall (m :: * -> *). TextParser m AccountAlias
accountaliasp ("--alias "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++StorageFormat -> StorageFormat
quoteIfNeeded StorageFormat
a) (Text -> Either (ParseErrorBundle Text CustomErr) AccountAlias)
-> Text -> Either (ParseErrorBundle Text CustomErr) AccountAlias
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Text
T.pack StorageFormat
a)
([StorageFormat] -> [AccountAlias])
-> (InputOpts -> [StorageFormat]) -> InputOpts -> [AccountAlias]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> [StorageFormat]
aliases_
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
addJournalItemP :: MonadIO m => ErroringJournalParser m ()
addJournalItemP :: ErroringJournalParser m ()
addJournalItemP =
[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 ()
-> StorageFormat -> ErroringJournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "transaction or directive"
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 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 ()
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 ()
-> StorageFormat -> ErroringJournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "directive"
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 "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) Char
-> ParsecT CustomErr Text (ExceptT FinalParseError m) ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text (ExceptT FinalParseError m) Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
StorageFormat
filename <- Text -> StorageFormat
T.unpack (Text -> StorageFormat)
-> StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) Text
-> StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageFormat
-> (Token Text -> Bool)
-> StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
(Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')
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 e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
[StorageFormat]
filepaths <- Int
-> SourcePos
-> StorageFormat
-> JournalParser (ExceptT FinalParseError m) [StorageFormat]
forall (m :: * -> *).
MonadIO m =>
Int
-> SourcePos -> StorageFormat -> JournalParser m [StorageFormat]
getFilePaths Int
parentoff SourcePos
parentpos StorageFormat
filename
[StorageFormat]
-> (StorageFormat -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StorageFormat]
filepaths ((StorageFormat -> ErroringJournalParser m ())
-> ErroringJournalParser m ())
-> (StorageFormat -> ErroringJournalParser m ())
-> ErroringJournalParser m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> StorageFormat -> ErroringJournalParser m ()
forall (m :: * -> *).
MonadIO m =>
SourcePos -> StorageFormat -> 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 -> StorageFormat -> JournalParser m [StorageFormat]
getFilePaths parseroff :: Int
parseroff parserpos :: SourcePos
parserpos filename :: StorageFormat
filename = do
let curdir :: StorageFormat
curdir = StorageFormat -> StorageFormat
takeDirectory (SourcePos -> StorageFormat
sourceName SourcePos
parserpos)
StorageFormat
filename' <- ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat)
-> ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat -> IO StorageFormat
expandHomePath StorageFormat
filename
IO StorageFormat
-> StorageFormat -> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a.
MonadIO m =>
IO a -> StorageFormat -> TextParser m a
`orRethrowIOError` (SourcePos -> StorageFormat
forall a. Show a => a -> StorageFormat
show SourcePos
parserpos StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ " locating " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
filename)
Pattern
fileglob <- case CompOptions -> StorageFormat -> Either StorageFormat Pattern
tryCompileWith CompOptions
compDefault{errorRecovery :: Bool
errorRecovery=Bool
False} StorageFormat
filename' of
Right x :: Pattern
x -> Pattern -> StateT Journal (ParsecT CustomErr Text m) Pattern
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
x
Left e :: StorageFormat
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 -> StorageFormat -> CustomErr
parseErrorAt Int
parseroff (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$ "Invalid glob pattern: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
e
[StorageFormat]
filepaths <- IO [StorageFormat] -> JournalParser m [StorageFormat]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StorageFormat] -> JournalParser m [StorageFormat])
-> IO [StorageFormat] -> JournalParser m [StorageFormat]
forall a b. (a -> b) -> a -> b
$ [StorageFormat] -> [StorageFormat]
forall a. Ord a => [a] -> [a]
sort ([StorageFormat] -> [StorageFormat])
-> IO [StorageFormat] -> IO [StorageFormat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StorageFormat -> IO [StorageFormat]
globDir1 Pattern
fileglob StorageFormat
curdir
if (Bool -> Bool
not (Bool -> Bool)
-> ([StorageFormat] -> Bool) -> [StorageFormat] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StorageFormat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [StorageFormat]
filepaths
then [StorageFormat] -> JournalParser m [StorageFormat]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [StorageFormat]
filepaths
else CustomErr -> JournalParser m [StorageFormat]
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> JournalParser m [StorageFormat])
-> CustomErr -> JournalParser m [StorageFormat]
forall a b. (a -> b) -> a -> b
$ Int -> StorageFormat -> CustomErr
parseErrorAt Int
parseroff (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"No existing files match pattern: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
filename
parseChild :: MonadIO m => SourcePos -> FilePath -> ErroringJournalParser m ()
parseChild :: SourcePos -> StorageFormat -> ErroringJournalParser m ()
parseChild parentpos :: SourcePos
parentpos filepath :: StorageFormat
filepath = do
Journal
parentj <- StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
forall s (m :: * -> *). MonadState s m => m s
get
let parentfilestack :: [StorageFormat]
parentfilestack = Journal -> [StorageFormat]
jincludefilestack Journal
parentj
Bool -> ErroringJournalParser m () -> ErroringJournalParser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StorageFormat
filepath StorageFormat -> [StorageFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [StorageFormat]
parentfilestack) (ErroringJournalParser m () -> ErroringJournalParser m ())
-> ErroringJournalParser m () -> ErroringJournalParser m ()
forall a b. (a -> b) -> a -> b
$
StorageFormat -> ErroringJournalParser m ()
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail ("Cyclic include: " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
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
$ StorageFormat -> IO Text
readFilePortably StorageFormat
filepath
IO Text
-> StorageFormat
-> ParsecT CustomErr Text (ExceptT FinalParseError m) Text
forall (m :: * -> *) a.
MonadIO m =>
IO a -> StorageFormat -> TextParser m a
`orRethrowIOError` (SourcePos -> StorageFormat
forall a. Show a => a -> StorageFormat
show SourcePos
parentpos StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ " reading " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++ StorageFormat
filepath)
let initChildj :: Journal
initChildj = StorageFormat -> Journal -> Journal
newJournalWithParseStateFrom StorageFormat
filepath Journal
parentj
let parser :: StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
parser = [StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal]
-> StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
forall s (m :: * -> *) a.
[StateT s (ParsecT CustomErr Text m) a]
-> StateT s (ParsecT CustomErr Text m) a
choiceInState
[ StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp
, StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep
, StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
forall (m :: * -> *). JournalParser m Journal
timedotfilep
]
Journal
updatedChildj <- (StorageFormat, Text) -> Journal -> Journal
journalAddFile (StorageFormat
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
-> StorageFormat
-> 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
-> StorageFormat
-> Text
-> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
parseIncludeFile StateT
Journal
(ParsecT CustomErr Text (ExceptT FinalParseError m))
Journal
parser Journal
initChildj StorageFormat
filepath Text
childInput
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 :: StorageFormat -> Journal -> Journal
newJournalWithParseStateFrom filepath :: StorageFormat
filepath j :: Journal
j = Journal
forall a. Monoid a => a
mempty{
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
,jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j
,jincludefilestack :: [StorageFormat]
jincludefilestack = StorageFormat
filepath StorageFormat -> [StorageFormat] -> [StorageFormat]
forall a. a -> [a] -> [a]
: Journal -> [StorageFormat]
jincludefilestack Journal
j
}
orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
orRethrowIOError :: IO a -> StorageFormat -> TextParser m a
orRethrowIOError io :: IO a
io msg :: StorageFormat
msg = do
Either StorageFormat a
eResult <- IO (Either StorageFormat a)
-> ParsecT CustomErr Text m (Either StorageFormat a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either StorageFormat a)
-> ParsecT CustomErr Text m (Either StorageFormat a))
-> IO (Either StorageFormat a)
-> ParsecT CustomErr Text m (Either StorageFormat a)
forall a b. (a -> b) -> a -> b
$ (a -> Either StorageFormat a
forall a b. b -> Either a b
Right (a -> Either StorageFormat a)
-> IO a -> IO (Either StorageFormat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
io) IO (Either StorageFormat a)
-> (IOException -> IO (Either StorageFormat a))
-> IO (Either StorageFormat a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` \(IOException
e::C.IOException) -> Either StorageFormat a -> IO (Either StorageFormat a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StorageFormat a -> IO (Either StorageFormat a))
-> Either StorageFormat a -> IO (Either StorageFormat a)
forall a b. (a -> b) -> a -> b
$ StorageFormat -> Either StorageFormat a
forall a b. a -> Either a b
Left (StorageFormat -> Either StorageFormat a)
-> StorageFormat -> Either StorageFormat a
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat -> StorageFormat -> StorageFormat
forall r. PrintfType r => StorageFormat -> r
printf "%s:\n%s" StorageFormat
msg (IOException -> StorageFormat
forall a. Show a => a -> StorageFormat
show IOException
e)
case Either StorageFormat a
eResult of
Right res :: a
res -> a -> TextParser m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
Left errMsg :: StorageFormat
errMsg -> StorageFormat -> TextParser m a
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail StorageFormat
errMsg
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
Tokens Text
-> StateT Journal (ParsecT CustomErr Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Text
acct <- StateT Journal (ParsecT CustomErr Text m) Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
[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)
-> StorageFormat -> [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 "ALERX"
(cmt :: Text
cmt, tags :: [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
StateT Journal (ParsecT CustomErr Text m) StorageFormat
-> JournalParser m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *). JournalParser m StorageFormat
indentedlinep
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 StorageFormat AccountType)
metype = Text -> Either StorageFormat AccountType
parseAccountTypeCode (Text -> Either StorageFormat AccountType)
-> Maybe Text -> Maybe (Either StorageFormat AccountType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mtypecode'
(Text, Text, [Tag]) -> JournalParser m ()
forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addAccountDeclaration (Text
acct, Text
cmt, [Tag]
tags)
case Maybe (Either StorageFormat AccountType)
metype of
Nothing -> () -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Right t :: AccountType
t) -> Text -> AccountType -> JournalParser m ()
forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
t
Just (Left err :: StorageFormat
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 -> StorageFormat -> CustomErr
parseErrorAt Int
off StorageFormat
err
accountTypeTagName :: Text
accountTypeTagName = "type"
parseAccountTypeCode :: Text -> Either String AccountType
parseAccountTypeCode :: Text -> Either StorageFormat AccountType
parseAccountTypeCode s :: Text
s =
case Text -> Text
T.toLower Text
s of
"asset" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Asset
"a" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Asset
"liability" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Liability
"l" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Liability
"equity" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Equity
"e" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Equity
"revenue" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Revenue
"r" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Revenue
"expense" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Expense
"x" -> AccountType -> Either StorageFormat AccountType
forall a b. b -> Either a b
Right AccountType
Expense
_ -> StorageFormat -> Either StorageFormat AccountType
forall a b. a -> Either a b
Left StorageFormat
err
where
err :: StorageFormat
err = "invalid account type code "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++Text -> StorageFormat
T.unpack Text
sStorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++", should be one of " StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++
(StorageFormat -> [StorageFormat] -> StorageFormat
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([StorageFormat] -> StorageFormat)
-> [StorageFormat] -> StorageFormat
forall a b. (a -> b) -> a -> b
$ ["A","L","E","R","X","ASSET","LIABILITY","EQUITY","REVENUE","EXPENSE"])
addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()
addAccountDeclaration :: (Text, Text, [Tag]) -> JournalParser m ()
addAccountDeclaration (a :: Text
a,cmt :: Text
cmt,tags :: [Tag]
tags) =
(Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: 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
+ 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})
indentedlinep :: JournalParser m String
indentedlinep :: JournalParser m StorageFormat
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome 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) ()
-> JournalParser m StorageFormat -> JournalParser m StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (StorageFormat -> StorageFormat
rstrip (StorageFormat -> StorageFormat)
-> JournalParser m StorageFormat -> JournalParser m StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m StorageFormat
-> JournalParser m StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline)
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
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep = do
(off :: 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 "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
$ StorageFormat -> AmountStyle -> AmountStyle
forall a. Show a => StorageFormat -> a -> a
dbg2 "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 -> StorageFormat -> CustomErr
parseErrorAt Int
off StorageFormat
pleaseincludedecimalpoint
else (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: 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 :: StorageFormat
pleaseincludedecimalpoint = "to avoid ambiguity, please include a decimal separator in commodity directives"
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 "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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' (\j :: 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline) 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
>>)
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep :: Text -> JournalParser m AmountStyle
formatdirectivep expectedsym :: 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 "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 -> StorageFormat -> CustomErr
parseErrorAt Int
off StorageFormat
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
$ StorageFormat -> AmountStyle -> AmountStyle
forall a. Show a => StorageFormat -> a -> a
dbg2 "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 -> StorageFormat -> CustomErr
parseErrorAt Int
off (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
StorageFormat -> Text -> Text -> StorageFormat
forall r. PrintfType r => StorageFormat -> r
printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" Text
expectedsym Text
acommodity
keywordp :: String -> JournalParser m ()
keywordp :: StorageFormat -> 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 ())
-> (StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) Text)
-> StorageFormat
-> 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)
-> (StorageFormat -> Text)
-> StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Text
forall a. IsString a => StorageFormat -> 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
keywordsp :: String -> JournalParser m ()
keywordsp :: StorageFormat -> 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 ())
-> (StorageFormat -> JournalParser m ())
-> StorageFormat
-> 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 ())
-> (StorageFormat -> [JournalParser m ()])
-> StorageFormat
-> 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 ()])
-> (StorageFormat -> [JournalParser m ()])
-> StorageFormat
-> [JournalParser m ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorageFormat -> JournalParser m ())
-> [StorageFormat] -> [JournalParser m ()]
forall a b. (a -> b) -> [a] -> [b]
map StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordp ([StorageFormat] -> [JournalParser m ()])
-> (StorageFormat -> [StorageFormat])
-> StorageFormat
-> [JournalParser m ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> [StorageFormat]
words
applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep = do
StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordsp "apply account" JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordsp "end apply account" JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
accountaliasp :: TextParser m AccountAlias
accountaliasp :: TextParser m AccountAlias
accountaliasp = TextParser m AccountAlias
forall (m :: * -> *). TextParser m AccountAlias
regexaliasp TextParser m AccountAlias
-> TextParser m AccountAlias -> TextParser m AccountAlias
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser m AccountAlias
forall (m :: * -> *). TextParser m AccountAlias
basicaliasp
basicaliasp :: TextParser m AccountAlias
basicaliasp :: TextParser m AccountAlias
basicaliasp = do
StorageFormat
old <- StorageFormat -> StorageFormat
rstrip (StorageFormat -> StorageFormat)
-> ParsecT CustomErr Text m StorageFormat
-> ParsecT CustomErr Text m StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat)
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT CustomErr Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ("=" :: [Char]))
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'='
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
StorageFormat
new <- StorageFormat -> StorageFormat
rstrip (StorageFormat -> StorageFormat)
-> ParsecT CustomErr Text m StorageFormat
-> ParsecT CustomErr Text m StorageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
AccountAlias -> TextParser m AccountAlias
forall (m :: * -> *) a. Monad m => a -> m a
return (AccountAlias -> TextParser m AccountAlias)
-> AccountAlias -> TextParser m AccountAlias
forall a b. (a -> b) -> a -> b
$ Text -> Text -> AccountAlias
BasicAlias (StorageFormat -> Text
T.pack StorageFormat
old) (StorageFormat -> Text
T.pack StorageFormat
new)
regexaliasp :: TextParser m AccountAlias
regexaliasp :: TextParser m AccountAlias
regexaliasp = do
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'/'
StorageFormat
re <- ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat)
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT CustomErr Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ("/\n\r" :: [Char])
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'/'
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'='
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
StorageFormat
repl <- ParsecT CustomErr Text m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
AccountAlias -> TextParser m AccountAlias
forall (m :: * -> *) a. Monad m => a -> m a
return (AccountAlias -> TextParser m AccountAlias)
-> AccountAlias -> TextParser m AccountAlias
forall a b. (a -> b) -> a -> b
$ StorageFormat -> StorageFormat -> AccountAlias
RegexAlias StorageFormat
re StorageFormat
repl
endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep = do
StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordsp "end aliases" JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 "tag" StateT Journal (ParsecT CustomErr Text m) Text
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
StorageFormat
_ <- ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat)
-> ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m StorageFormat
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 StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
() -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endtagdirectivep :: JournalParser m ()
endtagdirectivep :: JournalParser m ()
endtagdirectivep = do
(StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordsp "end tag" JournalParser m () -> JournalParser m () -> JournalParser m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StorageFormat -> JournalParser m ()
forall (m :: * -> *). StorageFormat -> JournalParser m ()
keywordp "pop") JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "end tag or pop directive"
ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
() -> 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 Token Text
'Y' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
StorageFormat
y <- StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
let y' :: Year
y' = StorageFormat -> Year
forall a. Read a => StorageFormat -> a
read StorageFormat
y
StorageFormat -> JournalParser m ()
forall (m :: * -> *). MonadFail m => StorageFormat -> m ()
failIfInvalidYear StorageFormat
y
Year -> JournalParser m ()
forall (m :: * -> *). Year -> JournalParser m ()
setYear Year
y'
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 Token Text
'D' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
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 -> StorageFormat -> CustomErr
parseErrorAt Int
off StorageFormat
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 Token Text
'P' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 d :: Day
d _ <- 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
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Amount
price <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
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 Token Text
'N' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
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 Token Text
'C' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp
ParsecT CustomErr Text m StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) StorageFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline
() -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 Token Text
'=' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
(_comment :: Text
_comment, _tags :: [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
[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
periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction
periodictransactionp :: JournalParser m PeriodicTransaction
periodictransactionp = 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 Token Text
'~' StateT Journal (ParsecT CustomErr Text m) Char
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Int
off <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
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
Nothing -> Day
today
Just y :: Year
y -> Year -> Int -> Int -> Day
fromGregorian Year
y 1 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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ';' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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
(interval :: Interval
interval, span :: 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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
offset1 Int
offset2 (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"remainder of period expression cannot be parsed"
StorageFormat -> StorageFormat -> StorageFormat
forall a. Semigroup a => a -> a -> a
<> "\nperhaps you need to terminate the period expression with a double space?"
StorageFormat -> StorageFormat -> StorageFormat
forall a. Semigroup a => a -> a -> a
<> "\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
case Interval -> DateSpan -> Text -> Maybe StorageFormat
checkPeriodicTransactionStartDate Interval
interval DateSpan
span Text
periodtxt of
Just e :: StorageFormat
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 -> StorageFormat -> CustomErr
parseErrorAt Int
off StorageFormat
e
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
-> StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) Status
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
(comment :: Text
comment, tags :: [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
[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
}
transactionp :: JournalParser m Transaction
transactionp :: JournalParser m Transaction
transactionp = do
SourcePos
startpos <- StateT Journal (ParsecT CustomErr Text m) SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
Day
date <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep JournalParser m Day -> StorageFormat -> JournalParser m Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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)
-> StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Day)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) Status
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
(comment :: Text
comment, tags :: [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 e s (m :: * -> *). 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 0 "" GenericSourcePos
sourcepos Day
date Maybe Day
edate Status
status Text
code Text
description Text
comment [Tag]
tags [Posting]
postings
postingsp :: Maybe Year -> JournalParser m [Posting]
postingsp :: Maybe Year -> JournalParser m [Posting]
postingsp mTransactionYear :: 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]
-> StorageFormat -> JournalParser m [Posting]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "postings"
postingp :: Maybe Year -> JournalParser m Posting
postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear :: Maybe Year
mTransactionYear = do
(status :: Status
status, account :: 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 (ptype :: PostingType
ptype, account' :: 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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
-> StateT
Journal (ParsecT CustomErr Text m) (Maybe BalanceAssertion))
-> StateT Journal (ParsecT CustomErr Text m) BalanceAssertion
-> StateT
Journal (ParsecT CustomErr Text m) (Maybe BalanceAssertion)
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) BalanceAssertion
forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp
Maybe Amount
_ <- JournalParser m (Maybe Amount)
forall (m :: * -> *). JournalParser m (Maybe Amount)
fixedlotpricep
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
(comment :: Text
comment,tags :: [Tag]
tags,mdate :: Maybe Day
mdate,mdate2 :: 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_JournalReader :: TestTree
tests_JournalReader = StorageFormat -> [TestTree] -> TestTree
tests "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
StorageFormat -> [TestTree] -> TestTree
tests "accountnamep" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse JournalParser IO Text
p "a:b:c"
]
,StorageFormat -> [TestTree] -> TestTree
tests "datep" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 "2018/01/01" (Year -> Int -> Int -> Day
fromGregorian 2018 1 1)
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep "2018-01-01"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep "2018.01.01"
,StorageFormat -> Assertion -> TestTree
test "yearless date with no default year" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Day
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep "1/1" "current year is unknown"
,StorageFormat -> Assertion -> TestTree
test "yearless date with default year" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let s :: Text
s = "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
forall a. Monoid a => a
mempty{jparsedefaultyear :: Maybe Year
jparsedefaultyear=Year -> Maybe Year
forall a. a -> Maybe a
Just 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 (StorageFormat -> Assertion
forall a. HasCallStack => StorageFormat -> IO a
assertFailure (StorageFormat -> Assertion)
-> (ParseErrorBundle Text CustomErr -> StorageFormat)
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("parse error at "StorageFormat -> StorageFormat -> StorageFormat
forall a. [a] -> [a] -> [a]
++) (StorageFormat -> StorageFormat)
-> (ParseErrorBundle Text CustomErr -> StorageFormat)
-> ParseErrorBundle Text CustomErr
-> StorageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> StorageFormat
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
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Day
forall (m :: * -> *). JournalParser m Day
datep "2018/1/1"
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 :: StorageFormat -> Assertion
bad = (\t :: StorageFormat
t -> StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep StorageFormat
t "")
Text -> Assertion
good "2011/1/1 00:00"
Text -> Assertion
good "2011/1/1 23:59:59"
StorageFormat -> Assertion
bad "2011/1/1"
StorageFormat -> Assertion
bad "2011/1/1 24:00:00"
StorageFormat -> Assertion
bad "2011/1/1 00:60:00"
StorageFormat -> Assertion
bad "2011/1/1 00:00:60"
StorageFormat -> Assertion
bad "2011/1/1 3:5:7"
let t :: LocalTime
t = Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian 2018 1 1) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay 0 0 (Year -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral 0))
StateT Journal (ParsecT CustomErr Text IO) LocalTime
-> Text -> LocalTime -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid 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 "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, Monoid 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 "2018/1/1 00:00+1234" LocalTime
t
,StorageFormat -> [TestTree] -> TestTree
tests "periodictransactionp" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"~ monthly from 2018/6 ;In 2019 we will change this\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = "monthly from 2018/6"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months 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 2018 6 1) Maybe Day
forall a. Maybe a
Nothing
,ptdescription :: Text
ptdescription = ""
,ptcomment :: Text
ptcomment = "In 2019 we will change this\n"
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"~ monthly from 2018/6 In 2019 we will change this\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = "monthly from 2018/6"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months 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 2018 6 1) Maybe Day
forall a. Maybe a
Nothing
,ptdescription :: Text
ptdescription = "In 2019 we will change this"
,ptcomment :: Text
ptcomment = ""
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"~ monthly Next year blah blah\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = "monthly"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months 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 = "Next year blah blah"
,ptcomment :: Text
ptcomment = ""
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"~ 2019-01-04\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = "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 2019 1 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 2019 1 5)
,ptdescription :: Text
ptdescription = ""
,ptcomment :: Text
ptcomment = ""
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"~ 2019-01-04\n ;\n a 1\n b\n"
]
,StorageFormat -> [TestTree] -> TestTree
tests "postingp" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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)
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
Posting
posting{
paccount :: Text
paccount="expenses:food:dining",
pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
usd 10],
pcomment :: Text
pcomment="a: a a\nb: b b\n",
ptags :: [Tag]
ptags=[("a","a a"), ("b","b b")]
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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)
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
Posting
nullposting{
paccount :: Text
paccount="a"
,pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
num 1]
,pcomment :: Text
pcomment="date:2012/11/28, date2=2012/11/29,b:b\n"
,ptags :: [Tag]
ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")]
,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 2012 11 28
,pdate2 :: Maybe Day
pdate2=Maybe Day
forall a. Maybe a
Nothing
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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)
" a 1. ; [2012/11/28=2012/11/29]\n"
Posting
nullposting{
paccount :: Text
paccount="a"
,pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
num 1]
,pcomment :: Text
pcomment="[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 2012 11 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 2012 11 29
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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) " a 1 \"DE123\"\n"
,StorageFormat -> Assertion -> TestTree
test "balance assertion and 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, Monoid 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) " a 1 \"DE123\" =$1 { =2.2 EUR} \n"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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) " a $1 == $1\n"
]
,StorageFormat -> [TestTree] -> TestTree
tests "transactionmodifierp" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"= (some value expr)\n some:postings 1.\n"
TransactionModifier
nulltransactionmodifier {
tmquerytxt :: Text
tmquerytxt = "(some value expr)"
,tmpostingrules :: [Posting]
tmpostingrules = [Posting
nullposting{paccount :: Text
paccount="some:postings", pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed[DecimalRaw Year -> Amount
num 1]}]
}
]
,StorageFormat -> [TestTree] -> TestTree
tests "transactionp" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 "2015/1/1\n" Transaction
nulltransaction{tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian 2015 1 1}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
" ; ttag1: val1",
" * a $1.00 ; pcomment1",
" ; pcomment2",
" ; ptag1: val1",
" ; ptag2: val2"
])
Transaction
nulltransaction{
tsourcepos :: GenericSourcePos
tsourcepos=StorageFormat -> (Int, Int) -> GenericSourcePos
JournalSourcePos "" (1,7),
tprecedingcomment :: Text
tprecedingcomment="",
tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian 2012 5 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 2012 5 15,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: Text
tcode="code",
tdescription :: Text
tdescription="desc",
tcomment :: Text
tcomment="tcomment1\ntcomment2\nttag1: val1\n",
ttags :: [Tag]
ttags=[("ttag1","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="a",
pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [DecimalRaw Year -> Amount
usd 1],
pcomment :: Text
pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
ptype :: PostingType
ptype=PostingType
RegularPosting,
ptags :: [Tag]
ptags=[("ptag1","val1"),("ptag2","val2")],
ptransaction :: Maybe Transaction
ptransaction=Maybe Transaction
forall a. Maybe a
Nothing
}
]
}
,StorageFormat -> Assertion -> TestTree
test "parses a well-formed transaction" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => StorageFormat -> Bool -> Assertion
StorageFormat -> Bool -> Assertion
assertBool "" (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
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking $-47.18"
,""
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 "2009/1/1 a ;comment\n b 1\n" Transaction -> Text
tdescription "a"
,StorageFormat -> Assertion -> TestTree
test "parses a following whitespace line" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => StorageFormat -> Bool -> Assertion
StorageFormat -> Bool -> Assertion
assertBool "" (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
["2012/1/1"
," a 1"
," b"
," "
]
,StorageFormat -> Assertion -> TestTree
test "parses an empty transaction comment following whitespace line" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
HasCallStack => StorageFormat -> Bool -> Assertion
StorageFormat -> Bool -> Assertion
assertBool "" (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
["2012/1/1"
," ;"
," a 1"
," b"
," "
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment"
," ; posting 1 comment 2"
," b"
," ; 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)
2
]
,StorageFormat -> [TestTree] -> TestTree
tests "directivep" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 "!account a\n"
StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid 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 "!D 1.0\n"
]
,StorageFormat -> [TestTree] -> TestTree
tests "accountdirectivep" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep "account a:b ; a comment\n"
,StorageFormat -> Assertion -> TestTree
test "does-not-support-!" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) ()
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep "!account a:b\n" ""
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
accountdirectivep "account a:b A\n"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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 "account a:b ; type:asset\n"
Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts
[("a:b", AccountDeclarationInfo :: Text -> [Tag] -> Int -> AccountDeclarationInfo
AccountDeclarationInfo{adicomment :: Text
adicomment = "type:asset\n"
,aditags :: [Tag]
aditags = [("type","asset")]
,adideclarationorder :: Int
adideclarationorder = 1
})
]
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep "C 1h = $50.00\n"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep "D $1,000.0\n"
StateT Journal (ParsecT CustomErr Text IO) ()
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
,StorageFormat -> [TestTree] -> TestTree
tests "defaultyeardirectivep" [
StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep "Y 1000"
,StorageFormat -> Assertion -> TestTree
test "999" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) ()
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep "Y 999" "bad year number"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep "Y 12345"
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep "N $\n"
,StorageFormat -> [TestTree] -> TestTree
tests "includedirectivep" [
StorageFormat -> Assertion -> TestTree
test "include" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> StorageFormat -> Assertion
forall st a.
(Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> StorageFormat -> Assertion
assertParseErrorE StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
,StorageFormat -> Assertion -> TestTree
test "glob" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> Text -> StorageFormat -> Assertion
forall st a.
(Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> StorageFormat -> Assertion
assertParseErrorE StateT
Journal (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
]
,StorageFormat -> Assertion -> TestTree
test "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, Monoid 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
"P 2017/01/30 BTC $922.83\n"
PriceDirective :: Day -> Text -> Amount -> PriceDirective
PriceDirective{
pddate :: Day
pddate = Year -> Int -> Int -> Day
fromGregorian 2017 1 30,
pdcommodity :: Text
pdcommodity = "BTC",
pdamount :: Amount
pdamount = DecimalRaw Year -> Amount
usd 922.83
}
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
tagdirectivep "tag foo \n"
,StorageFormat -> Assertion -> TestTree
test "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, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep "end tag \n"
StateT Journal (ParsecT CustomErr Text IO) () -> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) ()
forall (m :: * -> *). JournalParser m ()
endtagdirectivep "pop \n"
,StorageFormat -> [TestTree] -> TestTree
tests "journalp" [
StorageFormat -> Assertion -> TestTree
test "empty file" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ ErroringJournalParser IO Journal -> Text -> Journal -> Assertion
forall st a.
(Monoid 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 "" Journal
nulljournal
]
,StorageFormat -> Assertion -> TestTree
test "parseAndFinaliseJournal" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either StorageFormat Journal
ej <- ExceptT StorageFormat IO Journal
-> IO (Either StorageFormat Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StorageFormat IO Journal
-> IO (Either StorageFormat Journal))
-> ExceptT StorageFormat IO Journal
-> IO (Either StorageFormat Journal)
forall a b. (a -> b) -> a -> b
$ ErroringJournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp InputOpts
definputopts "" "2019-1-1\n"
let Right j :: Journal
j = Either StorageFormat Journal
ej
StorageFormat -> [StorageFormat] -> [StorageFormat] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
StorageFormat -> a -> a -> Assertion
assertEqual "" [""] ([StorageFormat] -> Assertion) -> [StorageFormat] -> Assertion
forall a b. (a -> b) -> a -> b
$ Journal -> [StorageFormat]
journalFilePaths Journal
j
]