{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-|

'AccountName's are strings like @assets:cash:petty@, with multiple
components separated by ':'.  From a set of these we derive the account
hierarchy.

-}

module Hledger.Data.AccountName (
   accountLeafName
  ,accountNameComponents
  ,accountNameDrop
  ,accountNameFromComponents
  ,accountNameLevel
  ,accountNameToAccountOnlyRegex
  ,accountNameToAccountOnlyRegexCI
  ,accountNameToAccountRegex
  ,accountNameToAccountRegexCI
  ,accountNameTreeFrom
  ,accountSummarisedName
  ,accountNameInferType
  ,accountNameInferTypeExcept
  ,accountNameType
  ,defaultBaseConversionAccount
  ,assetAccountRegex
  ,cashAccountRegex
  ,liabilityAccountRegex
  ,equityAccountRegex
  ,conversionAccountRegex
  ,revenueAccountRegex
  ,expenseAccountRegex
  ,acctsep
  ,acctsepchar
  ,clipAccountName
  ,clipOrEllipsifyAccountName
  ,getAccountNameClippedDepth
  ,elideAccountName
  ,escapeName
  ,expandAccountName
  ,expandAccountNames
  ,isAccountNamePrefixOf
--  ,isAccountRegex
  ,isSubAccountNameOf
  ,parentAccountName
  ,parentAccountNames
  ,subAccountNamesFrom
  ,topAccountNames
  ,topAccountName
  ,unbudgetedAccountName
  ,accountNamePostingType
  ,accountNameWithoutPostingType
  ,accountNameWithPostingType
  ,joinAccountNames
  ,concatAccountNames
  ,accountNameApplyAliases
  ,accountNameApplyAliasesMemo
  ,tests_AccountName
)
where

import Control.Applicative ((<|>))
import Control.Monad (foldM)
import Data.Foldable (asum, find, toList)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Data.MemoUgly (memo)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tree (Tree(..), unfoldTree)
import Safe
import Text.DocLayout (realLength)

import Hledger.Data.Types hiding (asubs)
import Hledger.Utils
import Data.List (partition)

-- $setup
-- >>> :set -XOverloadedStrings

acctsepchar :: Char
acctsepchar :: Char
acctsepchar = Char
':'

acctsep :: Text
acctsep :: Text
acctsep = RegexError -> Text
T.pack [Char
acctsepchar]

-- The base conversion account name used by --infer-equity,
-- when no other account of type V/Conversion has been declared.
defaultBaseConversionAccount :: a
defaultBaseConversionAccount = a
"equity:conversion"

-- | Regular expressions matching common English top-level account names,
-- used as a fallback when account types are not declared.
assetAccountRegex :: Regexp
assetAccountRegex      = Text -> Regexp
toRegexCI' Text
"^assets?(:|$)"
cashAccountRegex :: Regexp
cashAccountRegex       = Text -> Regexp
toRegexCI' Text
"^assets?(:.+)?:(cash|bank|che(ck|que?)(ing)?|savings?|current)(:|$)"
liabilityAccountRegex :: Regexp
liabilityAccountRegex  = Text -> Regexp
toRegexCI' Text
"^(debts?|liabilit(y|ies))(:|$)"
equityAccountRegex :: Regexp
equityAccountRegex     = Text -> Regexp
toRegexCI' Text
"^equity(:|$)"
conversionAccountRegex :: Regexp
conversionAccountRegex = Text -> Regexp
toRegexCI' Text
"^equity:(trade|trades|trading|conversion)(:|$)"
revenueAccountRegex :: Regexp
revenueAccountRegex    = Text -> Regexp
toRegexCI' Text
"^(income|revenue)s?(:|$)"
expenseAccountRegex :: Regexp
expenseAccountRegex    = Text -> Regexp
toRegexCI' Text
"^expenses?(:|$)"

-- | Try to guess an account's type from its name,
-- matching common English top-level account names.
accountNameInferType :: AccountName -> Maybe AccountType
accountNameInferType :: Text -> Maybe AccountType
accountNameInferType Text
a
  | Regexp -> Text -> Bool
regexMatchText Regexp
cashAccountRegex       Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Cash
  | Regexp -> Text -> Bool
regexMatchText Regexp
assetAccountRegex      Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Asset
  | Regexp -> Text -> Bool
regexMatchText Regexp
liabilityAccountRegex  Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Liability
  | Regexp -> Text -> Bool
regexMatchText Regexp
conversionAccountRegex Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Conversion
  | Regexp -> Text -> Bool
