diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 451509fa1..f1c96b3e1 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -68,6 +68,7 @@ module Hledger.Data.Posting ( ) where +import Control.Monad (foldM) import Data.Foldable (asum) import Data.List.Extra (nubSort) import qualified Data.Map as M @@ -289,17 +290,18 @@ concatAccountNames as = accountNameWithPostingType t $ T.intercalate ":" $ map a -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. -accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName -accountNameApplyAliases aliases a = accountNameWithPostingType atype aname' - where - (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) - aname' = foldl - (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) - aname - aliases +-- Or, return any error arising from a bad regular expression in the aliases. +accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName +accountNameApplyAliases aliases a = + let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a) + in foldM + (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct)) + aname + aliases + >>= Right . accountNameWithPostingType atype -- | Memoising version of accountNameApplyAliases, maybe overkill. -accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName +accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) -- XXX re-test this memoisation @@ -307,11 +309,13 @@ accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases) -- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a -- aliasMatches (RegexAlias re _) a = regexMatchesCI re a -aliasReplace :: AccountAlias -> AccountName -> AccountName +aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName aliasReplace (BasicAlias old new) a - | old `isAccountNamePrefixOf` a || old == a = new <> T.drop (T.length old) a - | otherwise = a -aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX + | old `isAccountNamePrefixOf` a || old == a = + Right $ new <> T.drop (T.length old) a + | otherwise = Right a +aliasReplace (RegexAlias re repl) a = + fmap T.pack $ regexReplaceCIMemo_ re repl $ T.unpack a -- XXX -- | Apply a specified valuation to this posting's amount, using the -- provided price oracle, commodity styles, reference dates, and diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 7029f5e46..485901d90 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -566,16 +566,23 @@ yearorintp = do -- | Parse an account name (plus one following space if present), -- then apply any parent account prefix and/or account aliases currently in effect, -- in that order. (Ie first add the parent account prefix, then rewrite with aliases). +-- This calls error if any account alias with an invalid regular expression exists. modifiedaccountnamep :: JournalParser m AccountName modifiedaccountnamep = do - parent <- getParentAccount + parent <- getParentAccount aliases <- getAccountAliases - a <- lift accountnamep - return $! - accountNameApplyAliases aliases $ - -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function) - joinAccountNames parent - a + -- off1 <- getOffset + a <- lift accountnamep + -- off2 <- getOffset + -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function) + case accountNameApplyAliases aliases $ joinAccountNames parent a of + Right a' -> return $! a' + -- should not happen, regexaliasp will have displayed a better error already: + -- (XXX why does customFailure cause error to be displayed there, but not here ?) + -- Left e -> customFailure $! parseErrorAtRegion off1 off2 err + Left e -> error' err -- PARTIAL: + where + err = "problem in account alias applied to "++T.unpack a++": "++e -- | Parse an account name, plus one following space if present. -- Account names have one or more parts separated by the account separator character, diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 5924ffabb..cb004393d 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -521,13 +521,17 @@ regexaliasp :: TextParser m AccountAlias regexaliasp = do -- dbgparse 0 "regexaliasp" char '/' + off1 <- getOffset re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end + off2 <- getOffset char '/' skipNonNewlineSpaces char '=' skipNonNewlineSpaces repl <- anySingle `manyTill` eolof - return $ RegexAlias re repl + case toRegex_ re of + Right _ -> return $! RegexAlias re repl + Left e -> customFailure $! parseErrorAtRegion off1 off2 e endaliasesdirectivep :: JournalParser m () endaliasesdirectivep = do