{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Hledger.Data.AccountName (
accountLeafName
,accountNameComponents
,accountNameDrop
,accountNameFromComponents
,accountNameLevel
,accountNameToAccountOnlyRegex
,accountNameToAccountOnlyRegexCI
,accountNameToAccountRegex
,accountNameToAccountRegexCI
,accountNameTreeFrom
,accountSummarisedName
,acctsep
,acctsepchar
,clipAccountName
,clipOrEllipsifyAccountName
,elideAccountName
,escapeName
,expandAccountName
,expandAccountNames
,isAccountNamePrefixOf
,isSubAccountNameOf
,parentAccountName
,parentAccountNames
,subAccountNamesFrom
,topAccountNames
,unbudgetedAccountName
,tests_AccountName
)
where
import Data.List.Extra (nubSort)
import qualified Data.List.NonEmpty as NE
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tree (Tree(..))
import Hledger.Data.Types
import Hledger.Utils
acctsepchar :: Char
acctsepchar :: Char
acctsepchar = ':'
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 a :: 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
> 1 = Text -> [Text] -> Text
T.intercalate ":" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take 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
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
accountNameLevel :: AccountName -> Int
accountNameLevel :: Text -> Int
accountNameLevel "" = 0
accountNameLevel a :: 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
+ 1
unbudgetedAccountName :: T.Text
unbudgetedAccountName :: Text
unbudgetedAccountName = "<unbudgeted>"
accountNameDrop :: Int -> AccountName -> AccountName
accountNameDrop :: Int -> Text -> Text
accountNameDrop n :: Int
n a :: 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
unbudgetedAccountName
a' :: 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 [] = "..."
accountNameFromComponentsOrElide xs :: [Text]
xs = [Text] -> Text
accountNameFromComponents [Text]
xs
expandAccountNames :: [AccountName] -> [AccountName]
expandAccountNames :: [Text] -> [Text]
expandAccountNames as :: [Text]
as = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
expandAccountName [Text]
as
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 as :: [Text]
as = [Text
a | Text
a <- [Text] -> [Text]
expandAccountNames [Text]
as, Text -> Int
accountNameLevel Text
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1]
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 a :: 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' "" = []
parentAccountNames' a :: 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
s :: Text
s isSubAccountNameOf :: Text -> Text -> Bool
`isSubAccountNameOf` p :: 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
+ 1))
subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]
subAccountNamesFrom :: [Text] -> Text -> [Text]
subAccountNamesFrom accts :: [Text]
accts a :: 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 accts :: [Text]
accts =
Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "root" ([Text] -> Forest Text
accounttreesfrom ([Text] -> [Text]
topAccountNames [Text]
accts))
where
accounttreesfrom :: [AccountName] -> [Tree AccountName]
accounttreesfrom :: [Text] -> Forest Text
accounttreesfrom [] = []
accounttreesfrom as :: [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 width :: Int
width s :: Text
s
| " (split)" Text -> Text -> Bool
`T.isSuffixOf` Text
s =
let
names :: [Text]
names = Text -> Text -> [Text]
T.splitOn ", " (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
- 8) Text
s
widthpername :: Int
widthpername = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
<>" (split)") (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [Text] -> Text
T.intercalate ", "
[[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 width :: Int
width done :: [Text]
done ss :: [Text]
ss
| Text -> Int
textWidth ([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
> 1 = Int -> [Text] -> [Text] -> [Text]
elideparts Int
width ([Text]
done[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++[Int -> Text -> Text
textTakeWidth 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 Nothing = Text -> Text
forall a. a -> a
id
clipAccountName (Just n :: 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 0) = Text -> Text -> Text
forall a b. a -> b -> a
const "..."
clipOrEllipsifyAccountName n :: Maybe Int
n = Maybe Int -> Text -> Text
clipAccountName Maybe Int
n
escapeName :: AccountName -> String
escapeName :: Text -> String
escapeName = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar
where
escapeChar :: Char -> Text
escapeChar c :: 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 "\\" Char
c else Char -> Text
T.singleton Char
c
escapedChars :: String
escapedChars = ['[', '?', '+', '|', '(', ')', '*', '$', '^', '\\']
accountNameToAccountRegex :: AccountName -> Regexp
accountNameToAccountRegex :: Text -> Regexp
accountNameToAccountRegex a :: Text
a = String -> Regexp
toRegex' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ '^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(:|$)"
accountNameToAccountRegexCI :: AccountName -> Regexp
accountNameToAccountRegexCI :: Text -> Regexp
accountNameToAccountRegexCI a :: Text
a = String -> Regexp
toRegexCI' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ '^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(:|$)"
accountNameToAccountOnlyRegex :: AccountName -> Regexp
accountNameToAccountOnlyRegex :: Text -> Regexp
accountNameToAccountOnlyRegex a :: Text
a = String -> Regexp
toRegex' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ '^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$"
accountNameToAccountOnlyRegexCI :: AccountName -> Regexp
accountNameToAccountOnlyRegexCI :: Text -> Regexp
accountNameToAccountOnlyRegexCI a :: Text
a = String -> Regexp
toRegexCI' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ '^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "$"
tests_AccountName :: TestTree
tests_AccountName = String -> [TestTree] -> TestTree
tests "AccountName" [
String -> Assertion -> TestTree
test "accountNameTreeFrom" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Text] -> Tree Text
accountNameTreeFrom ["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 "root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a" []]
[Text] -> Tree Text
accountNameTreeFrom ["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 "root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a" [], Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "b" []]
[Text] -> Tree Text
accountNameTreeFrom ["a","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 "root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a:b" []]]
[Text] -> Tree Text
accountNameTreeFrom ["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 "root" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a:b" [Text -> Forest Text -> Tree Text
forall a. a -> Forest a -> Tree a
Node "a:b:c" []]]]
,String -> Assertion -> TestTree
test "expandAccountNames" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
[Text] -> [Text]
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] [Text] -> [Text] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?=
["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
,String -> Assertion -> TestTree
test "isAccountNamePrefixOf" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` "assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` "assets:bank" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
"assets" Text -> Text -> Bool
`isAccountNamePrefixOf` "assets:bank:checking" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
"my assets" Text -> Text -> Bool
`isAccountNamePrefixOf` "assets:bank" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
,String -> Assertion -> TestTree
test "isSubAccountNameOf" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
"assets" Text -> Text -> Bool
`isSubAccountNameOf` "assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
"assets:bank" Text -> Text -> Bool
`isSubAccountNameOf` "assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True
"assets:bank:checking" Text -> Text -> Bool
`isSubAccountNameOf` "assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
"assets:bank" Text -> Text -> Bool
`isSubAccountNameOf` "my assets" Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
False
]