regexMatchText Regexp
equityAccountRegex     Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Equity
  | Regexp -> Text -> Bool
regexMatchText Regexp
revenueAccountRegex    Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Revenue
  | Regexp -> Text -> Bool
regexMatchText Regexp
expenseAccountRegex    Text
a = AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Expense
  | Bool
otherwise                               = Maybe AccountType
forall a. Maybe a
Nothing

-- | Like accountNameInferType, but exclude the provided types from the guesses.
-- Used eg to prevent "equity:conversion" being inferred as Conversion when a different
-- account has been declared with that type.
accountNameInferTypeExcept :: [AccountType] -> AccountName -> Maybe AccountType
accountNameInferTypeExcept :: [AccountType] -> Text -> Maybe AccountType
accountNameInferTypeExcept [AccountType]
excludedtypes Text
a =
  case Text -> Maybe AccountType
accountNameInferType Text
a of
    Just AccountType
t | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AccountType
t AccountType -> [AccountType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountType]
excludedtypes -> AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
t
    Maybe AccountType
_ -> Maybe AccountType
forall a. Maybe a
Nothing

-- Extract the 'AccountType' of an 'AccountName' by looking it up in the
-- provided Map, traversing the parent accounts if necessary. If none of those
-- work, try 'accountNameInferType'.
accountNameType :: M.Map AccountName AccountType -> AccountName -> Maybe AccountType
accountNameType :: Map Text AccountType -> Text -> Maybe AccountType
accountNameType Map Text AccountType
atypes Text
a = [Maybe AccountType] -> Maybe AccountType
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Text -> Maybe AccountType) -> [Text] -> [Maybe AccountType]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Map Text AccountType -> Maybe AccountType
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text AccountType
atypes) ([Text] -> [Maybe AccountType]) -> [Text] -> [Maybe AccountType]
forall a b. (a -> b) -> a -> b
$ Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
parentAccountNames Text
a)
                         Maybe AccountType -> Maybe AccountType -> Maybe AccountType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe AccountType
accountNameInferType Text
a

-- accountNameComponents :: AccountName -> [String]
-- accountNameComponents = splitAtElement acctsepchar

accountNameComponents :: AccountName -> [Text]
accountNameComponents :: Text -> [Text]
accountNameComponents = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
acctsep

accountNameFromComponents :: [Text] -> AccountName
accountNameFromComponents :: [Text] -> Text
accountNameFromComponents = Text -> [Text] -> Text
T.intercalate Text
acctsep

accountLeafName :: AccountName -> Text
accountLeafName :: Text -> Text
accountLeafName = [Text] -> Text
forall a. HasCallStack => [a] -> a
last ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents

-- | Truncate all account name components but the last to two characters.
accountSummarisedName :: AccountName -> Text
accountSummarisedName :: Text -> Text
accountSummarisedName Text
a
  --   length cs > 1 = take 2 (head cs) ++ ":" ++ a'
  | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Text -> [Text] -> Text
T.intercalate Text
":" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take Int
2) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
cs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a'
  | Bool
otherwise     = Text
a'
    where
      cs :: [Text]
cs = Text -> [Text]
accountNameComponents Text
a
      a' :: Text
a' = Text -> Text
accountLeafName Text
a

-- | The level (depth) of an account name.
--
-- >>> accountNameLevel ""  -- special case
-- 0
-- >>> accountNameLevel "assets"
-- 1
-- >>> accountNameLevel "assets:cash"
-- 2
accountNameLevel :: AccountName -> Int
accountNameLevel :: Text -> Int
accountNameLevel Text
"" = Int
0
accountNameLevel Text
a = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
acctsepchar) Text
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | A top-level account prefixed to some accounts in budget reports.
-- Defined here so it can be ignored by accountNameDrop.
unbudgetedAccountName :: T.Text
unbudgetedAccountName :: Text
unbudgetedAccountName = Text
"<unbudgeted>"

accountNamePostingType :: AccountName -> PostingType
accountNamePostingType :: Text -> PostingType
accountNamePostingType Text
a
    | Text -> Bool
T.null Text
a = PostingType
RegularPosting
    | HasCallStack => Text -> Char
Text -> Char
T.head Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' = PostingType
BalancedVirtualPosting
    | HasCallStack => Text -> Char
Text -> Char
T.head Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' = PostingType
VirtualPosting
    | Bool
otherwise = PostingType
RegularPosting

accountNameWithoutPostingType :: AccountName -> AccountName
accountNameWithoutPostingType :: Text -> Text
accountNameWithoutPostingType Text
a = case Text -> PostingType
accountNamePostingType Text
a of
                                    PostingType
