{-# 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
  ,accountNameType
  ,assetAccountRegex
  ,cashAccountRegex
  ,liabilityAccountRegex
  ,equityAccountRegex
  ,conversionAccountRegex
  ,revenueAccountRegex
  ,expenseAccountRegex
  ,acctsep
  ,acctsepchar
  ,clipAccountName
  ,clipOrEllipsifyAccountName
  ,elideAccountName
  ,escapeName
  ,expandAccountName
  ,expandAccountNames
  ,isAccountNamePrefixOf
--  ,isAccountRegex
  ,isSubAccountNameOf
  ,parentAccountName
  ,parentAccountNames
  ,subAccountNamesFrom
  ,topAccountNames
  ,unbudgetedAccountName
  ,accountNamePostingType
  ,accountNameWithoutPostingType
  ,accountNameWithPostingType
  ,joinAccountNames
  ,concatAccountNames
  ,accountNameApplyAliases
  ,accountNameApplyAliasesMemo
  ,tests_AccountName
)
where

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

import Hledger.Data.Types
import Hledger.Utils

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

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

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

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

accountNameComponents :: AccountName -> [Text]
accountNameComponents :: Text -> [Text]
accountNameComponents = 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 = forall a. [a] -> a
last 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'
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
cs forall a. Ord a => a -> a -> Bool
> Int
1 = Text -> [Text] -> Text
T.intercalate Text
":" (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take Int
2) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [Text]
cs) forall a. Semigroup a => a -> a -> a
<> 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

-- | 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:(trad(e|ing)|conversion)s?(:|$)"
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 = forall a. a -> Maybe a
Just AccountType
Cash
  | Regexp -> Text -> Bool
regexMatchText Regexp
assetAccountRegex      Text
a = forall a. a -> Maybe a
Just AccountType
Asset
  | Regexp -> Text -> Bool
regexMatchText Regexp
liabilityAccountRegex  Text
a = forall a. a -> Maybe a
Just AccountType
Liability
  | Regexp -> Text -> Bool
regexMatchText Regexp
conversionAccountRegex Text
a = forall a. a -> Maybe a
Just AccountType
Conversion
  | Regexp -> Text -> Bool
regexMatchText Regexp
equityAccountRegex     Text
a = forall a. a -> Maybe a
Just AccountType
Equity
  | Regexp -> Text -> Bool
regexMatchText Regexp
revenueAccountRegex    Text
a = forall a. a -> Maybe a
Just AccountType
Revenue
  | Regexp -> Text -> Bool
regexMatchText Regexp
expenseAccountRegex    Text
a = forall a. a -> Maybe a
Just AccountType
Expense
  | Bool
otherwise                               = 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 = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text AccountType
atypes) forall a b. (a -> b) -> a -> b
$ Text
a forall a. a -> [a] -> [a]
: Text -> [Text]
parentAccountNames Text
a)
                         forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe AccountType
accountNameInferType Text
a

accountNameLevel :: AccountName -> Int
accountNameLevel :: Text -> Int
accountNameLevel Text
"" = Int
0
accountNameLevel Text
a = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
==Char
acctsepchar) Text
a) 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
    | Text -> Char
T.head Text
a forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
a forall a. Eq a => a -> a -> Bool
== Char
']' = PostingType
BalancedVirtualPosting
    | Text -> Char
T.head Text
a forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
a 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
"]" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
accountNameWithoutPostingType
accountNameWithPostingType PostingType
VirtualPosting         = Text -> Text -> Text -> Text
wrap 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 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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 forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
":" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
accountNameWithoutPostingType [Text]
as
    where t :: PostingType
t = forall a. a -> [a] -> a
headDef PostingType
RegularPosting forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= PostingType
RegularPosting) forall a b. (a -> b) -> a -> b
$ 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 forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
     (\Text
acct AccountAlias
alias -> forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"result" forall a b. (a -> b) -> a -> b
$ AccountAlias -> Text -> Either RegexError Text
aliasReplace (forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"alias" AccountAlias
alias) (forall a. Show a => RegexError -> a -> a
dbg6 RegexError
"account" Text
acct))
     Text
name
     [AccountAlias]
aliases
     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. b -> Either a b
Right 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 = 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 forall a. Eq a => a -> a -> Bool
== Text
a =
      forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
new forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop (Text -> Int
T.length Text
old) Text
a
  | Bool
otherwise = forall a b. b -> Either a b
Right Text
a
aliasReplace (RegexAlias Regexp
re RegexError
repl) Text
a =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RegexError -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> RegexError -> RegexError -> Either RegexError RegexError
regexReplace Regexp
re RegexError
repl 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 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 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 forall a. Semigroup a => a -> a -> a
<> Text
a'
  | Bool
otherwise = [Text] -> Text
accountNameFromComponentsOrElide forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n forall a b. (a -> b) -> a -> b
$ Text -> [Text]
accountNameComponents Text
a
  where
    unbudgetedAccountAndSep :: Text
