journal: when an account alias contains a bad regexp, show details

lib: accountNameApplyAliases, accountNameApplyAliasesMemo are now
total

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
+-- Or, return any error arising from a bad regular expression in the aliases.
-accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
+accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName
-  where
+accountNameApplyAliases aliases a =
-    (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
+  let (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)
-    aname' = foldl
+  in foldM
-             (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))
+     (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))
-             aname
+     aname
-             aliases
+     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
+  | old `isAccountNamePrefixOf` a || old == a =
-  | otherwise = a
+      Right $ new <> T.drop (T.length old) a
-aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX
+  | 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

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
+  -- off1    <- getOffset
-  return $!
+  a       <- lift accountnamep
-    accountNameApplyAliases aliases $
+  -- off2    <- getOffset
-     -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)
+  -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)
-    joinAccountNames parent
+  case accountNameApplyAliases aliases $ joinAccountNames parent a of
-    a
+    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,

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