BalancedVirtualPosting -> Text -> Text
textUnbracket Text
a
                                    PostingType
VirtualPosting -> Text -> Text
textUnbracket Text
a
                                    PostingType
RegularPosting -> Text
a

accountNameWithPostingType :: PostingType -> AccountName -> AccountName
accountNameWithPostingType :: PostingType -> Text -> Text
accountNameWithPostingType PostingType
BalancedVirtualPosting = Text -> Text -> Text -> Text
wrap Text
"[" Text
"]" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
accountNameWithoutPostingType
accountNameWithPostingType PostingType
VirtualPosting         = Text -> Text -> Text -> Text
wrap Text
"(" Text
")" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
accountNameWithoutPostingType
accountNameWithPostingType PostingType
RegularPosting         = Text -> Text
accountNameWithoutPostingType

-- | Prefix one account name to another, preserving posting type
-- indicators like concatAccountNames.
joinAccountNames :: AccountName -> AccountName -> AccountName
joinAccountNames :: Text -> Text -> Text
joinAccountNames Text
a Text
b = [Text] -> Text
concatAccountNames ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
a,Text
b]

-- | Join account names into one. If any of them has () or [] posting type
-- indicators, these (the first type encountered) will also be applied to
-- the resulting account name.
concatAccountNames :: [AccountName] -> AccountName
concatAccountNames :: [Text] -> Text
concatAccountNames [Text]
as = PostingType -> Text -> Text
accountNameWithPostingType PostingType
t (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
accountNameWithoutPostingType [Text]
as
    where t :: PostingType
t = PostingType -> [PostingType] -> PostingType
forall a. a -> [a] -> a
headDef PostingType
RegularPosting ([PostingType] -> PostingType) -> [PostingType] -> PostingType
forall a b. (a -> b) -> a -> b
$ (PostingType -> Bool) -> [PostingType] -> [PostingType]
forall a. (a -> Bool) -> [a] -> [a]
filter (PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
/= PostingType
RegularPosting) ([PostingType] -> [PostingType]) -> [PostingType] -> [PostingType]
forall a b. (a -> b) -> a -> b
$ (Text -> PostingType) -> [Text] -> [PostingType]
forall a b. (a -> b) -> [a] -> [b]
map Text -> PostingType
accountNamePostingType [Text]
as

-- | Rewrite an account name using all matching aliases from the given list, in sequence.
-- Each alias sees the result of applying the previous aliases.
-- Or, return any error arising from a bad regular expression in the aliases.
accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliases :: [AccountAlias] -> Text -> Either RegexError Text
accountNameApplyAliases [AccountAlias]
aliases Text
a =
  let (Text
name,PostingType
typ) = (Text -> Text
accountNameWithoutPostingType Text
a, Text -> PostingType
accountNamePostingType Text
a)
  in (Text -> AccountAlias -> Either RegexError Text)
-> Text -> [AccountAlias] -> Either RegexError Text
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
     (\Text
acct AccountAlias
alias -> RegexError -> Either RegexError Text -> Either RegexError Text
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"result" (Either RegexError Text -> Either RegexError Text)
-> Either RegexError Text -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ AccountAlias -> Text -> Either RegexError Text
aliasReplace (RegexError -> AccountAlias -> AccountAlias
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"alias" AccountAlias
alias) (RegexError -> Text -> Text
forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"account" Text
acct))
     Text
name
     [AccountAlias]
aliases
     Either RegexError Text
-> (Text -> Either RegexError Text) -> Either RegexError Text
forall a b.
Either RegexError a
-> (a -> Either RegexError b) -> Either RegexError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either RegexError Text
forall a b. b -> Either a b
Right (Text -> Either RegexError Text)
-> (Text -> Text) -> Text -> Either RegexError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingType -> Text -> Text
accountNameWithPostingType PostingType
typ

-- | Memoising version of accountNameApplyAliases, maybe overkill.
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliasesMemo :: [AccountAlias] -> Text -> Either RegexError Text
accountNameApplyAliasesMemo [AccountAlias]
aliases = (Text -> Either RegexError Text) -> Text -> Either RegexError Text
forall a b. Ord a => (a -> b) -> a -> b
memo ([AccountAlias] -> Text -> Either RegexError Text
accountNameApplyAliases [AccountAlias]
aliases)
  -- XXX re-test this memoisation

-- aliasMatches :: AccountAlias -> AccountName -> Bool
-- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a
-- aliasMatches (RegexAlias re  _) a = regexMatchesCI re a

aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName
aliasReplace :: AccountAlias -> Text -> Either RegexError Text
aliasReplace (BasicAlias Text
old Text
new) Text
a
  | Text
old Text -> Text -> Bool
`isAccountNamePrefixOf` Text
a Bool -> Bool -> Bool
|| Text
old Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a =
      Text -> Either RegexError Text
forall a b. b -> Either a b
Right (Text -> Either RegexError Text) -> Text -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ Text
new Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop (Text -> Int
T.length Text
old) Text
a
  | Bool
otherwise = Text -> Either RegexError Text
forall a b. b -> Either a b
Right Text
a
aliasReplace (RegexAlias Regexp
re RegexError
repl) Text
a =
  (RegexError -> Text)
-> Either RegexError RegexError -> Either RegexError Text
forall a b. (a -> b) -> Either RegexError a -> Either RegexError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RegexError -> Text
T.pack (Either RegexError RegexError -> Either RegexError Text)
-> (RegexError -> Either RegexError RegexError)
-> RegexError
-> Either RegexError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> RegexError -> RegexError -> Either RegexError RegexError
regexReplace Regexp
re RegexError
repl (RegexError -> Either RegexError Text)
-> RegexError -> Either RegexError Text
forall a b. (a -> b) -> a -> b
$ Text -> RegexError
T.unpack Text
a -- XXX

-- | Remove some number of account name components from the front of the account name.
-- If the special "<unbudgeted>" top-level account is present, it is preserved and
-- dropping affects the rest of the account name.
accountNameDrop :: Int -> AccountName -> AccountName
accountNameDrop :: Int -> Text -> Text
accountNameDrop Int
n Text
a
  | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
unbudgetedAccountName = Text
a
  | Text
unbudgetedAccountAndSep Text -> Text -> Bool
`T.isPrefixOf` Text
a =
      case Int -> Text -> Text
accountNameDrop Int
n (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
unbudgetedAccountAndSep) Text
a of
        Text
"" -> Text
unbudgetedAccountName
        Text
a' -> Text
unbudgetedAccountAndSep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a'
  | Bool
otherwise = [Text] -> Text
accountNameFromComponentsOrElide ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
n ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
accountNameComponents Text
a
  where
    unbudgetedAccountAndSep :: Text
unbudgetedAccountAndSep = Text
unbudgetedAccountName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acctsep
    accountNameFromComponentsOrElide :: [Text] -> Text
accountNameFromComponentsOrElide [] = Text
"..."
    accountNameFromComponentsOrElide [Text]
xs = [Text] -> Text
accountNameFromComponents [Text]
xs

-- | Sorted unique account names implied by these account names,
-- ie these plus all their parent accounts up to the root.
-- Eg: ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
expandAccountNames :: [AccountName] -> [AccountName]
expandAccountNames :: [Text] -> [Text]
expandAccountNames = Set Text -> [Text]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Text -> [Text]) -> ([Text] -> Set Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Set Text) -> [Text] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> (Text -> [Text]) -> Text -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
expandAccountName)

