{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Read.JournalReader (
findReader,
splitReaderPrefix,
reader,
parseAndFinaliseJournal,
runJournalParser,
rjp,
runErroringJournalParser,
rejp,
getParentAccount,
journalp,
directivep,
defaultyeardirectivep,
marketpricedirectivep,
datetimep,
datep,
modifiedaccountnamep,
tmpostingrulep,
statusp,
emptyorcommentlinep,
followingcommentp,
accountaliasp
,tests_JournalReader
)
where
import qualified Control.Monad.Fail as Fail (fail)
import qualified Control.Exception as C
import Control.Monad (forM_, when, void, unless)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.State.Strict (evalStateT,get,modify',put)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower)
import Data.Either (isRight, lefts)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Data.String
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Safe
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf
import System.FilePath
import "Glob" System.FilePath.Glob hiding (match)
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils
import qualified Hledger.Read.CsvReader as CsvReader (reader)
import qualified Hledger.Read.RulesReader as RulesReader (reader)
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
runJournalParser, rjp
:: Monad m
=> JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser :: forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser JournalParser m a
p = forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JournalParser m a
p Journal
nulljournal) [Char]
""
rjp :: forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp = forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser
runErroringJournalParser, rejp
:: Monad m
=> ErroringJournalParser m a
-> Text
-> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser :: forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser ErroringJournalParser m a
p Text
t =
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser m a
p Journal
nulljournal) [Char]
"" Text
t
rejp :: forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
rejp = forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser
readers' :: MonadIO m => [Reader m]
readers' :: forall (m :: * -> *). MonadIO m => [Reader m]
readers' = [
forall (m :: * -> *). MonadIO m => Reader m
reader
,forall (m :: * -> *). MonadIO m => Reader m
TimeclockReader.reader
,forall (m :: * -> *). MonadIO m => Reader m
TimedotReader.reader
,forall (m :: * -> *). MonadIO m => Reader m
RulesReader.reader
,forall (m :: * -> *). MonadIO m => Reader m
CsvReader.reader
]
readerNames :: [String]
readerNames :: [[Char]]
readerNames = forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Reader m -> [Char]
rFormat (forall (m :: * -> *). MonadIO m => [Reader m]
readers'::[Reader IO])
findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m)
findReader :: forall (m :: * -> *).
MonadIO m =>
Maybe [Char] -> Maybe [Char] -> Maybe (Reader m)
findReader Maybe [Char]
Nothing Maybe [Char]
Nothing = forall a. Maybe a
Nothing
findReader (Just [Char]
fmt) Maybe [Char]
_ = forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- forall (m :: * -> *). MonadIO m => [Reader m]
readers', forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r forall a. Eq a => a -> a -> Bool
== [Char]
fmt]
findReader Maybe [Char]
Nothing (Just [Char]
path) =
case Maybe [Char]
prefix of
Just [Char]
fmt -> forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- forall (m :: * -> *). MonadIO m => [Reader m]
readers', forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r forall a. Eq a => a -> a -> Bool
== [Char]
fmt]
Maybe [Char]
Nothing -> forall a. [a] -> Maybe a
headMay [Reader m
r | Reader m
r <- forall (m :: * -> *). MonadIO m => [Reader m]
readers', [Char]
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (m :: * -> *). Reader m -> [[Char]]
rExtensions Reader m
r]
where
(Maybe [Char]
prefix,[Char]
path') = [Char] -> (Maybe [Char], [Char])
splitReaderPrefix [Char]
path
ext :: [Char]
ext = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeExtension [Char]
path'
type PrefixedFilePath = FilePath
splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
splitReaderPrefix :: [Char] -> (Maybe [Char], [Char])
splitReaderPrefix [Char]
f =
forall a. a -> [a] -> a
headDef (forall a. Maybe a
Nothing, [Char]
f) forall a b. (a -> b) -> a -> b
$
[(forall a. a -> Maybe a
Just [Char]
r, forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
r forall a. Num a => a -> a -> a
+ Int
1) [Char]
f) | [Char]
r <- [[Char]]
readerNames, ([Char]
rforall a. [a] -> [a] -> [a]
++[Char]
":") forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
f]
reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
{rFormat :: [Char]
rFormat = [Char]
"journal"
,rExtensions :: [[Char]]
rExtensions = [[Char]
"journal", [Char]
"j", [Char]
"hledger", [Char]
"ledger"]
,rReadFn :: InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
rReadFn = InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parse InputOpts
iopts [Char]
f = ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
journalp' InputOpts
iopts [Char]
f
where
journalp' :: ErroringJournalParser IO Journal
journalp' = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp
journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
journalp :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp = do
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
addJournalItemP
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
forall s (m :: * -> *). MonadState s m => m s
get
addJournalItemP :: MonadIO m => ErroringJournalParser m ()
addJournalItemP :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
addJournalItemP =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep
, forall (m :: * -> *). JournalParser m Transaction
transactionp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Journal -> Journal
addTransaction
, forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionModifier -> Journal -> Journal
addTransactionModifier
, forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicTransaction -> Journal -> Journal
addPeriodicTransaction
, forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceDirective -> Journal -> Journal
addPriceDirective
, forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
, forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
multilinecommentp)
] forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"transaction or directive"
directivep :: MonadIO m => ErroringJournalParser m ()
directivep :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep = (do
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'!',Char
'@']
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep
,forall (m :: * -> *). JournalParser m ()
aliasdirectivep
,forall (m :: * -> *). JournalParser m ()
endaliasesdirectivep
,forall (m :: * -> *). JournalParser m ()
accountdirectivep
,forall (m :: * -> *). JournalParser m ()
applyaccountdirectivep
,forall (m :: * -> *). JournalParser m ()
applyfixeddirectivep
,forall (m :: * -> *). JournalParser m ()
applytagdirectivep
,forall (m :: * -> *). JournalParser m ()
assertdirectivep
,forall (m :: * -> *). JournalParser m ()
bucketdirectivep
,forall (m :: * -> *). JournalParser m ()
capturedirectivep
,forall (m :: * -> *). JournalParser m ()
checkdirectivep
,forall (m :: * -> *). JournalParser m ()
commandlineflagdirectivep
,forall (m :: * -> *). JournalParser m ()
commoditydirectivep
,forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep
,forall (m :: * -> *). JournalParser m ()
decimalmarkdirectivep
,forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep
,forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep
,forall (m :: * -> *). JournalParser m ()
definedirectivep
,forall (m :: * -> *). JournalParser m ()
endapplyaccountdirectivep
,forall (m :: * -> *). JournalParser m ()
endapplyfixeddirectivep
,forall (m :: * -> *). JournalParser m ()
endapplytagdirectivep
,forall (m :: * -> *). JournalParser m ()
endapplyyeardirectivep
,forall (m :: * -> *). JournalParser m ()
endtagdirectivep
,forall (m :: * -> *). JournalParser m ()
evaldirectivep
,forall (m :: * -> *). JournalParser m ()
exprdirectivep
,forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep
,forall (m :: * -> *). JournalParser m ()
payeedirectivep
,forall (m :: * -> *). JournalParser m ()
pythondirectivep
,forall (m :: * -> *). JournalParser m ()
tagdirectivep
,forall (m :: * -> *). JournalParser m ()
valuedirectivep
]
) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"directive"
includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep :: forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"include"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
[Char]
prefixedglob <- Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
Int
parentoff <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
SourcePos
parentpos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let (Maybe [Char]
mprefix,[Char]
glb) = [Char] -> (Maybe [Char], [Char])
splitReaderPrefix [Char]
prefixedglob
[[Char]]
paths <- forall (m :: * -> *).
MonadIO m =>
Int -> SourcePos -> [Char] -> JournalParser m [[Char]]
getFilePaths Int
parentoff SourcePos
parentpos [Char]
glb
let prefixedpaths :: [[Char]]
prefixedpaths = case Maybe [Char]
mprefix of
Maybe [Char]
Nothing -> [[Char]]
paths
Just [Char]
fmt -> forall a b. (a -> b) -> [a] -> [b]
map (([Char]
fmtforall a. [a] -> [a] -> [a]
++[Char]
":")forall a. [a] -> [a] -> [a]
++) [[Char]]
paths
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
prefixedpaths forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
SourcePos -> [Char] -> ErroringJournalParser m ()
parseChild SourcePos
parentpos
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 :: forall (m :: * -> *).
MonadIO m =>
Int -> SourcePos -> [Char] -> JournalParser m [[Char]]
getFilePaths Int
parseroff SourcePos
parserpos [Char]
filename = do
let curdir :: [Char]
curdir = [Char] -> [Char]
takeDirectory (SourcePos -> [Char]
sourceName SourcePos
parserpos)
[Char]
filename' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
expandHomePath [Char]
filename
forall (m :: * -> *) a.
MonadIO m =>
IO a -> [Char] -> TextParser m a
`orRethrowIOError` (forall a. Show a => a -> [Char]
show SourcePos
parserpos forall a. [a] -> [a] -> [a]
++ [Char]
" locating " forall a. [a] -> [a] -> [a]
++ [Char]
filename)
Pattern
fileglob <- case CompOptions -> [Char] -> Either [Char] Pattern
tryCompileWith CompOptions
compDefault{errorRecovery :: Bool
errorRecovery=Bool
False} [Char]
filename' of
Right Pattern
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
x
Left [Char]
e -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
parseroff forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid glob pattern: " forall a. [a] -> [a] -> [a]
++ [Char]
e
[[Char]]
filepaths <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> [Char] -> IO [[Char]]
globDir1 Pattern
fileglob [Char]
curdir
if (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]]
filepaths
then forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]]
filepaths
else forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
parseroff forall a b. (a -> b) -> a -> b
$
[Char]
"No existing files match pattern: " forall a. [a] -> [a] -> [a]
++ [Char]
filename
parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()
parseChild :: forall (m :: * -> *).
MonadIO m =>
SourcePos -> [Char] -> ErroringJournalParser m ()
parseChild SourcePos
parentpos [Char]
prefixedpath = do
let (Maybe [Char]
_mprefix,[Char]
filepath) = [Char] -> (Maybe [Char], [Char])
splitReaderPrefix [Char]
prefixedpath
Journal
parentj <- forall s (m :: * -> *). MonadState s m => m s
get
let parentfilestack :: [[Char]]
parentfilestack = Journal -> [[Char]]
jincludefilestack Journal
parentj
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
filepath forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
parentfilestack) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail ([Char]
"Cyclic include: " forall a. [a] -> [a] -> [a]
++ [Char]
filepath)
Text
childInput <-
forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
6 ([Char]
"parseChild: "forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
takeFileName [Char]
filepath) forall a b. (a -> b) -> a -> b
$
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
readFilePortably [Char]
filepath
forall (m :: * -> *) a.
MonadIO m =>
IO a -> [Char] -> TextParser m a
`orRethrowIOError` (forall a. Show a => a -> [Char]
show SourcePos
parentpos forall a. [a] -> [a] -> [a]
++ [Char]
" reading " forall a. [a] -> [a] -> [a]
++ [Char]
filepath)
let initChildj :: Journal
initChildj = [Char] -> Journal -> Journal
newJournalWithParseStateFrom [Char]
filepath Journal
parentj
let r :: Reader m
r = forall a. a -> Maybe a -> a
fromMaybe forall (m :: * -> *). MonadIO m => Reader m
reader forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Maybe [Char] -> Maybe [Char] -> Maybe (Reader m)
findReader forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just [Char]
prefixedpath)
parser :: ErroringJournalParser m Journal
parser = forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser Reader m
r
forall (m :: * -> *) a. (MonadIO m, Show a) => [Char] -> a -> m ()
dbg6IO [Char]
"parseChild: trying reader" (forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r)
Journal
updatedChildj <- ([Char], Text) -> Journal -> Journal
journalAddFile ([Char]
filepath, Text
childInput) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) st a.
Monad m =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
a
-> st
-> [Char]
-> Text
-> StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m))
a
parseIncludeFile ErroringJournalParser m Journal
parser Journal
initChildj [Char]
filepath Text
childInput
let
parentj' :: Journal
parentj' =
[Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"parseChild: child " forall a. Semigroup a => a -> a -> a
<> [Char]
childfilename forall a. Semigroup a => a -> a -> a
<> [Char]
" acct decls: ") Journal
updatedChildj
Journal -> Journal -> Journal
`journalConcat`
[Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"parseChild: parent " forall a. Semigroup a => a -> a -> a
<> [Char]
parentfilename forall a. Semigroup a => a -> a -> a
<> [Char]
" acct decls: ") Journal
parentj
where
childfilename :: [Char]
childfilename = [Char] -> [Char]
takeFileName [Char]
filepath
parentfilename :: [Char]
parentfilename = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"(unknown)" [Char] -> [Char]
takeFileName forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ Journal -> [[Char]]
jincludefilestack Journal
parentj
forall s (m :: * -> *). MonadState s m => s -> m ()
put Journal
parentj'
newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
newJournalWithParseStateFrom :: [Char] -> Journal -> Journal
newJournalWithParseStateFrom [Char]
filepath Journal
j = Journal
nulljournal{
jparsedefaultyear :: Maybe Year
jparsedefaultyear = Journal -> Maybe Year
jparsedefaultyear Journal
j
,jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity Journal
j
,jparseparentaccounts :: [Text]
jparseparentaccounts = Journal -> [Text]
jparseparentaccounts Journal
j
,jparsedecimalmark :: Maybe Char
jparsedecimalmark = Journal -> Maybe Char
jparsedecimalmark 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 :: [[Char]]
jincludefilestack = [Char]
filepath forall a. a -> [a] -> [a]
: Journal -> [[Char]]
jincludefilestack Journal
j
}
orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
orRethrowIOError :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> [Char] -> TextParser m a
orRethrowIOError IO a
io [Char]
msg = do
Either [Char] a
eResult <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
io) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` \(IOException
e::C.IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"%s:\n%s" [Char]
msg (forall a. Show a => a -> [Char]
show IOException
e)
case Either [Char] a
eResult of
Right a
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
Left [Char]
errMsg -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
errMsg
accountdirectivep :: JournalParser m ()
accountdirectivep :: forall (m :: * -> *). JournalParser m ()
accountdirectivep = do
Int
off <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"account"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
acct <- (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"account name without brackets") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
(Text
cmt, [Tag]
tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall (m :: * -> *). JournalParser m [Char]
indentedlinep
let
metype :: Maybe (Either [Char] AccountType)
metype = Text -> Either [Char] AccountType
parseAccountTypeCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
accountTypeTagName [Tag]
tags
forall (m :: * -> *).
(Text, Text, [Tag], SourcePos) -> JournalParser m ()
addAccountDeclaration (Text
acct, Text
cmt, [Tag]
tags, SourcePos
pos)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tag]
tags) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Text -> [Tag] -> JournalParser m ()
addDeclaredAccountTags Text
acct [Tag]
tags
case Maybe (Either [Char] AccountType)
metype of
Maybe (Either [Char] AccountType)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Right AccountType
t) -> forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
t
Just (Left [Char]
err) -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
err
accountTypeTagName :: Text
accountTypeTagName = Text
"type"
parseAccountTypeCode :: Text -> Either String AccountType
parseAccountTypeCode :: Text -> Either [Char] AccountType
parseAccountTypeCode Text
s =
case Text -> Text
T.toLower Text
s of
Text
"asset" -> forall a b. b -> Either a b
Right AccountType
Asset
Text
"a" -> forall a b. b -> Either a b
Right AccountType
Asset
Text
"liability" -> forall a b. b -> Either a b
Right AccountType
Liability
Text
"l" -> forall a b. b -> Either a b
Right AccountType
Liability
Text
"equity" -> forall a b. b -> Either a b
Right AccountType
Equity
Text
"e" -> forall a b. b -> Either a b
Right AccountType
Equity
Text
"revenue" -> forall a b. b -> Either a b
Right AccountType
Revenue
Text
"r" -> forall a b. b -> Either a b
Right AccountType
Revenue
Text
"expense" -> forall a b. b -> Either a b
Right AccountType
Expense
Text
"x" -> forall a b. b -> Either a b
Right AccountType
Expense
Text
"cash" -> forall a b. b -> Either a b
Right AccountType
Cash
Text
"c" -> forall a b. b -> Either a b
Right AccountType
Cash
Text
"conversion" -> forall a b. b -> Either a b
Right AccountType
Conversion
Text
"v" -> forall a b. b -> Either a b
Right AccountType
Conversion
Text
_ -> forall a b. a -> Either a b
Left [Char]
err
where
err :: [Char]
err = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"invalid account type code "forall a. Semigroup a => a -> a -> a
<>Text
sforall a. Semigroup a => a -> a -> a
<>Text
", should be one of " forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate Text
", " [Text
"A",Text
"L",Text
"E",Text
"R",Text
"X",Text
"C",Text
"V",Text
"Asset",Text
"Liability",Text
"Equity",Text
"Revenue",Text
"Expense",Text
"Cash",Text
"Conversion"]
addAccountDeclaration :: (AccountName,Text,[Tag],SourcePos) -> JournalParser m ()
addAccountDeclaration :: forall (m :: * -> *).
(Text, Text, [Tag], SourcePos) -> JournalParser m ()
addAccountDeclaration (Text
a,Text
cmt,[Tag]
tags,SourcePos
pos) = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j ->
let
decls :: [(Text, AccountDeclarationInfo)]
decls = Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
d :: (Text, AccountDeclarationInfo)
d = (Text
a, AccountDeclarationInfo
nullaccountdeclarationinfo{
adicomment :: Text
adicomment = Text
cmt
,aditags :: [Tag]
aditags = [Tag]
tags
,adideclarationorder :: Int
adideclarationorder = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, AccountDeclarationInfo)]
decls forall a. Num a => a -> a -> a
+ Int
1
,adisourcepos :: SourcePos
adisourcepos = SourcePos
pos
})
in
Journal
j{jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredaccounts = (Text, AccountDeclarationInfo)
dforall a. a -> [a] -> [a]
:[(Text, AccountDeclarationInfo)]
decls})
addPayeeDeclaration :: (Payee,Text,[Tag]) -> JournalParser m ()
addPayeeDeclaration :: forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addPayeeDeclaration (Text
p, Text
cmt, [Tag]
tags) =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j@Journal{[(Text, PayeeDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jdeclaredpayees} -> Journal
j{jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jdeclaredpayees=(Text, PayeeDeclarationInfo)
dforall a. a -> [a] -> [a]
:[(Text, PayeeDeclarationInfo)]
jdeclaredpayees})
where
d :: (Text, PayeeDeclarationInfo)
d = (Text
p
,PayeeDeclarationInfo
nullpayeedeclarationinfo{
pdicomment :: Text
pdicomment = Text
cmt
,pditags :: [Tag]
pditags = [Tag]
tags
})
addTagDeclaration :: (TagName,Text) -> JournalParser m ()
addTagDeclaration :: forall (m :: * -> *). Tag -> JournalParser m ()
addTagDeclaration (Text
t, Text
cmt) =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j@Journal{[(Text, TagDeclarationInfo)]
jdeclaredtags :: Journal -> [(Text, TagDeclarationInfo)]
jdeclaredtags :: [(Text, TagDeclarationInfo)]
jdeclaredtags} -> Journal
j{jdeclaredtags :: [(Text, TagDeclarationInfo)]
jdeclaredtags=(Text, TagDeclarationInfo)
tagandinfoforall a. a -> [a] -> [a]
:[(Text, TagDeclarationInfo)]
jdeclaredtags})
where
tagandinfo :: (Text, TagDeclarationInfo)
tagandinfo = (Text
t, TagDeclarationInfo
nulltagdeclarationinfo{tdicomment :: Text
tdicomment=Text
cmt})
indentedlinep :: JournalParser m String
indentedlinep :: forall (m :: * -> *). JournalParser m [Char]
indentedlinep = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> [Char]
rstrip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline)
commoditydirectivep :: JournalParser m ()
commoditydirectivep :: forall (m :: * -> *). JournalParser m ()
commoditydirectivep = forall (m :: * -> *). JournalParser m ()
commoditydirectiveonelinep forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). JournalParser m ()
commoditydirectivemultilinep
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep :: forall (m :: * -> *). JournalParser m ()
commoditydirectiveonelinep = do
(Int
off, Amount{Text
acommodity :: Amount -> Text
acommodity :: Text
acommodity,AmountStyle
astyle :: Amount -> AmountStyle
astyle :: AmountStyle
astyle}) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Int
off <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Amount
amt <- forall (m :: * -> *). JournalParser m Amount
amountp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
off, Amount
amt)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Text
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
followingcommentp
let comm :: Commodity
comm = Commodity{csymbol :: Text
csymbol=Text
acommodity, cformat :: Maybe AmountStyle
cformat=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg6 [Char]
"style from commodity directive" AmountStyle
astyle}
if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ AmountStyle -> Maybe Char
asdecimalmark AmountStyle
astyle
then forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
pleaseincludedecimalpoint
else forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jcommodities :: Map Text Commodity
jcommodities=forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
acommodity Commodity
comm forall a b. (a -> b) -> a -> b
$ Journal -> Map Text Commodity
jcommodities Journal
j})
pleaseincludedecimalpoint :: String
pleaseincludedecimalpoint :: [Char]
pleaseincludedecimalpoint = [Char] -> [Char]
chomp forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
[Char]
"Please include a decimal point or decimal comma in commodity directives,"
,[Char]
"to help us parse correctly. It may be followed by zero or more decimal digits."
,[Char]
"Examples:"
,[Char]
"commodity $1000. ; no thousands mark, decimal period, no decimals"
,[Char]
"commodity 1.234,00 ARS ; period at thousands, decimal comma, 2 decimals"
,[Char]
"commodity EUR 1 000,000 ; space at thousands, decimal comma, 3 decimals"
,[Char]
"commodity INR1,23,45,678.0 ; comma at thousands/lakhs/crores, decimal period, 1 decimal"
]
commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep :: forall (m :: * -> *). JournalParser m ()
commoditydirectivemultilinep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"commodity"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
sym <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
commoditysymbolp
Text
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
followingcommentp
[Either AmountStyle [Char]]
subdirectives <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall {b}.
StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
indented (forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP (forall (m :: * -> *). Text -> JournalParser m AmountStyle
formatdirectivep Text
sym) (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline))
let mfmt :: Maybe AmountStyle
mfmt = forall a. [a] -> Maybe a
lastMay forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
lefts [Either AmountStyle [Char]]
subdirectives
let comm :: Commodity
comm = Commodity{csymbol :: Text
csymbol=Text
sym, cformat :: Maybe AmountStyle
cformat=Maybe AmountStyle
mfmt}
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jcommodities :: Map Text Commodity
jcommodities=forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
sym Commodity
comm forall a b. (a -> b) -> a -> b
$ Journal -> Map Text Commodity
jcommodities Journal
j})
where
indented :: StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
indented = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep :: forall (m :: * -> *). Text -> JournalParser m AmountStyle
formatdirectivep Text
expectedsym = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"format"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Int
off <- 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} <- forall (m :: * -> *). JournalParser m Amount
amountp
Text
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
followingcommentp
if Text
acommodityforall a. Eq a => a -> a -> Bool
==Text
expectedsym
then
if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ AmountStyle -> Maybe Char
asdecimalmark AmountStyle
astyle
then forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
pleaseincludedecimalpoint
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg6 [Char]
"style from format subdirective" AmountStyle
astyle
else forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off forall a b. (a -> b) -> a -> b
$
forall r. PrintfType r => [Char] -> r
printf [Char]
"commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" Text
expectedsym Text
acommodity
applyfixeddirectivep, endapplyfixeddirectivep, applytagdirectivep, endapplytagdirectivep,
assertdirectivep, bucketdirectivep, capturedirectivep, checkdirectivep,
endapplyyeardirectivep, definedirectivep, exprdirectivep, valuedirectivep,
evaldirectivep, pythondirectivep, commandlineflagdirectivep
:: JournalParser m ()
applyfixeddirectivep :: forall (m :: * -> *). JournalParser m ()
applyfixeddirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply fixed" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplyfixeddirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyfixeddirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply fixed" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
applytagdirectivep :: forall (m :: * -> *). JournalParser m ()
applytagdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply tag" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplytagdirectivep :: forall (m :: * -> *). JournalParser m ()
endapplytagdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply tag" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
endapplyyeardirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyyeardirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end apply year" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertdirectivep :: forall (m :: * -> *). JournalParser m ()
assertdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"assert" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
bucketdirectivep :: forall (m :: * -> *). JournalParser m ()
bucketdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"A " forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"bucket " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
capturedirectivep :: forall (m :: * -> *). JournalParser m ()
capturedirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"capture" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkdirectivep :: forall (m :: * -> *). JournalParser m ()
checkdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"check" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
definedirectivep :: forall (m :: * -> *). JournalParser m ()
definedirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"define" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
exprdirectivep :: forall (m :: * -> *). JournalParser m ()
exprdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"expr" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
valuedirectivep :: forall (m :: * -> *). JournalParser m ()
valuedirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"value" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
evaldirectivep :: forall (m :: * -> *). JournalParser m ()
evaldirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"eval" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
commandlineflagdirectivep :: forall (m :: * -> *). JournalParser m ()
commandlineflagdirectivep = do forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
pythondirectivep :: forall (m :: * -> *). JournalParser m ()
pythondirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"python" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
indentedline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
blankline
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
indentedline :: StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
indentedline = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
blankline :: StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
blankline = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"blank line"
keywordp :: String -> JournalParser m ()
keywordp :: forall (m :: * -> *). [Char] -> JournalParser m ()
keywordp = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString
spacesp :: JournalParser m ()
spacesp :: forall (m :: * -> *). JournalParser m ()
spacesp = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
keywordsp :: String -> JournalParser m ()
keywordsp :: forall (m :: * -> *). [Char] -> JournalParser m ()
keywordsp = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse forall (m :: * -> *). JournalParser m ()
spacesp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). [Char] -> JournalParser m ()
keywordp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words
applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep :: forall (m :: * -> *). JournalParser m ()
applyaccountdirectivep = do
forall (m :: * -> *). [Char] -> JournalParser m ()
keywordsp [Char]
"apply account" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"apply account directive"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
parent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
accountnamep
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
forall (m :: * -> *). Text -> JournalParser m ()
pushParentAccount Text
parent
endapplyaccountdirectivep :: JournalParser m ()
endapplyaccountdirectivep :: forall (m :: * -> *). JournalParser m ()
endapplyaccountdirectivep = do
forall (m :: * -> *). [Char] -> JournalParser m ()
keywordsp [Char]
"end apply account" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"end apply account directive"
forall (m :: * -> *). JournalParser m ()
popParentAccount
aliasdirectivep :: JournalParser m ()
aliasdirectivep :: forall (m :: * -> *). JournalParser m ()
aliasdirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"alias"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
AccountAlias
alias <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m AccountAlias
accountaliasp
forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias AccountAlias
alias
endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep :: forall (m :: * -> *). JournalParser m ()
endaliasesdirectivep = do
forall (m :: * -> *). [Char] -> JournalParser m ()
keywordsp [Char]
"end aliases" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"end aliases directive"
forall (m :: * -> *). MonadState Journal m => m ()
clearAccountAliases
tagdirectivep :: JournalParser m ()
tagdirectivep :: forall (m :: * -> *). JournalParser m ()
tagdirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"tag directive"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
tagname <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall (m :: * -> *). TextParser m Char
nonspace
(Text
comment, [Tag]
_) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall (m :: * -> *). JournalParser m [Char]
indentedlinep
forall (m :: * -> *). Tag -> JournalParser m ()
addTagDeclaration (Text
tagname,Text
comment)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endtagdirectivep :: JournalParser m ()
endtagdirectivep :: forall (m :: * -> *). JournalParser m ()
endtagdirectivep = (do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"end tag or end apply tag directive"
payeedirectivep :: JournalParser m ()
payeedirectivep :: forall (m :: * -> *). JournalParser m ()
payeedirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"payee" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"payee directive"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
payee <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m Text
noncommenttext1p
(Text
comment, [Tag]
tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall (m :: * -> *). JournalParser m [Char]
indentedlinep
forall (m :: * -> *). (Text, Text, [Tag]) -> JournalParser m ()
addPayeeDeclaration (Text
payee, Text
comment, [Tag]
tags)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep :: forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep = do
(forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Y" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"year" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"apply year") forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"default year"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall (m :: * -> *). Year -> JournalParser m ()
setYear forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Year
yearp
defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep :: forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'D' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"default commodity"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Int
off <- 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} <- forall (m :: * -> *). JournalParser m Amount
amountp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
if forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ AmountStyle -> Maybe Char
asdecimalmark AmountStyle
astyle
then forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
pleaseincludedecimalpoint
else forall (m :: * -> *). (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle (Text
acommodity, AmountStyle
astyle)
marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep :: forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'P' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"market price"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Day
date <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (do {LocalTime Day
d TimeOfDay
_ <- forall (m :: * -> *). JournalParser m LocalTime
datetimep; forall (m :: * -> *) a. Monad m => a -> m a
return Day
d}) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). JournalParser m Day
datep
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Text
symbol <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
commoditysymbolp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
price <- forall (m :: * -> *). JournalParser m Amount
amountp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Day -> Text -> Amount -> PriceDirective
PriceDirective Day
date Text
symbol Amount
price
ignoredpricecommoditydirectivep :: JournalParser m ()
ignoredpricecommoditydirectivep :: forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'N' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"ignored-price commodity"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
commoditysymbolp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
forall (m :: * -> *) a. Monad m => a -> m a
return ()
commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep :: forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'C' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"commodity conversion"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
forall (m :: * -> *). JournalParser m Amount
amountp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall (m :: * -> *). JournalParser m Amount
amountp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decimalmarkdirectivep :: JournalParser m ()
decimalmarkdirectivep :: forall (m :: * -> *). JournalParser m ()
decimalmarkdirectivep = do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"decimal-mark" forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"decimal mark"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Char
mark <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall a b. (a -> b) -> a -> b
$ \Journal
j -> Journal
j{jparsedecimalmark :: Maybe Char
jparsedecimalmark=forall a. a -> Maybe a
Just Char
mark}
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m [Char]
restofline
forall (m :: * -> *) a. Monad m => a -> m a
return ()
transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp :: forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"modifier transaction"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Text
querytxt <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m Text
descriptionp
(Text
_comment, [Tag]
_tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
[TMPostingRule]
postingrules <- forall (m :: * -> *). Maybe Year -> JournalParser m [TMPostingRule]
tmpostingrulesp forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [TMPostingRule] -> TransactionModifier
TransactionModifier Text
querytxt [TMPostingRule]
postingrules
periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction
periodictransactionp :: forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp = do
SourcePos
startpos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'~' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"periodic transaction"
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Day
today <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
Maybe Year
mdefaultyear <- forall (m :: * -> *). JournalParser m (Maybe Year)
getYear
let refdate :: Day
refdate = case Maybe Year
mdefaultyear of
Maybe Year
Nothing -> Day
today
Just Year
y -> Year -> Int -> Int -> Day
fromGregorian Year
y Int
1 Int
1
SourceExcerpt
periodExcerpt <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadParsec HledgerParseErrorData Text m =>
m a -> m SourceExcerpt
excerpt_ forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
let periodtxt :: Text
periodtxt = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ SourceExcerpt -> Text
getExcerptText SourceExcerpt
periodExcerpt
(Interval
interval, DateSpan
spn) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
SourceExcerpt
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
reparseExcerpt SourceExcerpt
periodExcerpt forall a b. (a -> b) -> a -> b
$ do
(Interval, DateSpan)
pexp <- forall (m :: * -> *). Day -> TextParser m (Interval, DateSpan)
periodexprp Day
refdate
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall a b. (a -> b) -> a -> b
$ do
Int
offset1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest
Int
offset2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
offset1 Int
offset2 forall a b. (a -> b) -> a -> b
$
[Char]
"remainder of period expression cannot be parsed"
forall a. Semigroup a => a -> a -> a
<> [Char]
"\nperhaps you need to terminate the period expression with a double space?"
forall a. Semigroup a => a -> a -> a
<> [Char]
"\na double space is required between period expression and description/comment"
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval, DateSpan)
pexp
Status
status <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Status
statusp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"cleared status"
Text
code <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
codep forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"transaction code"
Text
description <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m Text
descriptionp
(Text
comment, [Tag]
tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
[Posting]
postings <- forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> a
first3 forall a b. (a -> b) -> a -> b
$ Day -> (Year, Int, Int)
toGregorian Day
refdate)
SourcePos
endpos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let sourcepos :: (SourcePos, SourcePos)
sourcepos = (SourcePos
startpos, SourcePos
endpos)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PeriodicTransaction
nullperiodictransaction{
ptperiodexpr :: Text
ptperiodexpr=Text
periodtxt
,ptinterval :: Interval
ptinterval=Interval
interval
,ptspan :: DateSpan
ptspan=DateSpan
spn
,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos=(SourcePos, SourcePos)
sourcepos
,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 :: forall (m :: * -> *). JournalParser m Transaction
transactionp = do
SourcePos
startpos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Day
date <- forall (m :: * -> *). JournalParser m Day
datep forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"transaction"
Maybe Day
edate <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Day -> TextParser m Day
secondarydatep Day
date) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"secondary date"
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"whitespace or newline"
Status
status <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Status
statusp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"cleared status"
Text
code <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
codep forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"transaction code"
Text
description <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m Text
descriptionp
(Text
comment, [Tag]
tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
let year :: Year
year = forall {a} {b} {c}. (a, b, c) -> a
first3 forall a b. (a -> b) -> a -> b
$ Day -> (Year, Int, Int)
toGregorian Day
date
[Posting]
postings <- forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp (forall a. a -> Maybe a
Just Year
year)
SourcePos
endpos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let sourcepos :: (SourcePos, SourcePos)
sourcepos = (SourcePos
startpos, SourcePos
endpos)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$ Year
-> Text
-> (SourcePos, SourcePos)
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction Year
0 Text
"" (SourcePos, SourcePos)
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 :: forall (m :: * -> *). Maybe Year -> JournalParser m [Posting]
postingsp Maybe Year
mTransactionYear = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp Maybe Year
mTransactionYear) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"postings"
postingp :: Maybe Year -> JournalParser m Posting
postingp :: forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper Bool
False
tmpostingrulesp :: Maybe Year -> JournalParser m [TMPostingRule]
tmpostingrulesp :: forall (m :: * -> *). Maybe Year -> JournalParser m [TMPostingRule]
tmpostingrulesp Maybe Year
mTransactionYear = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (m :: * -> *). Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep Maybe Year
mTransactionYear) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"posting rules"
tmpostingrulep :: Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep :: forall (m :: * -> *). Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Posting -> Bool -> TMPostingRule
TMPostingRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper Bool
True
postingphelper :: Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper :: forall (m :: * -> *).
Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper Bool
isPostingRule Maybe Year
mTransactionYear = do
(Status
status, Text
account) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Status
status <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Status
statusp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Text
account <- forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
status, Text
account)
let (PostingType
ptype, Text
account') = (Text -> PostingType
accountNamePostingType Text
account, Text -> Text
textUnbracket Text
account)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Bool
mult <- if Bool
isPostingRule then StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
multiplierp else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Maybe Amount
amt <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Bool -> JournalParser m Amount
amountp' Bool
mult
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Maybe BalanceAssertion
massertion <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
(Text
comment,[Tag]
tags,Maybe Day
mdate,Maybe Day
mdate2) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Maybe Year -> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
postingcommentp Maybe Year
mTransactionYear
let p :: Posting
p = 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=forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount
missingmixedamt Amount -> MixedAmount
mixedAmount Maybe Amount
amt
, pcomment :: Text
pcomment=Text
comment
, ptype :: PostingType
ptype=PostingType
ptype
, ptags :: [Tag]
ptags=[Tag]
tags
, pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion=Maybe BalanceAssertion
massertion
}
forall (m :: * -> *) a. Monad m => a -> m a
return (Posting
p, Bool
mult)
where
multiplierp :: StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
multiplierp = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*'
tests_JournalReader :: TestTree
tests_JournalReader = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"JournalReader" [
let p :: JournalParser IO Text
p = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
accountnamep :: JournalParser IO AccountName in
[Char] -> [TestTree] -> TestTree
testGroup [Char]
"accountnamep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"basic" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse JournalParser IO Text
p Text
"a:b:c"
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"datep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"YYYY/MM/DD" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Day
datep Text
"2018/01/01" (Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
1 Int
1)
,[Char] -> Assertion -> TestTree
testCase [Char]
"YYYY-MM-DD" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Day
datep Text
"2018-01-01"
,[Char] -> Assertion -> TestTree
testCase [Char]
"YYYY.MM.DD" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Day
datep Text
"2018.01.01"
,[Char] -> Assertion -> TestTree
testCase [Char]
"yearless date with no default year" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError forall (m :: * -> *). JournalParser m Day
datep Text
"1/1" [Char]
"current year is unknown"
,[Char] -> Assertion -> TestTree
testCase [Char]
"yearless date with default year" forall a b. (a -> b) -> a -> b
$ do
let s :: Text
s = Text
"1/1"
Either HledgerParseErrors Day
ep <- forall (m :: * -> *) st a.
Monad m =>
st
-> StateT st (ParsecT HledgerParseErrorData Text m) a
-> Text
-> m (Either HledgerParseErrors a)
parseWithState Journal
nulljournal{jparsedefaultyear :: Maybe Year
jparsedefaultyear=forall a. a -> Maybe a
Just Year
2018} forall (m :: * -> *). JournalParser m Day
datep Text
s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> IO a
assertFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"parse error at "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HledgerParseErrors -> [Char]
customErrorBundlePretty) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) Either HledgerParseErrors Day
ep
,[Char] -> Assertion -> TestTree
testCase [Char]
"no leading zero" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Day
datep Text
"2018/1/1"
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"datetimep" forall a b. (a -> b) -> a -> b
$ do
let
good :: Text -> Assertion
good = forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m LocalTime
datetimep
bad :: Text -> Assertion
bad Text
t = forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
t [Char]
""
Text -> Assertion
good Text
"2011/1/1 00:00"
Text -> Assertion
good Text
"2011/1/1 23:59:59"
Text -> Assertion
bad Text
"2011/1/1"
Text -> Assertion
bad Text
"2011/1/1 24:00:00"
Text -> Assertion
bad Text
"2011/1/1 00:60:00"
Text -> Assertion
bad Text
"2011/1/1 00:00:60"
Text -> Assertion
bad Text
"2011/1/1 3:5:7"
let t :: LocalTime
t = Day -> TimeOfDay -> LocalTime
LocalTime (Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
1 Int
1) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00-0800" LocalTime
t
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m LocalTime
datetimep Text
"2018/1/1 00:00+1234" LocalTime
t
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"periodictransactionp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"more period text in comment after one space" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
Text
"~ monthly from 2018/6 ;In 2019 we will change this\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = Text
"monthly from 2018/6"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months Int
1
,ptspan :: DateSpan
ptspan = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Flex forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
6 Int
1) forall a. Maybe a
Nothing
,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos = ([Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), [Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))
,ptdescription :: Text
ptdescription = Text
""
,ptcomment :: Text
ptcomment = Text
"In 2019 we will change this\n"
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"more period text in description after two spaces" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
Text
"~ monthly from 2018/6 In 2019 we will change this\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = Text
"monthly from 2018/6"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months Int
1
,ptspan :: DateSpan
ptspan = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Flex forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2018 Int
6 Int
1) forall a. Maybe a
Nothing
,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos = ([Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), [Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))
,ptdescription :: Text
ptdescription = Text
"In 2019 we will change this"
,ptcomment :: Text
ptcomment = Text
""
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"Next year in description" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
Text
"~ monthly Next year blah blah\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = Text
"monthly"
,ptinterval :: Interval
ptinterval = Int -> Interval
Months Int
1
,ptspan :: DateSpan
ptspan = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan forall a. Maybe a
Nothing forall a. Maybe a
Nothing
,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos = ([Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), [Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))
,ptdescription :: Text
ptdescription = Text
"Next year blah blah"
,ptcomment :: Text
ptcomment = Text
""
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"Just date, no description" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
Text
"~ 2019-01-04\n"
PeriodicTransaction
nullperiodictransaction {
ptperiodexpr :: Text
ptperiodexpr = Text
"2019-01-04"
,ptinterval :: Interval
ptinterval = Interval
NoInterval
,ptspan :: DateSpan
ptspan = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2019 Int
1 Int
4) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2019 Int
1 Int
5)
,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos = ([Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), [Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))
,ptdescription :: Text
ptdescription = Text
""
,ptcomment :: Text
ptcomment = Text
""
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"Just date, no description + empty transaction comment" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *).
MonadIO m =>
JournalParser m PeriodicTransaction
periodictransactionp
Text
"~ 2019-01-04\n ;\n a 1\n b\n"
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"postingp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"basic" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing)
Text
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
Posting
posting{
paccount :: Text
paccount=Text
"expenses:food:dining",
pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (DecimalRaw Year -> Amount
usd DecimalRaw Year
10),
pcomment :: Text
pcomment=Text
"a: a a\nb: b b\n",
ptags :: [Tag]
ptags=[(Text
"a",Text
"a a"), (Text
"b",Text
"b b")]
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"posting dates" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing)
Text
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
Posting
nullposting{
paccount :: Text
paccount=Text
"a"
,pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (DecimalRaw Year -> Amount
num DecimalRaw Year
1)
,pcomment :: Text
pcomment=Text
"date:2012/11/28, date2=2012/11/29,b:b\n"
,ptags :: [Tag]
ptags=[(Text
"date", Text
"2012/11/28"), (Text
"date2=2012/11/29,b", Text
"b")]
,pdate :: Maybe Day
pdate=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
11 Int
28
,pdate2 :: Maybe Day
pdate2=forall a. Maybe a
Nothing
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"posting dates bracket syntax" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing)
Text
" a 1. ; [2012/11/28=2012/11/29]\n"
Posting
nullposting{
paccount :: Text
paccount=Text
"a"
,pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (DecimalRaw Year -> Amount
num DecimalRaw Year
1)
,pcomment :: Text
pcomment=Text
"[2012/11/28=2012/11/29]\n"
,ptags :: [Tag]
ptags=[]
,pdate :: Maybe Day
pdate= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
11 Int
28
,pdate2 :: Maybe Day
pdate2=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
11 Int
29
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"quoted commodity symbol with digits" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1 \"DE123\"\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"only lot price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A {1B}\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"fixed lot price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A {=1B}\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"total lot price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A {{1B}}\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"fixed total lot price, and spaces" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A {{ = 1B }}\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"lot price before transaction price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A {1B} @ 1B\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"lot price after transaction price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A @ 1B {1B}\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"lot price after balance assertion not allowed" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A @ 1B = 1A {1B}\n" [Char]
"unexpected '{'"
,[Char] -> Assertion -> TestTree
testCase [Char]
"only lot date" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A [2000-01-01]\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"transaction price, lot price, lot date" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A @ 1B {1B} [2000-01-01]\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"lot date, lot price, transaction price" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a 1A [2000-01-01] {1B} @ 1B\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"balance assertion over entire contents of account" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse (forall (m :: * -> *). Maybe Year -> JournalParser m Posting
postingp forall a. Maybe a
Nothing) Text
" a $1 == $1\n"
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"transactionmodifierp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"basic" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m TransactionModifier
transactionmodifierp
Text
"= (some value expr)\n some:postings 1.\n"
TransactionModifier
nulltransactionmodifier {
tmquerytxt :: Text
tmquerytxt = Text
"(some value expr)"
,tmpostingrules :: [TMPostingRule]
tmpostingrules = [Posting -> Bool -> TMPostingRule
TMPostingRule Posting
nullposting{paccount :: Text
paccount=Text
"some:postings", pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (DecimalRaw Year -> Amount
num DecimalRaw Year
1)} Bool
False]
}
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"transactionp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"just a date" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Transaction
transactionp Text
"2015/1/1\n" Transaction
nulltransaction{tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2015 Int
1 Int
1}
,[Char] -> Assertion -> TestTree
testCase [Char]
"more complex" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Transaction
transactionp
([Text] -> Text
T.unlines [
Text
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
Text
" ; tcomment2",
Text
" ; ttag1: val1",
Text
" * a $1.00 ; pcomment1",
Text
" ; pcomment2",
Text
" ; ptag1: val1",
Text
" ; ptag2: val2"
])
Transaction
nulltransaction{
tsourcepos :: (SourcePos, SourcePos)
tsourcepos=([Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), [Char] -> Pos -> Pos -> SourcePos
SourcePos [Char]
"" (Int -> Pos
mkPos Int
8) (Int -> Pos
mkPos Int
1)),
tprecedingcomment :: Text
tprecedingcomment=Text
"",
tdate :: Day
tdate=Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
5 Int
14,
tdate2 :: Maybe Day
tdate2=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
5 Int
15,
tstatus :: Status
tstatus=Status
Unmarked,
tcode :: Text
tcode=Text
"code",
tdescription :: Text
tdescription=Text
"desc",
tcomment :: Text
tcomment=Text
"tcomment1\ntcomment2\nttag1: val1\n",
ttags :: [Tag]
ttags=[(Text
"ttag1",Text
"val1")],
tpostings :: [Posting]
tpostings=[
Posting
nullposting{
pdate :: Maybe Day
pdate=forall a. Maybe a
Nothing,
pstatus :: Status
pstatus=Status
Cleared,
paccount :: Text
paccount=Text
"a",
pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (DecimalRaw Year -> Amount
usd DecimalRaw Year
1),
pcomment :: Text
pcomment=Text
"pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
ptype :: PostingType
ptype=PostingType
RegularPosting,
ptags :: [Tag]
ptags=[(Text
"ptag1",Text
"val1"),(Text
"ptag2",Text
"val2")],
ptransaction :: Maybe Transaction
ptransaction=forall a. Maybe a
Nothing
}
]
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"parses a well-formed transaction" forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp forall (m :: * -> *). JournalParser m Transaction
transactionp forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"2007/01/28 coopportunity"
,Text
" expenses:food:groceries $47.18"
,Text
" assets:checking $-47.18"
,Text
""
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"does not parse a following comment as part of the description" forall a b. (a -> b) -> a -> b
$
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn forall (m :: * -> *). JournalParser m Transaction
transactionp Text
"2009/1/1 a ;comment\n b 1\n" Transaction -> Text
tdescription Text
"a"
,[Char] -> Assertion -> TestTree
testCase [Char]
"parses a following whitespace line" forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp forall (m :: * -> *). JournalParser m Transaction
transactionp forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"2012/1/1"
,Text
" a 1"
,Text
" b"
,Text
" "
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"parses an empty transaction comment following whitespace line" forall a b. (a -> b) -> a -> b
$
HasCallStack => [Char] -> Bool -> Assertion
assertBool [Char]
"" forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
JournalParser m a -> Text -> m (Either HledgerParseErrors a)
rjp forall (m :: * -> *). JournalParser m Transaction
transactionp forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[Text
"2012/1/1"
,Text
" ;"
,Text
" a 1"
,Text
" b"
,Text
" "
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"comments everywhere, two postings parsed" forall a b. (a -> b) -> a -> b
$
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn forall (m :: * -> *). JournalParser m Transaction
transactionp
([Text] -> Text
T.unlines
[Text
"2009/1/1 x ; transaction comment"
,Text
" a 1 ; posting 1 comment"
,Text
" ; posting 1 comment 2"
,Text
" b"
,Text
" ; posting 2 comment"
])
(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings)
Int
2
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"directivep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"supports !" forall a b. (a -> b) -> a -> b
$ do
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
a
-> Text -> Assertion
assertParseE forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!account a\n"
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
a
-> Text -> Assertion
assertParseE forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
directivep Text
"!D 1.0\n"
]
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"accountdirectivep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"with-comment" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b ; a comment\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"does-not-support-!" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"!account a:b\n" [Char]
""
,[Char] -> Assertion -> TestTree
testCase [Char]
"account-type-code" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b ; type:A\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"account-type-tag" forall a b. (a -> b) -> a -> b
$ forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> (st -> b) -> b -> Assertion
assertParseStateOn forall (m :: * -> *). JournalParser m ()
accountdirectivep Text
"account a:b ; type:asset\n"
Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts
[(Text
"a:b", AccountDeclarationInfo{adicomment :: Text
adicomment = Text
"type:asset\n"
,aditags :: [Tag]
aditags = [(Text
"type",Text
"asset")]
,adideclarationorder :: Int
adideclarationorder = Int
1
,adisourcepos :: SourcePos
adisourcepos = forall a b. (a, b) -> a
fst (SourcePos, SourcePos)
nullsourcepos
})
]
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"commodityconversiondirectivep" forall a b. (a -> b) -> a -> b
$ do
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
commodityconversiondirectivep Text
"C 1h = $50.00\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"defaultcommoditydirectivep" forall a b. (a -> b) -> a -> b
$ do
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep Text
"D $1,000.0\n"
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError forall (m :: * -> *). JournalParser m ()
defaultcommoditydirectivep Text
"D $1000\n" [Char]
"Please include a decimal point or decimal comma"
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"defaultyeardirectivep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"1000" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep Text
"Y 1000"
,[Char] -> Assertion -> TestTree
testCase [Char]
"12345" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
defaultyeardirectivep Text
"Y 12345"
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"ignoredpricecommoditydirectivep" forall a b. (a -> b) -> a -> b
$ do
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
ignoredpricecommoditydirectivep Text
"N $\n"
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"includedirectivep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"include" forall a b. (a -> b) -> a -> b
$ forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
a
-> Text -> [Char] -> Assertion
assertParseErrorE forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep Text
"include nosuchfile\n" [Char]
"No existing files match pattern: nosuchfile"
,[Char] -> Assertion -> TestTree
testCase [Char]
"glob" forall a b. (a -> b) -> a -> b
$ forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
a
-> Text -> [Char] -> Assertion
assertParseErrorE forall (m :: * -> *). MonadIO m => ErroringJournalParser m ()
includedirectivep Text
"include nosuchfile*\n" [Char]
"No existing files match pattern: nosuchfile*"
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"marketpricedirectivep" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m PriceDirective
marketpricedirectivep
Text
"P 2017/01/30 BTC $922.83\n"
PriceDirective{
pddate :: Day
pddate = Year -> Int -> Int -> Day
fromGregorian Year
2017 Int
1 Int
30,
pdcommodity :: Text
pdcommodity = Text
"BTC",
pdamount :: Amount
pdamount = DecimalRaw Year -> Amount
usd DecimalRaw Year
922.83
}
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"payeedirectivep" [
[Char] -> Assertion -> TestTree
testCase [Char]
"simple" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo\n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"with-comment" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
payeedirectivep Text
"payee foo ; comment\n"
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"tagdirectivep" forall a b. (a -> b) -> a -> b
$ do
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
tagdirectivep Text
"tag foo \n"
,[Char] -> Assertion -> TestTree
testCase [Char]
"endtagdirectivep" forall a b. (a -> b) -> a -> b
$ do
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
endtagdirectivep Text
"end tag \n"
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m ()
endtagdirectivep Text
"end apply tag \n"
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"journalp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"empty file" forall a b. (a -> b) -> a -> b
$ forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT
st
(ParsecT HledgerParseErrorData Text (ExceptT FinalParseError IO))
a
-> Text -> a -> Assertion
assertParseEqE forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp Text
"" Journal
nulljournal
]
,[Char] -> Assertion -> TestTree
testCase [Char]
"parseAndFinaliseJournal" forall a b. (a -> b) -> a -> b
$ do
Either [Char] Journal
ej <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal forall (m :: * -> *). MonadIO m => ErroringJournalParser m Journal
journalp InputOpts
definputopts [Char]
"" Text
"2019-1-1\n"
let Right Journal
j = Either [Char] Journal
ej
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"" [[Char]
""] forall a b. (a -> b) -> a -> b
$ Journal -> [[Char]]
journalFilePaths Journal
j
]