module Hledger.Utils.Tree
( FastTree(..)
, treeFromPaths
) where

-- import Data.Char
import Data.List (foldl')
import qualified Data.Map as M

-- | An efficient-to-build tree suggested by Cale Gibbard, probably
-- better than accountNameTreeFrom.
newtype FastTree a = T (M.Map a (FastTree a))
  deriving (Int -> FastTree a -> ShowS
[FastTree a] -> ShowS
FastTree a -> String
(Int -> FastTree a -> ShowS)
-> (FastTree a -> String)
-> ([FastTree a] -> ShowS)
-> Show (FastTree a)
forall a. Show a => Int -> FastTree a -> ShowS
forall a. Show a => [FastTree a] -> ShowS
forall a. Show a => FastTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FastTree a] -> ShowS
$cshowList :: forall a. Show a => [FastTree a] -> ShowS
show :: FastTree a -> String
$cshow :: forall a. Show a => FastTree a -> String
showsPrec :: Int -> FastTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FastTree a -> ShowS
Show, FastTree a -> FastTree a -> Bool
(FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool) -> Eq (FastTree a)
forall a. Eq a => FastTree a -> FastTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FastTree a -> FastTree a -> Bool
$c/= :: forall a. Eq a => FastTree a -> FastTree a -> Bool
== :: FastTree a -> FastTree a -> Bool
$c== :: forall a. Eq a => FastTree a -> FastTree a -> Bool
Eq, Eq (FastTree a)
Eq (FastTree a)
-> (FastTree a -> FastTree a -> Ordering)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> Bool)
-> (FastTree a -> FastTree a -> FastTree a)
-> (FastTree a -> FastTree a -> FastTree a)
-> Ord (FastTree a)
FastTree a -> FastTree a -> Bool
FastTree a -> FastTree a -> Ordering
FastTree a -> FastTree a -> FastTree a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FastTree a)
forall a. Ord a => FastTree a -> FastTree a -> Bool
forall a. Ord a => FastTree a -> FastTree a -> Ordering
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
min :: FastTree a -> FastTree a -> FastTree a
$cmin :: forall a. Ord a => FastTree a -> FastTree a -> FastTree a
max :: FastTree a -> FastTree a -> FastTree a
$cmax :: forall a. Ord a => FastTree a -> FastTree a -> FastTree a
>= :: FastTree a -> FastTree a -> Bool
$c>= :: forall a. Ord a => FastTree a -> FastTree a -> Bool
> :: FastTree a -> FastTree a -> Bool
$c> :: forall a. Ord a => FastTree a -> FastTree a -> Bool
<= :: FastTree a -> FastTree a -> Bool
$c<= :: forall a. Ord a => FastTree a -> FastTree a -> Bool
< :: FastTree a -> FastTree a -> Bool
$c< :: forall a. Ord a => FastTree a -> FastTree a -> Bool
compare :: FastTree a -> FastTree a -> Ordering
$ccompare :: forall a. Ord a => FastTree a -> FastTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (FastTree a)
Ord)

emptyTree :: FastTree a
emptyTree :: FastTree a
emptyTree = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T Map a (FastTree a)
forall k a. Map k a
M.empty

mergeTrees :: (Ord a) => FastTree a -> FastTree a -> FastTree a
mergeTrees :: FastTree a -> FastTree a -> FastTree a
mergeTrees (T Map a (FastTree a)
m) (T Map a (FastTree a)
m') = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T ((FastTree a -> FastTree a -> FastTree a)
-> Map a (FastTree a) -> Map a (FastTree a) -> Map a (FastTree a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith FastTree a -> FastTree a -> FastTree a
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
mergeTrees Map a (FastTree a)
m Map a (FastTree a)
m')

treeFromPath :: [a] -> FastTree a
treeFromPath :: [a] -> FastTree a
treeFromPath []     = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T Map a (FastTree a)
forall k a. Map k a
M.empty
treeFromPath (a
x:[a]
xs) = Map a (FastTree a) -> FastTree a
forall a. Map a (FastTree a) -> FastTree a
T (a -> FastTree a -> Map a (FastTree a)
forall k a. k -> a -> Map k a
M.singleton a
x ([a] -> FastTree a
forall a. [a] -> FastTree a
treeFromPath [a]
xs))

treeFromPaths :: (Ord a) => [[a]] -> FastTree a
treeFromPaths :: [[a]] -> FastTree a
treeFromPaths = (FastTree a -> FastTree a -> FastTree a)
-> FastTree a -> [FastTree a] -> FastTree a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FastTree a -> FastTree a -> FastTree a
forall a. Ord a => FastTree a -> FastTree a -> FastTree a
mergeTrees FastTree a
forall a. FastTree a
emptyTree ([FastTree a] -> FastTree a)
-> ([[a]] -> [FastTree a]) -> [[a]] -> FastTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> FastTree a) -> [[a]] -> [FastTree a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> FastTree a
forall a. [a] -> FastTree a
treeFromPath