-- | "a:b:c" -> ["a","a:b","a:b:c"]
expandAccountName :: AccountName -> [AccountName]
expandAccountName :: Text -> [Text]
expandAccountName = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
accountNameFromComponents ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Text] -> [[Text]]
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty [Text] -> [[Text]])
-> (Text -> NonEmpty [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> NonEmpty [Text]
forall (f :: * -> *) a. Foldable f => f a -> NonEmpty [a]
NE.inits ([Text] -> NonEmpty [Text])
-> (Text -> [Text]) -> Text -> NonEmpty [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents

-- | ["a:b:c","d:e"] -> ["a","d"]
topAccountNames :: [AccountName] -> [AccountName]
topAccountNames :: [Text] -> [Text]
topAccountNames = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
accountNameLevel) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
expandAccountNames

-- | "a:b:c" -> "a"
topAccountName :: AccountName -> AccountName
topAccountName :: Text -> Text
topAccountName = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
acctsepchar)

parentAccountName :: AccountName -> AccountName
parentAccountName :: Text -> Text
parentAccountName = [Text] -> Text
accountNameFromComponents ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents

parentAccountNames :: AccountName -> [AccountName]
parentAccountNames :: Text -> [Text]
parentAccountNames Text
a = Text -> [Text]
parentAccountNames' (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
parentAccountName Text
a
    where
      parentAccountNames' :: Text -> [Text]
parentAccountNames' Text
"" = []
      parentAccountNames' Text
a2 = Text
a2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
parentAccountNames' (Text -> Text
parentAccountName Text
a2)

