imp:print:beancount:convert account names more robustly; better errors

hledger-lib/Hledger/Data/AccountName.hs

@@ -74,7 +74,7 @@ import Text.DocLayout (realLength)
 
 import Hledger.Data.Types hiding (asubs)
 import Hledger.Utils
-import Data.Char (isDigit, isLetter)
+import Data.Char (isDigit, isLetter, isUpperCase)
 import Data.List (partition)
 
 -- $setup
@@ -362,44 +362,64 @@ accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- P
 type BeancountAccountName = AccountName
 type BeancountAccountNameComponent = AccountName
 
--- Convert a hledger account name to a valid Beancount account name.
+-- | Convert a hledger account name to a valid Beancount account name.
 -- It replaces non-supported characters with @-@ (warning: in extreme cases
--- separate accounts could end up with the same name), and it capitalises 
+-- separate accounts could end up with the same name), it prepends the letter B
--- each account name part. It also checks that the first part is one of 
+-- to any part which doesn't begin with a letter or number, and it capitalises
--- Assets, Liabilities, Equity, Income, or Expenses, and if not it raises an error.
+-- each part. It also checks that the first part is one of the required english
--- Account aliases (eg --alias) should be used to set these required
+-- account names Assets, Liabilities, Equity, Income, or Expenses, and if not
--- top-level account names if needed.
+-- it raises an informative error suggesting --alias.
+-- Ref: https://beancount.github.io/docs/beancount_language_syntax.html#accounts
 accountNameToBeancount :: AccountName -> BeancountAccountName
 accountNameToBeancount a =
-  -- https://beancount.github.io/docs/beancount_language_syntax.html#accounts
+  dbg9 "beancount account name" $
-  accountNameFromComponents $
+  accountNameFromComponents bs'
-  case map (accountNameComponentToBeancount a) $ accountNameComponents a of
+  where
-    c:_ | c `notElem` beancountTopLevelAccounts -> error' e
+    bs =
-      where
+      map accountNameComponentToBeancount $ accountNameComponents $
-        e = T.unpack $ T.unlines [
+      dbg9 "hledger account name  " $
-          beancountAccountErrorMessage a,
+      a
-          "For Beancount output, all top-level accounts must be (or be aliased to) one of",
+    bs' =
-          T.intercalate ", " beancountTopLevelAccounts <> "."
+      case bs of
-          ]
+        b:_ | b `notElem` beancountTopLevelAccounts -> error' e
-    cs -> cs
+          where
+            e = T.unpack $ T.unlines [
+              "bad top-level account: " <> b
+              ,"in beancount account name:           " <> accountNameFromComponents bs
+              ,"converted from hledger account name: " <> a
+              ,"For Beancount, top-level accounts must be (or be --alias'ed to)"
+              ,"one of " <> T.intercalate ", " beancountTopLevelAccounts <> "."
+              -- ,"and not: " <> b
+              ]
+        cs -> cs
 
-accountNameComponentToBeancount :: AccountName -> AccountName -> BeancountAccountNameComponent
+accountNameComponentToBeancount :: AccountName -> BeancountAccountNameComponent
-accountNameComponentToBeancount acct part =
+accountNameComponentToBeancount acctpart =
-  case T.uncons part of
+  prependStartCharIfNeeded $
-    Just (c,_) | not $ isLetter c -> error' e
+  case T.uncons acctpart of
-      where
+    Nothing -> ""
-        e = unlines [
+    Just (c,cs) ->
-          T.unpack $ beancountAccountErrorMessage acct,
+      textCapitalise $
-          "For Beancount output, each account name part must begin with a letter."
+      T.map (\d -> if isBeancountAccountChar d then d else '-') $ T.cons c cs
-          ]
+  where
-    _ -> textCapitalise part'
+    prependStartCharIfNeeded t =
-      where part' = T.map (\c -> if isBeancountAccountChar c then c else '-') part
+      case T.uncons t of
+        Just (c,_) | not $ isBeancountAccountStartChar c -> T.cons beancountAccountDummyStartChar t
+        _ -> t
 
-beancountAccountErrorMessage :: AccountName -> Text
+-- | Dummy valid starting character to prepend to Beancount account name parts if needed (B).
-beancountAccountErrorMessage a = "Could not convert \"" <> a <> "\" to a Beancount account name."
+beancountAccountDummyStartChar :: Char
+beancountAccountDummyStartChar = 'B'
 
+-- XXX these probably allow too much unicode:
+
+-- | Is this a valid character to start a Beancount account name part (capital letter or digit) ?
+isBeancountAccountStartChar :: Char -> Bool
+isBeancountAccountStartChar c = (isLetter c && isUpperCase c) || isDigit c
+
+-- | Is this a valid character to appear elsewhere in a Beancount account name part (letter, digit, or -) ?
 isBeancountAccountChar :: Char -> Bool
-isBeancountAccountChar c = c `elem` ("-:"::[Char]) || isLetter c || isDigit c
+isBeancountAccountChar c = isLetter c || isDigit c || c=='-'
 
 beancountTopLevelAccounts = ["Assets", "Liabilities", "Equity", "Income", "Expenses"]