module AccountName
where
import Utils
import Types

sepchar = ':'

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

accountNameFromComponents :: [String] -> AccountName
accountNameFromComponents = concat . intersperse [sepchar]

accountLeafName :: AccountName -> String
accountLeafName = last . accountNameComponents

accountNameLevel :: AccountName -> Int
accountNameLevel "" = 0
accountNameLevel a = (length $ filter (==sepchar) a) + 1

-- ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"]
expandAccountNames :: [AccountName] -> [AccountName]
expandAccountNames as = nub $ concat $ map expand as
    where expand as = map accountNameFromComponents (tail $ inits $ accountNameComponents as)

-- ["a:b:c","d:e"] -> ["a","d"]
topAccountNames :: [AccountName] -> [AccountName]
topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]

parentAccountName :: AccountName -> AccountName
parentAccountName a = accountNameFromComponents $ init $ accountNameComponents a

parentAccountNames :: AccountName -> [AccountName]
parentAccountNames a = parentAccountNames' $ parentAccountName a
    where
      parentAccountNames' "" = []
      parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a)

isAccountNamePrefixOf :: AccountName -> AccountName -> Bool
p `isAccountNamePrefixOf` s = ((p ++ [sepchar]) `isPrefixOf` s)

isSubAccountNameOf :: AccountName -> AccountName -> Bool
s `isSubAccountNameOf` p = 
    (p `isAccountNamePrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1))

subAccountNamesFrom :: [AccountName] -> AccountName -> [AccountName]
subAccountNamesFrom accts a = filter (`isSubAccountNameOf` a) accts

matchAccountName :: Regex -> AccountName -> Bool
matchAccountName r a =
    case matchRegex r a of
      Nothing -> False
      otherwise -> True

indentAccountName ::  Int -> AccountName -> String
indentAccountName indentcorrection a = 
    replicate (indentlevel * 2) ' ' ++ (accountLeafName a)
    where indentlevel = ((accountNameLevel a) - 1) + indentcorrection


-- We could almost get by with just the above, but we need smarter
-- structures to eg display the account tree with boring accounts elided.
-- first, here is a tree of AccountNames; Account and Account tree are
-- defined later.

accountNameTreeFrom_props =
    [
     accountNameTreeFrom ["a"]       == Node "top" [Node "a" []],
     accountNameTreeFrom ["a","b"]   == Node "top" [Node "a" [], Node "b" []],
     accountNameTreeFrom ["a","a:b"] == Node "top" [Node "a" [Node "a:b" []]],
     accountNameTreeFrom ["a:b"]     == Node "top" [Node "a" [Node "a:b" []]]
    ]
accountNameTreeFrom :: [AccountName] -> Tree AccountName
accountNameTreeFrom accts = 
    Node "top" (accountsFrom (topAccountNames accts))
        where
          accountsFrom :: [AccountName] -> [Tree AccountName]
          accountsFrom [] = []
          accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as]
          subs = (subAccountNamesFrom accts)

filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName
filterAccountNameTree pats keepsubs maxdepth =
    treefilter (\a -> matchany a || (keepsubs && issubofmatch a)) . treeprune maxdepth
    where
      regexes = map mkRegex pats
      matchany a = any (match a) regexes
      match a r = matchAccountName r $ accountLeafName a
      issubofmatch a = any matchany $ parentAccountNames a