-- | Is the first account a parent or other ancestor of (and not the same as) the second ?
isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
isAccountNamePrefixOf :: Text -> Text -> Bool
isAccountNamePrefixOf = Text -> Text -> Bool
T.isPrefixOf (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acctsep)

isSubAccountNameOf :: AccountName -> AccountName -> Bool
Text
s isSubAccountNameOf :: Text -> Text -> Bool
`isSubAccountNameOf` Text
p =
  (Text
p Text -> Text -> Bool
`isAccountNamePrefixOf` Text
s) Bool -> Bool -> Bool
&& (Text -> Int
accountNameLevel Text
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Int
accountNameLevel Text
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

-- | From a list of account names, select those which are direct
-- subaccounts of the given account name.
subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]
subAccountNamesFrom :: [Text] -> Text -> [Text]
subAccountNamesFrom [Text]
accts Text
a = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
`isSubAccountNameOf` Text
a) [Text]
accts

-- | Convert a list of account names to a tree, efficiently.
accountNameTreeFrom :: [AccountName] -> Tree AccountName
accountNameTreeFrom :: [Text] -> Tree Text
accountNameTreeFrom [Text]
accts = ((Text, [Text]) -> (Text, [(Text, [Text])]))
-> (Text, [Text]) -> Tree Text
forall b a. (b -> (a, [b])) -> b -> Tree a
unfoldTree (Text, [Text]) -> (Text, [(Text, [Text])])
grow (Text
"root", [Text] -> [Text]
expandAccountNames [Text]
accts)
  where
    -- unfoldTree :: (b -> (a, [b])) -> b -> Tree a
    -- grow :: (b -> (a, [b]))
    -- a = AccountName                  - the label at each node of the tree
    -- b = (AccountName, [AccountName]) - the next node's account, and the accounts remaining to consume under it
    grow :: ((AccountName, [AccountName]) -> (AccountName, [(AccountName, [AccountName])]))
    grow :: (Text, [Text]) -> (Text, [(Text, [Text])])
grow (Text
a,[])   = (Text
a,[])
    grow (Text
a,[Text]
rest) = (Text
a, [(Text
s, (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
s Text -> Text -> Bool
`isAccountNamePrefixOf`) [Text]
deepersubs) | Text
s <- [Text]
asubs])
      where
        ([Text]
asubs, [Text]
deepersubs) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text -> Text -> Bool
isChildOf Text
a) [Text]
rest
        isChildOf :: Text -> Text -> Bool
isChildOf Text
"root" = (Int
1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
accountNameLevel
        isChildOf Text
acct   = (Text -> Text -> Bool
`isSubAccountNameOf` Text
acct)

-- | Elide an account name to fit in the specified width.
-- From the ledger 2.6 news:
--
-- @
--   What Ledger now does is that if an account name is too long, it will
--   start abbreviating the first parts of the account name down to two
--   letters in length.  If this results in a string that is still too
--   long, the front will be elided -- not the end.  For example:
--
--     Expenses:Cash           ; OK, not too long
--     Ex:Wednesday:Cash       ; "Expenses" was abbreviated to fit
--     Ex:We:Afternoon:Cash    ; "Expenses" and "Wednesday" abbreviated
--     ; Expenses:Wednesday:Afternoon:Lunch:Snack:Candy:Chocolate:Cash
--     ..:Af:Lu:Sn:Ca:Ch:Cash  ; Abbreviated and elided!
-- @
elideAccountName :: Int -> AccountName -> AccountName
elideAccountName :: Int -> Text -> Text
elideAccountName Int
width Text
s
  -- XXX special case for transactions register's multi-account pseudo-names
  | Text
" (split)" Text -> Text -> Bool
`T.isSuffixOf` Text
s =
    let
      names :: [Text]
names = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
", " (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) Text
s
      widthpername :: Int
widthpername = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names
    in
     Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) Bool
True Bool
False (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
     (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" (split)") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
     Text -> [Text] -> Text
T.intercalate Text
", "
     [[Text] -> Text
accountNameFromComponents ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text] -> [Text]
elideparts Int
widthpername [] ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
accountNameComponents Text
s' | Text
s' <- [Text]
names]
  | Bool
otherwise =
    Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) Bool
True Bool
False (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
accountNameFromComponents ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text] -> [Text]
elideparts Int
width [] ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
accountNameComponents Text
s
      where
        elideparts :: Int -> [Text] -> [Text] -> [Text]
        elideparts :: Int -> [Text] -> [Text] -> [Text]
