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

'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
  ,acctsep
  ,acctsepchar
  ,clipAccountName
  ,clipOrEllipsifyAccountName
  ,elideAccountName
  ,escapeName
  ,expandAccountName
  ,expandAccountNames
  ,isAccountNamePrefixOf
--  ,isAccountRegex
  ,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

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

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

acctsep :: Text
acctsep :: Text
acctsep = String -> 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 = [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

-- | 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 (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

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>"

-- | 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 [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

-- | "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]
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
== Int
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 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)

-- | 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.
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)

--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
", " (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
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
> 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

-- | 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  = 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

-- | 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) = Text -> Text -> Text
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 $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"
-- First\?!#\$\*\?\$\(\*\) !@\^#\*\? %\)\*!@#
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 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
'\\']

-- | Convert an account name to a regular expression matching it and its subaccounts.
accountNameToAccountRegex :: AccountName -> Regexp
accountNameToAccountRegex :: Text -> Regexp
accountNameToAccountRegex Text
a = String -> Regexp
toRegex' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(:|$)"  -- 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 = String -> Regexp
toRegexCI' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(:|$)"  -- 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 = String -> Regexp
toRegex' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" -- 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 = String -> Regexp
toRegexCI' (String -> Regexp) -> String -> Regexp
forall a b. (a -> b) -> a -> b
$ Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
escapeName Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" -- 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 = String -> [TestTree] -> TestTree
tests String
"AccountName" [
   String -> Assertion -> TestTree
test 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
test 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
test 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
test 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
 ]