{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
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
,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
acctsepchar :: Char
acctsepchar :: Char
acctsepchar = Char
':'
acctsep :: Text
acctsep :: Text
acctsep = String -> Text
T.pack [Char
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 = [Text] -> Text
forall a. [a] -> a
last ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
accountNameComponents
accountSummarisedName :: AccountName -> Text
accountSummarisedName :: Text -> Text
accountSummarisedName Text
a
| [Text] -> 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. [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
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?(:|$)"
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
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 (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 (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
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' = PostingType
BalancedVirtualPosting
| Text -> Char
T.head Text
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& 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
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]
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
accountNameApplyAliases :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliases :: [AccountAlias] -> Text -> Either String Text
accountNameApplyAliases [AccountAlias]
aliases Text
a =
let (Text
aname,PostingType
atype) = (Text -> Text
accountNameWithoutPostingType Text
a, Text -> PostingType
accountNamePostingType Text
a)
in (Text -> AccountAlias -> Either String Text)
-> Text -> [AccountAlias] -> Either String Text
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
(\Text
acct AccountAlias
alias -> String -> Either String Text -> Either String Text
forall a. Show a => String -> a -> a
dbg6 String
"result" (Either String Text -> Either String Text)
-> Either String Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ AccountAlias -> Text -> Either String Text
aliasReplace (String -> AccountAlias -> AccountAlias
forall a. Show a => String -> a -> a
dbg6 String
"alias" AccountAlias
alias) (String -> Text -> Text
forall a. Show a => String -> a -> a
dbg6 String
"account" Text
acct))
Text
aname
[AccountAlias]
aliases
Either String Text
-> (Text -> Either String Text) -> Either String Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> (Text -> Text) -> Text -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostingType -> Text -> Text
accountNameWithPostingType PostingType
atype
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> Either RegexError AccountName
accountNameApplyAliasesMemo :: [AccountAlias] -> Text -> Either String Text
accountNameApplyAliasesMemo [AccountAlias]
aliases = (Text -> Either String Text) -> Text -> Either String Text
forall a b. Ord a => (a -> b) -> a -> b
memo ([AccountAlias] -> Text -> Either String Text
accountNameApplyAliases [AccountAlias]
aliases)
aliasReplace :: AccountAlias -> AccountName -> Either RegexError AccountName
aliasReplace :: AccountAlias -> Text -> Either String 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 String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String 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 String Text
forall a b. b -> Either a b
Right Text
a
aliasReplace (RegexAlias Regexp
re String
repl) Text
a =
(String -> Text) -> Either String String -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Either String String -> Either String Text)
-> (String -> Either String String) -> String -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> String -> String -> Either String String
regexReplace Regexp
re String
repl (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
a
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
expandAccountNames :: [AccountName] -> [AccountName]
expandAccountNames :: [Text] -> [Text]
expandAccountNames = Set Text -> [Text]
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 (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)
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
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
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. [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
a = Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
parentAccountNames' (Text -> Text
parentAccountName Text
a)
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))
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
accountNameTreeFrom :: [AccountName] -> Tree AccountName
accountNameTreeFrom :: [Text] -> Tree Text
accountNameTreeFrom [Text]
accts =
Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"root" ([Text] -> Forest Text
accounttreesfrom ([Text] -> [Text]
topAccountNames [Text]
accts))
where
accounttreesfrom :: [AccountName] -> [Tree AccountName]
accounttreesfrom :: [Text] -> Forest Text
accounttreesfrom [] = []
accounttreesfrom [Text]
as = [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
a ([Text] -> Forest Text
accounttreesfrom ([Text] -> Forest Text) -> [Text] -> Forest Text
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)
elideAccountName :: Int -> AccountName -> AccountName
elideAccountName :: Int -> Text -> Text
elideAccountName Int
width Text
s
| Text
" (split)" Text -> Text -> Bool
`T.isSuffixOf` Text
s =
let
names :: [Text]
names = 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 (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 (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
width [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
width = [Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ss
| [Text] -> 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
width ([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. [a] -> a
head [Text]
ss]) ([Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
ss)
| Bool
otherwise = [Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Text]
ss
clipAccountName :: Maybe Int -> AccountName -> AccountName
clipAccountName :: Maybe Int -> Text -> Text
clipAccountName Maybe Int
Nothing = Text -> Text
forall a. a -> a
id
clipAccountName (Just 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
clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName
clipOrEllipsifyAccountName :: Maybe Int -> Text -> Text
clipOrEllipsifyAccountName (Just Int
0) = Text -> Text -> Text
forall a b. a -> b -> a
const Text
"..."
clipOrEllipsifyAccountName Maybe Int
n = Maybe Int -> Text -> Text
clipAccountName Maybe Int
n
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 -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
escapedChars then Text -> Char -> Text
T.snoc Text
"\\" Char
c else Char -> Text
T.singleton Char
c
escapedChars :: String
escapedChars = [Char
'[', Char
'?', Char
'+', Char
'|', Char
'(', Char
')', Char
'*', Char
'$', Char
'^', Char
'\\']
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
"(:|$)"
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
"(:|$)"
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
"$"
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
"$"
tests_AccountName :: TestTree
tests_AccountName = String -> [TestTree] -> TestTree
testGroup String
"AccountName" [
String -> Assertion -> TestTree
testCase String
"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 -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest 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 -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"a" [], Text -> Forest Text -> Tree Text
forall a. a -> Forest 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 -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"a" [Text -> Forest Text -> Tree Text
forall a. a -> Forest 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 -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"a" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"a:b" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node Text
"a:b:c" []]]]
,String -> Assertion -> TestTree
testCase String
"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"]
,String -> Assertion -> TestTree
testCase String
"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
,String -> Assertion -> TestTree
testCase String
"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
,String -> Assertion -> TestTree
testCase String
"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
]