unbudgetedAccountAndSep = Text
unbudgetedAccountName 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Ord a => [a] -> Set a
S.fromList 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 = forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
accountNameFromComponents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => f a -> NonEmpty [a]
NE.inits 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
1forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
accountNameLevel) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
expandAccountNames

parentAccountName :: AccountName -> AccountName
parentAccountName :: Text -> Text
parentAccountName = [Text] -> Text
accountNameFromComponents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init 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' forall a b. (a -> b) -> a -> b
$ Text -> Text
parentAccountName Text
a
    where
      parentAccountNames' :: Text -> [Text]
parentAccountNames' Text
"" = []
      parentAccountNames' Text
a2 = Text
a2 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 forall a. Eq a => a -> a -> Bool
== (Text -> Int
accountNameLevel Text
p 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
`isSubAccountNameOf` Text
a) [Text]
accts

-- | Convert a list of account names to a tree.
accountNameTreeFrom :: [AccountName] -> Tree AccountName
accountNameTreeFrom :: [Text] -> Tree Text
accountNameTreeFrom [Text]
accts =
    forall a. a -> [Tree a] -> Tree a
Node Text
"root" ([Text] -> [Tree Text]
accounttreesfrom ([Text] -> [Text]
topAccountNames [Text]
accts))
        where
          accounttreesfrom :: [AccountName] -> [Tree AccountName]
          accounttreesfrom :: [Text] -> [Tree Text]
accounttreesfrom [] = []
          accounttreesfrom [Text]
as = [forall a. a -> [Tree a] -> Tree a
Node Text
a ([Text] -> [Tree Text]
accounttreesfrom forall a b. (a -> b) -> a -> b
$ Text -> [Text]
subs Text
a) | Text
a <- [Text]
as]
          subs :: Text -> [Text]
subs = [Text] -> Text -> [Text]
subAccountNamesFrom ([Text] -> [Text]
expandAccountNames [Text]
accts)

--nullaccountnametree = Node "root" []

-- | 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 = Text -> Text -> [Text]
T.splitOn Text
", " forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Text -> Int
T.length Text
s forall a. Num a => a -> a -> a
- Int
8) Text
s
      widthpername :: Int
widthpername = forall a. Ord a => a -> a -> a
max Int
0 (Int
width forall a. Num a => a -> a -> a
- Int
8 forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
max Int
1 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names) forall a. Num a => a -> a -> a
- Int
1)) forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names
    in
     Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
width) Bool
True Bool
False forall a b. (a -> b) -> a -> b
$
     (forall a. Semigroup a => a -> a -> a
<>Text
" (split)") forall a b. (a -> b) -> a -> b
$
     Text -> [Text] -> Text
T.intercalate Text
", "
     [[Text] -> Text
accountNameFromComponents forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text] -> [Text]
elideparts Int
widthpername [] 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 forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
width) Bool
True Bool
False forall a b. (a -> b) -> a -> b
$ [Text] -> Text
accountNameFromComponents forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text] -> [Text]
elideparts Int
width [] 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
          | forall a. HasChars a => a -> Int
realLength ([Text] -> Text
accountNameFromComponents forall a b. (a -> b) -> a -> b
$ [Text]
doneforall a. [a] -> [a] -> [a]
++[Text]
ss) forall a. Ord a => a -> a -> Bool
<= Int
w = [Text]
doneforall a. [a] -> [a] -> [a]
++[Text]
ss
          | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss forall a. Ord a => a -> a -> Bool
> Int
1 = Int -> [Text] -> [Text] -> [Text]
elideparts Int
w ([Text]
doneforall a. [a] -> [a] -> [a]
++[Int -> Text -> Text
textTakeWidth Int
2 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Text]
ss]) (forall a. [a] -> [a]
tail [Text]
ss)
          | Bool
otherwise = [Text]
doneforall a. [a] -> [a] -> [a]
++[Text]
ss

-- | Keep only the first n components of an account name, where n
-- is a positive integer. If n is Just 0, returns the empty string, if n is
-- Nothing, return the full name.
clipAccountName :: Maybe Int -> AccountName -> AccountName
clipAccountName :: Maybe Int -> Text -> Text
clipAccountName Maybe Int
Nothing  = forall a. a -> a
id
clipAccountName (Just Int
n) = [Text] -> Text
accountNameFromComponents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents

-- | Keep only the first n components of an account name, where n
-- is a positive integer. If n is Just 0, returns "...", if n is Nothing, return
-- the full name.
clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName
clipOrEllipsifyAccountName :: Maybe Int -> Text -> Text
clipOrEllipsifyAccountName (Just Int
0) = forall a b. a -> b -> a
const Text
"..."
clipOrEllipsifyAccountName Maybe Int
n        = Maybe Int -> Text -> Text
clipAccountName Maybe Int
n

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