diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index a101212c4..a82a220c7 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1228,9 +1228,12 @@ postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p -- | Apply some account aliases to all posting account names in the journal, as described by accountNameApplyAliases. --- This can raise an error arising from a bad replacement pattern in a regular expression alias. -journalApplyAliases :: [AccountAlias] -> Journal -> Journal -journalApplyAliases aliases j = j{jtxns = map (transactionApplyAliases aliases) $ jtxns j} -- PARTIAL: +-- This can fail due to a bad replacement pattern in a regular expression alias. +journalApplyAliases :: [AccountAlias] -> Journal -> Either RegexError Journal +journalApplyAliases aliases j = + case mapM (transactionApplyAliases aliases) $ jtxns j of + Right ts -> Right j{jtxns = ts} + Left err -> Left err -- -- | Build a database of market prices in effect on the given date, -- -- from the journal's price directives. diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index fd401e319..57a8ce7d9 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -291,14 +291,15 @@ concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map a where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as -- | Apply some account aliases to the posting's account name, as described by accountNameApplyAliases. --- This can raise an error arising from a bad replacement pattern in a regular expression alias. -postingApplyAliases :: [AccountAlias] -> Posting -> Posting +-- This can fail due to a bad replacement pattern in a regular expression alias. +postingApplyAliases :: [AccountAlias] -> Posting -> Either RegexError Posting postingApplyAliases aliases p@Posting{paccount} = case accountNameApplyAliases aliases paccount of - Right a -> p{paccount=a} - Left e -> error' err -- PARTIAL: + Right a -> Right p{paccount=a} + Left e -> Left err where - err = "problem in account aliases:\n" ++ pshow aliases ++ "\n applied to account name: "++T.unpack paccount++"\n "++e + err = "problem while applying account aliases:\n" ++ pshow aliases + ++ "\n to account name: "++T.unpack paccount++"\n "++e -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 4dc562104..e0b5b090e 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -593,10 +593,12 @@ transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transac transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps} -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. --- This can raise an error arising from a bad replacement pattern in a regular expression alias. -transactionApplyAliases :: [AccountAlias] -> Transaction -> Transaction +-- This can fail due to a bad replacement pattern in a regular expression alias. +transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction transactionApplyAliases aliases t = - txnTieKnot $ t{tpostings = map (postingApplyAliases aliases) $ tpostings t} -- PARTIAL: + case mapM (postingApplyAliases aliases) $ tpostings t of + Right ps -> Right $ txnTieKnot $ t{tpostings=ps} + Left err -> Left err -- tests diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 358c9c150..f192d1383 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -296,10 +296,11 @@ parseAndFinaliseJournal' parser iopts f txt = do -- see notes above case ep of Left e -> throwError $ customErrorBundlePretty e - Right pj -> journalFinalise iopts f txt $ - -- apply any command line account aliases. Can fail with a bad replacement pattern. - journalApplyAliases (aliasesFromOpts iopts) $ -- PARTIAL: - pj + Right pj -> + -- apply any command line account aliases. Can fail with a bad replacement pattern. + case journalApplyAliases (aliasesFromOpts iopts) pj of + Left e -> throwError e + Right pj' -> journalFinalise iopts f txt pj' -- | Post-process a Journal that has just been parsed or generated, in this order: -- diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index ab93a3ce8..6357a9ca0 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -108,15 +108,16 @@ parse iopts f t = do let rulesfile = mrules_file_ iopts r <- liftIO $ readJournalFromCsv rulesfile f t case r of Left e -> throwError e - Right pj -> journalFinalise iopts{ignore_assertions_=True} f t pj'' - where - -- journalFinalise assumes the journal's items are - -- reversed, as produced by JournalReader's parser. - -- But here they are already properly ordered. So we'd - -- better preemptively reverse them once more. XXX inefficient - pj' = journalReverse pj - -- apply any command line account aliases. Can fail with a bad replacement pattern. - pj'' = journalApplyAliases (aliasesFromOpts iopts) pj' -- PARTIAL: + Right pj -> + -- journalFinalise assumes the journal's items are + -- reversed, as produced by JournalReader's parser. + -- But here they are already properly ordered. So we'd + -- better preemptively reverse them once more. XXX inefficient + let pj' = journalReverse pj + -- apply any command line account aliases. Can fail with a bad replacement pattern. + in case journalApplyAliases (aliasesFromOpts iopts) pj' of + Left e -> throwError e + Right pj'' -> journalFinalise iopts{ignore_assertions_=True} f t pj'' --- ** reading rules files --- *** rules utilities diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index fe11df485..d96d72fba 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -147,7 +147,9 @@ toRegexCI' = either error' id . toRegexCI -- | A replacement pattern. May include numeric backreferences (\N). type Replacement = String --- | An regular expression compilation/processing error message. +-- | An error message arising during a regular expression operation. +-- Eg: trying to compile a malformed regular expression, or +-- trying to apply a malformed replacement pattern. type RegexError = String -- helpers