{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Hledger.Read.JournalReader (
findReader,
splitReaderPrefix,
reader,
genericSourcePos,
parseAndFinaliseJournal,
runJournalParser,
rjp,
getParentAccount,
journalp,
directivep,
defaultyeardirectivep,
marketpricedirectivep,
datetimep,
datep,
modifiedaccountnamep,
postingp,
statusp,
emptyorcommentlinep,
followingcommentp,
accountaliasp
,tests_JournalReader
)
where
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import qualified Control.Exception as C
import Control.Monad (forM_, when, void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.State.Strict (get,modify',put)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower)
import Data.Either (isRight)
import qualified Data.Map.Strict as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
import Data.String
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Safe
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
import Text.Printf
import System.FilePath
import "Glob" System.FilePath.Glob hiding (match)
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils
import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
import qualified Hledger.Read.CsvReader as CsvReader (reader)
readers' :: MonadIO m => [Reader m]
readers' = [
reader
,TimeclockReader.reader
,TimedotReader.reader
,CsvReader.reader
]
readerNames :: [String]
readerNames = map rFormat (readers'::[Reader IO])
findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m)
findReader Nothing Nothing = Nothing
findReader (Just fmt) _ = headMay [r | r <- readers', rFormat r == fmt]
findReader Nothing (Just path) =
case prefix of
Just fmt -> headMay [r | r <- readers', rFormat r == fmt]
Nothing -> headMay [r | r <- readers', ext `elem` rExtensions r]
where
(prefix,path') = splitReaderPrefix path
ext = map toLower $ drop 1 $ takeExtension path'
type PrefixedFilePath = FilePath
splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
splitReaderPrefix f =
headDef (Nothing, f)
[(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]
reader :: MonadIO m => Reader m
reader = Reader
{rFormat = "journal"
,rExtensions = ["journal", "j", "hledger", "ledger"]
,rReadFn = parse
,rParser = journalp
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse iopts = parseAndFinaliseJournal journalp' iopts
where
journalp' = do
mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts)
journalp
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a)
. aliases_
journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
journalp = do
many addJournalItemP
eof
get
addJournalItemP :: MonadIO m => ErroringJournalParser m ()
addJournalItemP =
choice [
directivep
, transactionp >>= modify' . addTransaction
, transactionmodifierp >>= modify' . addTransactionModifier
, periodictransactionp >>= modify' . addPeriodicTransaction
, marketpricedirectivep >>= modify' . addPriceDirective
, void (lift emptyorcommentlinep)
, void (lift multilinecommentp)
] <?> "transaction or directive"
directivep :: MonadIO m => ErroringJournalParser m ()
directivep = (do
optional $ char '!'
choice [
includedirectivep
,aliasdirectivep
,endaliasesdirectivep
,accountdirectivep
,applyaccountdirectivep
,commoditydirectivep
,endapplyaccountdirectivep
,tagdirectivep
,endtagdirectivep
,defaultyeardirectivep
,defaultcommoditydirectivep
,commodityconversiondirectivep
,ignoredpricecommoditydirectivep
]
) <?> "directive"
includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep = do
string "include"
lift skipNonNewlineSpaces1
prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n')
parentoff <- getOffset
parentpos <- getSourcePos
let (mprefix,glob) = splitReaderPrefix prefixedglob
paths <- getFilePaths parentoff parentpos glob
let prefixedpaths = case mprefix of
Nothing -> paths
Just fmt -> map ((fmt++":")++) paths
forM_ prefixedpaths $ parseChild parentpos
void newline
where
getFilePaths
:: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
getFilePaths parseroff parserpos filename = do
let curdir = takeDirectory (sourceName parserpos)
filename' <- lift $ expandHomePath filename
`orRethrowIOError` (show parserpos ++ " locating " ++ filename)
fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of
Right x -> pure x
Left e -> customFailure $
parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
filepaths <- liftIO $ sort <$> globDir1 fileglob curdir
if (not . null) filepaths
then pure filepaths
else customFailure $ parseErrorAt parseroff $
"No existing files match pattern: " ++ filename
parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()
parseChild parentpos prefixedpath = do
let (_mprefix,filepath) = splitReaderPrefix prefixedpath
parentj <- get
let parentfilestack = jincludefilestack parentj
when (filepath `elem` parentfilestack) $
Fail.fail ("Cyclic include: " ++ filepath)
childInput <- lift $ readFilePortably filepath
`orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
let initChildj = newJournalWithParseStateFrom filepath parentj
let r = fromMaybe reader $ findReader Nothing (Just prefixedpath)
parser = rParser r
dbg6IO "trying reader" (rFormat r)
updatedChildj <- journalAddFile (filepath, childInput) <$>
parseIncludeFile parser initChildj filepath childInput
put $ updatedChildj <> parentj
newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
newJournalWithParseStateFrom filepath j = nulljournal{
jparsedefaultyear = jparsedefaultyear j
,jparsedefaultcommodity = jparsedefaultcommodity j
,jparseparentaccounts = jparseparentaccounts j
,jparsealiases = jparsealiases j
,jcommodities = jcommodities j
,jparsetimeclockentries = jparsetimeclockentries j
,jincludefilestack = filepath : jincludefilestack j
}
orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
orRethrowIOError io msg = do
eResult <- liftIO $ (Right <$> io) `C.catch` \(e::C.IOException) -> pure $ Left $ printf "%s:\n%s" msg (show e)
case eResult of
Right res -> pure res
Left errMsg -> Fail.fail errMsg
accountdirectivep :: JournalParser m ()
accountdirectivep = do
off <- getOffset
string "account"
lift skipNonNewlineSpaces1
acct <- modifiedaccountnamep
mtypecode :: Maybe Char <- lift $ optional $ try $ do
skipNonNewlineSpaces1
choice $ map char "ALERX"
(cmt, tags) <- lift transactioncommentp
skipMany indentedlinep
let
mtypecode' :: Maybe Text = maybe
(T.singleton <$> mtypecode)
Just
$ lookup accountTypeTagName tags
metype = parseAccountTypeCode <$> mtypecode'
addAccountDeclaration (acct, cmt, tags)
case metype of
Nothing -> return ()
Just (Right t) -> addDeclaredAccountType acct t
Just (Left err) -> customFailure $ parseErrorAt off err
accountTypeTagName = "type"
parseAccountTypeCode :: Text -> Either String AccountType
parseAccountTypeCode s =
case T.toLower s of
"asset" -> Right Asset
"a" -> Right Asset
"liability" -> Right Liability
"l" -> Right Liability
"equity" -> Right Equity
"e" -> Right Equity
"revenue" -> Right Revenue
"r" -> Right Revenue
"expense" -> Right Expense
"x" -> Right Expense
"cash" -> Right Cash
"c" -> Right Cash
_ -> Left err
where
err = "invalid account type code "++T.unpack s++", should be one of " ++
(intercalate ", " $ ["A","L","E","R","X","C","Asset","Liability","Equity","Revenue","Expense","Cash"])
addAccountDeclaration :: (AccountName,Text,[Tag]) -> JournalParser m ()
addAccountDeclaration (a,cmt,tags) =
modify' (\j ->
let
decls = jdeclaredaccounts j
d = (a, nullaccountdeclarationinfo{
adicomment = cmt
,aditags = tags
,adideclarationorder = length decls + 1
})
in
j{jdeclaredaccounts = d:decls})
indentedlinep :: JournalParser m String
indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline)
commoditydirectivep :: JournalParser m ()
commoditydirectivep = commoditydirectiveonelinep <|> commoditydirectivemultilinep
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep = do
(off, Amount{acommodity,astyle}) <- try $ do
string "commodity"
lift skipNonNewlineSpaces1
off <- getOffset
amount <- amountp
pure $ (off, amount)
lift skipNonNewlineSpaces
_ <- lift followingcommentp
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle}
if asdecimalpoint astyle == Nothing
then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
pleaseincludedecimalpoint :: String
pleaseincludedecimalpoint = chomp $ unlines [
"Please include a decimal point or decimal comma in commodity directives,"
,"to help us parse correctly. It may be followed by zero or more decimal digits."
,"Examples:"
,"commodity $1000. ; no thousands mark, decimal period, no decimals"
,"commodity 1.234,00 ARS ; period at thousands, decimal comma, 2 decimals"
,"commodity EUR 1 000,000 ; space at thousands, decimal comma, 3 decimals"
,"commodity INR1,23,45,678.0 ; comma at thousands/lakhs/crores, decimal period, 1 decimal"
]
commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep = do
string "commodity"
lift skipNonNewlineSpaces1
sym <- lift commoditysymbolp
_ <- lift followingcommentp
mformat <- lastMay <$> many (indented $ formatdirectivep sym)
let comm = Commodity{csymbol=sym, cformat=mformat}
modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
where
indented = (lift skipNonNewlineSpaces1 >>)
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep expectedsym = do
string "format"
lift skipNonNewlineSpaces1
off <- getOffset
Amount{acommodity,astyle} <- amountp
_ <- lift followingcommentp
if acommodity==expectedsym
then
if asdecimalpoint astyle == Nothing
then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else return $ dbg6 "style from format subdirective" astyle
else customFailure $ parseErrorAt off $
printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
keywordp :: String -> JournalParser m ()
keywordp = (() <$) . string . fromString
spacesp :: JournalParser m ()
spacesp = () <$ lift skipNonNewlineSpaces1
keywordsp :: String -> JournalParser m ()
keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words
applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep = do
keywordsp "apply account" <?> "apply account directive"
lift skipNonNewlineSpaces1
parent <- lift accountnamep
newline
pushParentAccount parent
endapplyaccountdirectivep :: JournalParser m ()
endapplyaccountdirectivep = do
keywordsp "end apply account" <?> "end apply account directive"
popParentAccount
aliasdirectivep :: JournalParser m ()
aliasdirectivep = do
string "alias"
lift skipNonNewlineSpaces1
alias <- lift accountaliasp
addAccountAlias alias
accountaliasp :: TextParser m AccountAlias
accountaliasp = regexaliasp <|> basicaliasp
basicaliasp :: TextParser m AccountAlias
basicaliasp = do
old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
char '='
skipNonNewlineSpaces
new <- rstrip <$> anySingle `manyTill` eolof
return $ BasicAlias (T.pack old) (T.pack new)
regexaliasp :: TextParser m AccountAlias
regexaliasp = do
char '/'
off1 <- getOffset
re <- some $ noneOf ("/\n\r" :: [Char])
off2 <- getOffset
char '/'
skipNonNewlineSpaces
char '='
skipNonNewlineSpaces
repl <- anySingle `manyTill` eolof
case toRegexCI re of
Right r -> return $! RegexAlias r repl
Left e -> customFailure $! parseErrorAtRegion off1 off2 e
endaliasesdirectivep :: JournalParser m ()
endaliasesdirectivep = do
keywordsp "end aliases" <?> "end aliases directive"
clearAccountAliases
tagdirectivep :: JournalParser m ()
tagdirectivep = do
string "tag" <?> "tag directive"
lift skipNonNewlineSpaces1
_ <- lift $ some nonspace
lift restofline
return ()
endtagdirectivep :: JournalParser m ()
endtagdirectivep = do
(keywordsp "end tag" <|> keywordp "pop") <?> "end tag or pop directive"
lift restofline
return ()
defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep = do
char 'Y' <?> "default year"
lift skipNonNewlineSpaces
setYear =<< lift yearp
defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep = do
char 'D' <?> "default commodity"
lift skipNonNewlineSpaces1
off <- getOffset
Amount{acommodity,astyle} <- amountp
lift restofline
if asdecimalpoint astyle == Nothing
then customFailure $ parseErrorAt off pleaseincludedecimalpoint
else setDefaultCommodityAndStyle (acommodity, astyle)
marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep = do
char 'P' <?> "market price"
lift skipNonNewlineSpaces
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep
lift skipNonNewlineSpaces1
symbol <- lift commoditysymbolp
lift skipNonNewlineSpaces
price <- amountp
lift restofline
return $ PriceDirective date symbol price
ignoredpricecommoditydirectivep :: JournalParser m ()
ignoredpricecommoditydirectivep = do
char 'N' <?> "ignored-price commodity"
lift skipNonNewlineSpaces1
lift commoditysymbolp
lift restofline
return ()
commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep = do
char 'C' <?> "commodity conversion"
lift skipNonNewlineSpaces1
amountp
lift skipNonNewlineSpaces
char '='
lift skipNonNewlineSpaces
amountp
lift restofline
return ()
transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp = do
char '=' <?> "modifier transaction"
lift skipNonNewlineSpaces
querytxt <- lift $ T.strip <$> descriptionp
(_comment, _tags) <- lift transactioncommentp
postings <- postingsp Nothing
return $ TransactionModifier querytxt postings
periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction
periodictransactionp = do
char '~' <?> "periodic transaction"
lift $ skipNonNewlineSpaces
off <- getOffset
today <- liftIO getCurrentDay
mdefaultyear <- getYear
let refdate = case mdefaultyear of
Nothing -> today
Just y -> fromGregorian y 1 1
periodExcerpt <- lift $ excerpt_ $
singlespacedtextsatisfyingp (\c -> c /= ';' && c /= '\n')
let periodtxt = T.strip $ getExcerptText periodExcerpt
(interval, span) <- lift $ reparseExcerpt periodExcerpt $ do
pexp <- periodexprp refdate
(<|>) eof $ do
offset1 <- getOffset
void takeRest
offset2 <- getOffset
customFailure $ parseErrorAtRegion offset1 offset2 $
"remainder of period expression cannot be parsed"
<> "\nperhaps you need to terminate the period expression with a double space?"
<> "\na double space is required between period expression and description/comment"
pure pexp
case checkPeriodicTransactionStartDate interval span periodtxt of
Just e -> customFailure $ parseErrorAt off e
Nothing -> pure ()
status <- lift statusp <?> "cleared status"
code <- lift codep <?> "transaction code"
description <- lift $ T.strip <$> descriptionp
(comment, tags) <- lift transactioncommentp
postings <- postingsp (Just $ first3 $ toGregorian refdate)
return $ nullperiodictransaction{
ptperiodexpr=periodtxt
,ptinterval=interval
,ptspan=span
,ptstatus=status
,ptcode=code
,ptdescription=description
,ptcomment=comment
,pttags=tags
,ptpostings=postings
}
transactionp :: JournalParser m Transaction
transactionp = do
startpos <- getSourcePos
date <- datep <?> "transaction"
edate <- optional (lift $ secondarydatep date) <?> "secondary date"
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
status <- lift statusp <?> "cleared status"
code <- lift codep <?> "transaction code"
description <- lift $ T.strip <$> descriptionp
(comment, tags) <- lift transactioncommentp
let year = first3 $ toGregorian date
postings <- postingsp (Just year)
endpos <- getSourcePos
let sourcepos = journalSourcePos startpos endpos
return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings
postingsp :: Maybe Year -> JournalParser m [Posting]
postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings"
postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear = do
(status, account) <- try $ do
lift skipNonNewlineSpaces1
status <- lift statusp
lift skipNonNewlineSpaces
account <- modifiedaccountnamep
return (status, account)
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
lift skipNonNewlineSpaces
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
lift skipNonNewlineSpaces
massertion <- optional balanceassertionp
lift skipNonNewlineSpaces
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
return posting
{ pdate=mdate
, pdate2=mdate2
, pstatus=status
, paccount=account'
, pamount=amount
, pcomment=comment
, ptype=ptype
, ptags=tags
, pbalanceassertion=massertion
}
tests_JournalReader = tests "JournalReader" [
let p = lift accountnamep :: JournalParser IO AccountName in
tests "accountnamep" [
test "basic" $ assertParse p "a:b:c"
]
,tests "datep" [
test "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
,test "YYYY-MM-DD" $ assertParse datep "2018-01-01"
,test "YYYY.MM.DD" $ assertParse datep "2018.01.01"
,test "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown"
,test "yearless date with default year" $ do
let s = "1/1"
ep <- parseWithState nulljournal{jparsedefaultyear=Just 2018} datep s
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
,test "no leading zero" $ assertParse datep "2018/1/1"
]
,test "datetimep" $ do
let
good = assertParse datetimep
bad = (\t -> assertParseError datetimep t "")
good "2011/1/1 00:00"
good "2011/1/1 23:59:59"
bad "2011/1/1"
bad "2011/1/1 24:00:00"
bad "2011/1/1 00:60:00"
bad "2011/1/1 00:00:60"
bad "2011/1/1 3:5:7"
let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 0)
assertParseEq datetimep "2018/1/1 00:00-0800" t
assertParseEq datetimep "2018/1/1 00:00+1234" t
,tests "periodictransactionp" [
test "more period text in comment after one space" $ assertParseEq periodictransactionp
"~ monthly from 2018/6 ;In 2019 we will change this\n"
nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6"
,ptinterval = Months 1
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
,ptdescription = ""
,ptcomment = "In 2019 we will change this\n"
}
,test "more period text in description after two spaces" $ assertParseEq periodictransactionp
"~ monthly from 2018/6 In 2019 we will change this\n"
nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6"
,ptinterval = Months 1
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
,ptdescription = "In 2019 we will change this"
,ptcomment = ""
}
,test "Next year in description" $ assertParseEq periodictransactionp
"~ monthly Next year blah blah\n"
nullperiodictransaction {
ptperiodexpr = "monthly"
,ptinterval = Months 1
,ptspan = DateSpan Nothing Nothing
,ptdescription = "Next year blah blah"
,ptcomment = ""
}
,test "Just date, no description" $ assertParseEq periodictransactionp
"~ 2019-01-04\n"
nullperiodictransaction {
ptperiodexpr = "2019-01-04"
,ptinterval = NoInterval
,ptspan = DateSpan (Just $ fromGregorian 2019 1 4) (Just $ fromGregorian 2019 1 5)
,ptdescription = ""
,ptcomment = ""
}
,test "Just date, no description + empty transaction comment" $ assertParse periodictransactionp
"~ 2019-01-04\n ;\n a 1\n b\n"
]
,tests "postingp" [
test "basic" $ assertParseEq (postingp Nothing)
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
posting{
paccount="expenses:food:dining",
pamount=Mixed [usd 10],
pcomment="a: a a\nb: b b\n",
ptags=[("a","a a"), ("b","b b")]
}
,test "posting dates" $ assertParseEq (postingp Nothing)
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
nullposting{
paccount="a"
,pamount=Mixed [num 1]
,pcomment="date:2012/11/28, date2=2012/11/29,b:b\n"
,ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")]
,pdate=Just $ fromGregorian 2012 11 28
,pdate2=Nothing
}
,test "posting dates bracket syntax" $ assertParseEq (postingp Nothing)
" a 1. ; [2012/11/28=2012/11/29]\n"
nullposting{
paccount="a"
,pamount=Mixed [num 1]
,pcomment="[2012/11/28=2012/11/29]\n"
,ptags=[]
,pdate= Just $ fromGregorian 2012 11 28
,pdate2=Just $ fromGregorian 2012 11 29
}
,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n"
,test "only lot price" $ assertParse (postingp Nothing) " a 1A {1B}\n"
,test "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n"
,test "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n"
,test "fixed total lot price, and spaces" $ assertParse (postingp Nothing) " a 1A {{ = 1B }}\n"
,test "lot price before transaction price" $ assertParse (postingp Nothing) " a 1A {1B} @ 1B\n"
,test "lot price after transaction price" $ assertParse (postingp Nothing) " a 1A @ 1B {1B}\n"
,test "lot price after balance assertion not allowed" $ assertParseError (postingp Nothing) " a 1A @ 1B = 1A {1B}\n" "unexpected '{'"
,test "only lot date" $ assertParse (postingp Nothing) " a 1A [2000-01-01]\n"
,test "transaction price, lot price, lot date" $ assertParse (postingp Nothing) " a 1A @ 1B {1B} [2000-01-01]\n"
,test "lot date, lot price, transaction price" $ assertParse (postingp Nothing) " a 1A [2000-01-01] {1B} @ 1B\n"
,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n"
]
,tests "transactionmodifierp" [
test "basic" $ assertParseEq transactionmodifierp
"= (some value expr)\n some:postings 1.\n"
nulltransactionmodifier {
tmquerytxt = "(some value expr)"
,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}]
}
]
,tests "transactionp" [
test "just a date" $ assertParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1}
,test "more complex" $ assertParseEq transactionp
(T.unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
" ; ttag1: val1",
" * a $1.00 ; pcomment1",
" ; pcomment2",
" ; ptag1: val1",
" ; ptag2: val2"
])
nulltransaction{
tsourcepos=JournalSourcePos "" (1,7),
tprecedingcomment="",
tdate=fromGregorian 2012 5 14,
tdate2=Just $ fromGregorian 2012 5 15,
tstatus=Unmarked,
tcode="code",
tdescription="desc",
tcomment="tcomment1\ntcomment2\nttag1: val1\n",
ttags=[("ttag1","val1")],
tpostings=[
nullposting{
pdate=Nothing,
pstatus=Cleared,
paccount="a",
pamount=Mixed [usd 1],
pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
ptype=RegularPosting,
ptags=[("ptag1","val1"),("ptag2","val2")],
ptransaction=Nothing
}
]
}
,test "parses a well-formed transaction" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking $-47.18"
,""
]
,test "does not parse a following comment as part of the description" $
assertParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a"
,test "parses a following whitespace line" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1"
," a 1"
," b"
," "
]
,test "parses an empty transaction comment following whitespace line" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1"
," ;"
," a 1"
," b"
," "
]
,test "comments everywhere, two postings parsed" $
assertParseEqOn transactionp
(T.unlines
["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment"
," ; posting 1 comment 2"
," b"
," ; posting 2 comment"
])
(length . tpostings)
2
]
,tests "directivep" [
test "supports !" $ do
assertParseE directivep "!account a\n"
assertParseE directivep "!D 1.0\n"
]
,tests "accountdirectivep" [
test "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n"
,test "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" ""
,test "account-type-code" $ assertParse accountdirectivep "account a:b A\n"
,test "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")]
,adideclarationorder = 1
})
]
]
,test "commodityconversiondirectivep" $ do
assertParse commodityconversiondirectivep "C 1h = $50.00\n"
,test "defaultcommoditydirectivep" $ do
assertParse defaultcommoditydirectivep "D $1,000.0\n"
assertParseError defaultcommoditydirectivep "D $1000\n" "Please include a decimal point or decimal comma"
,tests "defaultyeardirectivep" [
test "1000" $ assertParse defaultyeardirectivep "Y 1000"
,test "12345" $ assertParse defaultyeardirectivep "Y 12345"
]
,test "ignoredpricecommoditydirectivep" $ do
assertParse ignoredpricecommoditydirectivep "N $\n"
,tests "includedirectivep" [
test "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
,test "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
]
,test "marketpricedirectivep" $ assertParseEq marketpricedirectivep
"P 2017/01/30 BTC $922.83\n"
PriceDirective{
pddate = fromGregorian 2017 1 30,
pdcommodity = "BTC",
pdamount = usd 922.83
}
,test "tagdirectivep" $ do
assertParse tagdirectivep "tag foo \n"
,test "endtagdirectivep" $ do
assertParse endtagdirectivep "end tag \n"
assertParse endtagdirectivep "pop \n"
,tests "journalp" [
test "empty file" $ assertParseEqE journalp "" nulljournal
]
,test "parseAndFinaliseJournal" $ do
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
let Right j = ej
assertEqual "" [""] $ journalFilePaths j
]