elideparts Int
w [Text]
done [Text]
ss
          | Text -> Int
forall a. HasChars a => a -> Int
realLength ([Text] -> Text
accountNameFromComponents ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ss) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = [Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ss
          | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Int -> [Text] -> [Text] -> [Text]
elideparts Int
w ([Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Int -> Text -> Text
textTakeWidth Int
2 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. HasCallStack => [a] -> a
headErr [Text]
ss]) ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tailErr [Text]
ss)  -- PARTIAL headErr, tailErr will succeed because length > 1
          | Bool
otherwise = [Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ss

-- | Keep only the first n components of an account name, where n
-- is a positive integer.
clipAccountNameTo :: Int -> AccountName -> AccountName
clipAccountNameTo :: Int -> Text -> Text
clipAccountNameTo Int
n = [Text] -> Text
accountNameFromComponents ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
n ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents

-- | Calculate the depth to which an account name should be clipped for a given
-- 'DepthSpec'.
--
-- First checking whether the account name matches any of the regular
-- expressions controlling depth. If so, clip to the depth of the most specific
-- of those matches, i.e. the one which starts matching the latest as you
-- progress up the parents of the account. Otherwise clip to the flat depth
-- provided, or return the full name if Nothing.
getAccountNameClippedDepth :: DepthSpec -> AccountName -> Maybe Int
getAccountNameClippedDepth :: DepthSpec -> Text -> Maybe Int
getAccountNameClippedDepth (DepthSpec Maybe Int
flat [(Regexp, Int)]
regexps) Text
acctName =
    [(Regexp, Int)] -> Maybe Int
mostSpecificRegexp [(Regexp, Int)]
regexps Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
flat
  where
    -- If any regular expressions match, choose the one with the greatest
    -- specificity and clip to that depth.
    mostSpecificRegexp :: [(Regexp, Int)] -> Maybe Int
mostSpecificRegexp = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> Maybe Int)
-> ([(Regexp, Int)] -> Maybe (Int, Int))
-> [(Regexp, Int)]
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int))
-> Maybe (Int, Int) -> [(Int, Int)] -> Maybe (Int, Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall {a} {b}. Ord a => (a, b) -> Maybe (a, b) -> Maybe (a, b)
takeMax Maybe (Int, Int)
forall a. Maybe a
Nothing ([(Int, Int)] -> Maybe (Int, Int))
-> ([(Regexp, Int)] -> [(Int, Int)])
-> [(Regexp, Int)]
-> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Regexp, Int) -> Maybe (Int, Int))
-> [(Regexp, Int)] -> [(Int, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Regexp, Int) -> Maybe (Int, Int)
matchRegexp
      where
        -- If two regexps match, take the most specific one. If there is a tie,
        -- take the last one (this aligns with the behaviour for flat depths
        -- limiting).
        takeMax :: (a, b) -> Maybe (a, b) -> Maybe (a, b)
takeMax (a
s, b
d) (Just (a
s', b
d')) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ((a, b) -> Maybe (a, b)) -> (a, b) -> Maybe (a, b)
forall a b. (a -> b) -> a -> b
$ if a
s'a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
s then (a
s', b
d') else (a
s, b
d)
        takeMax (a
s, b
d) Maybe (a, b)
Nothing = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
s, b
d)

    -- If the regular expression matches the account name, store the specificity and requested depth
    matchRegexp :: (Regexp, Int) -> Maybe (Int, Int)
    matchRegexp :: (Regexp, Int) -> Maybe (Int, Int)
matchRegexp (Regexp
r, Int
d) = if Regexp -> Text -> Bool
regexMatchText Regexp
r Text
acctName then (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Regexp -> Int
forall {b}. (Bounded b, Num b, Enum b) => Regexp -> b
getSpecificity Regexp
r, Int
d) else Maybe (Int, Int)
forall a. Maybe a
Nothing
    -- Specificity is the smallest parent of the account which matches the regular expression
    getSpecificity :: Regexp -> b
getSpecificity Regexp
r = b -> ((b, Text) -> b) -> Maybe (b, Text) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
forall a. Bounded a => a
maxBound (b, Text) -> b
forall a b. (a, b) -> a
fst (Maybe (b, Text) -> b) -> Maybe (b, Text) -> b
forall a b. (a -> b) -> a -> b
$ ((b, Text) -> Bool) -> [(b, Text)] -> Maybe (b, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> Text -> Bool
regexMatchText Regexp
r (Text -> Bool) -> ((b, Text) -> Text) -> (b, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Text) -> Text
forall a b. (a, b) -> b
snd) [(b, Text)]
forall {a}. (Num a, Enum a) => [(a, Text)]
acctParents
    acctParents :: [(a, Text)]
acctParents = [a] -> [Text] -> [(a, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
1..] ([Text] -> [(a, Text)])
-> ([Text] -> [Text]) -> [Text] -> [(a, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
initDef [] ([Text] -> [(a, Text)]) -> [Text] -> [(a, Text)]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
expandAccountName Text
acctName

-- | Clip an account name to a given 'DepthSpec', first checking whether it
-- matches any of the regular expressions controlling depth. If so, clip to the
-- depth of the most specific of those matches, i.e. the one which starts
-- matching the latest as you progress up the parents of the account. Otherwise
-- clip to the flat depth provided, or return the full name if Nothing.
clipAccountName :: DepthSpec -> AccountName -> AccountName
clipAccountName :: DepthSpec -> Text -> Text
clipAccountName DepthSpec
ds Text
a = (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Int -> Text -> Text
clipAccountNameTo (DepthSpec -> Text -> Maybe Int
getAccountNameClippedDepth DepthSpec
ds Text
a) Text
a

-- | As 'clipAccountName', but return '...' if asked to clip to depth 0.
clipOrEllipsifyAccountName :: DepthSpec -> AccountName -> AccountName
clipOrEllipsifyAccountName :: DepthSpec -> Text -> Text
clipOrEllipsifyAccountName DepthSpec
ds Text
a = Maybe Int -> Text
go (DepthSpec -> Text -> Maybe Int
getAccountNameClippedDepth DepthSpec
ds Text
a)
  where
    go :: Maybe Int -> Text
go Maybe Int
Nothing  = Text
a
    go (Just Int
0) = Text
"..."
    go (Just Int
n) = Int -> Text -> Text
clipAccountNameTo Int
n Text
a

-- | Escape an AccountName for use within a regular expression.
-- >>> putStr . T.unpack $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
-- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
escapeName :: AccountName -> Text
escapeName :: Text -> Text
escapeName = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar
  where
    escapeChar :: Char -> Text
escapeChar Char
c = if Char
c Char -> RegexError -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RegexError
escapedChars then Text -> Char -> Text
T.snoc Text
"\\" Char
c else Char -> Text
T.singleton Char
c
    escapedChars :: RegexError
escapedChars = [Char
'[', Char
'?', Char
'+', Char
'|', Char
'(', Char
')', Char
'*', Char
'$', Char
'^', Char
'\\']

-- | Convert an account name to a regular expression matching it and its subaccounts.
accountNameToAccountRegex :: AccountName -> Regexp
accountNameToAccountRegex :: Text -> Regexp
accountNameToAccountRegex Text
a = Text -> Regexp
toRegex' (Text -> Regexp) -> Text -> Regexp
forall a b. (a -> b) -> a -> b
$ Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeName Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(:|$)"  -- PARTIAL: Is this safe after escapeName?

-- | Convert an account name to a regular expression matching it and its subaccounts,
-- case insensitively.
accountNameToAccountRegexCI :: AccountName -> Regexp
accountNameToAccountRegexCI :: Text -> Regexp
accountNameToAccountRegexCI Text
a = Text -> Regexp
toRegexCI' (Text -> Regexp) -> Text -> Regexp
forall a b. (a -> b) -> a -> b
$ Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeName Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(:|$)"  -- PARTIAL: Is this safe after escapeName?

-- | Convert an account name to a regular expression matching it but not its subaccounts.
accountNameToAccountOnlyRegex :: AccountName -> Regexp
accountNameToAccountOnlyRegex :: Text -> Regexp
accountNameToAccountOnlyRegex Text
a = Text -> Regexp
toRegex' (Text -> Regexp) -> Text -> Regexp
forall a b. (a -> b) -> a -> b
$ Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeName Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$" -- PARTIAL: Is this safe after escapeName?

-- | Convert an account name to a regular expression matching it but not its subaccounts,
-- case insensitively.
accountNameToAccountOnlyRegexCI :: AccountName -> Regexp
accountNameToAccountOnlyRegexCI :: Text -> Regexp
accountNameToAccountOnlyRegexCI Text
a = Text -> Regexp
toRegexCI' (Text -> Regexp) -> Text -> Regexp
forall a b. (a -> b) -> a -> b
$ Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeName Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$" -- PARTIAL: Is this safe after escapeName?

-- -- | Does this string look like an exact account-matching regular expression ?
--isAccountRegex  :: String -> Bool
--isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:("

tests_AccountName :: TestTree
tests_AccountName = RegexError -> [TestTree] -> TestTree
testGroup RegexError
"AccountName" [
   RegexError -> Assertion -> TestTree
testCase RegexError
"accountNameTreeFrom" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> Tree Text
accountNameTreeFrom [Text
"a"]       Tree Text -> Tree Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"root" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a" []]
    [Text] -> Tree Text
accountNameTreeFrom [Text
"a",Text
"b"]   Tree Text -> Tree Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"root" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a" [], Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"b" []]
    [Text] -> Tree Text
accountNameTreeFrom [Text
"a",Text
"a:b"] Tree Text -> Tree Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"root" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a:b" []]]
    [Text] -> Tree Text
accountNameTreeFrom [Text
"a:b:c"]   Tree Text -> Tree Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"root" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a:b" [Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"a:b:c" []]]]
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"expandAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> [Text]
expandAccountNames [Text
"assets:cash",Text
"assets:checking",Text
"expenses:vacation"] [Text] -> [Text] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
     [Text
"assets",Text
"assets:cash",Text
"assets:checking",Text
"expenses",Text
"expenses:vacation"]
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"isAccountNamePrefixOf" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Text
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` Text
"assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
    Text
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` Text
"assets:bank" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
    Text
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` Text
"assets:bank:checking" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
    Text
"my assets" Text -> Text -> Bool
`isAccountNamePrefixOf` Text
"assets:bank" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"isSubAccountNameOf" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Text
"assets" Text -> Text -> Bool
`isSubAccountNameOf` Text
"assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
    Text
"assets:bank" Text -> Text -> Bool
`isSubAccountNameOf` Text
"assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
    Text
"assets:bank:checking" Text -> Text -> Bool
`isSubAccountNameOf` Text
"assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
    Text
"assets:bank" Text -> Text -> Bool
`isSubAccountNameOf` Text
"my assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"accountNameInferType" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Text -> Maybe AccountType
accountNameInferType Text
"assets"            Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Asset
    Text -> Maybe AccountType
accountNameInferType Text
"assets:cash"       Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Cash
    Text -> Maybe AccountType
accountNameInferType Text
"assets:A/R"        Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Asset
    Text -> Maybe AccountType
accountNameInferType Text
"liabilities"       Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Liability
    Text -> Maybe AccountType
accountNameInferType Text
"equity"            Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Equity
    Text -> Maybe AccountType
accountNameInferType Text
"equity:conversion" Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Conversion
    Text -> Maybe AccountType
accountNameInferType Text
"expenses"          Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Expense
    Text -> Maybe AccountType
accountNameInferType Text
"revenues"          Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Revenue
    Text -> Maybe AccountType
accountNameInferType Text
"revenue"           Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Revenue
    Text -> Maybe AccountType
accountNameInferType Text
"income"            Maybe AccountType -> Maybe AccountType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= AccountType -> Maybe AccountType
forall a. a -> Maybe a
Just AccountType
Revenue
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"joinAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    Text -> Text -> Text
joinAccountNames Text
"assets" Text
"cash"     Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets:cash"
    Text -> Text -> Text
joinAccountNames Text
"assets:cash" Text
"a"   Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets:cash:a"
    Text -> Text -> Text
joinAccountNames Text
"assets" Text
"(cash)"   Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(assets:cash)"
    Text -> Text -> Text
joinAccountNames Text
"assets" Text
"[cash]"   Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"[assets:cash]"
    Text -> Text -> Text
joinAccountNames Text
"(assets)" Text
"cash"   Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(assets:cash)"
    Text -> Text -> Text
joinAccountNames Text
"" Text
"assets"         Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets"
    Text -> Text -> Text
joinAccountNames Text
"assets" Text
""         Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets"
  ,RegexError -> Assertion -> TestTree
testCase RegexError
"concatAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> Text
concatAccountNames [Text
"assets", Text
"cash"]   Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets:cash"
    [Text] -> Text
concatAccountNames [Text
"assets:cash", Text
"a"] Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets:cash:a"
    [Text] -> Text
concatAccountNames [Text
"assets", Text
"(cash)"] Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(assets:cash)"
    [Text] -> Text
concatAccountNames [Text
"assets", Text
"[cash]"] Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"[assets:cash]"
    [Text] -> Text
concatAccountNames [Text
"(assets)", Text
"cash"] Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(assets:cash)"
    [Text] -> Text
concatAccountNames [Text
"", Text
"assets"]       Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
":assets"
    [Text] -> Text
concatAccountNames [Text
"assets", Text
""]       Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"assets:"
 ]