-- | Build up shared prefix trees
module System.FilePattern.Tree(
    Tree(..), makeTree
    ) where

import Data.List.Extra
import Prelude


data Tree k v = Tree [v] [(k, Tree k v)]

makeTree :: Ord k => [(v, [k])] -> Tree k v
makeTree :: [(v, [k])] -> Tree k v
makeTree = [(v, [k])] -> Tree k v
forall a v. Eq a => [(v, [a])] -> Tree a v
f ([(v, [k])] -> Tree k v)
-> ([(v, [k])] -> [(v, [k])]) -> [(v, [k])] -> Tree k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, [k]) -> [k]) -> [(v, [k])] -> [(v, [k])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (v, [k]) -> [k]
forall a b. (a, b) -> b
snd
    where
        f :: [(v, [a])] -> Tree a v
f [(v, [a])]
xs = [v] -> [(a, Tree a v)] -> Tree a v
forall k v. [v] -> [(k, Tree k v)] -> Tree k v
Tree (((v, [a]) -> v) -> [(v, [a])] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, [a]) -> v
forall a b. (a, b) -> a
fst [(v, [a])]
empty) [((a, (v, [a])) -> a
forall a b. (a, b) -> a
fst ((a, (v, [a])) -> a) -> (a, (v, [a])) -> a
forall a b. (a -> b) -> a -> b
$ [(a, (v, [a]))] -> (a, (v, [a]))
forall a. [a] -> a
head [(a, (v, [a]))]
gs, [(v, [a])] -> Tree a v
f ([(v, [a])] -> Tree a v) -> [(v, [a])] -> Tree a v
forall a b. (a -> b) -> a -> b
$ ((a, (v, [a])) -> (v, [a])) -> [(a, (v, [a]))] -> [(v, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (a, (v, [a])) -> (v, [a])
forall a b. (a, b) -> b
snd [(a, (v, [a]))]
gs) | [(a, (v, [a]))]
gs <- [[(a, (v, [a]))]]
groups]
            where
                ([(v, [a])]
empty, [(v, [a])]
nonEmpty) = ((v, [a]) -> Bool) -> [(v, [a])] -> ([(v, [a])], [(v, [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ((v, [a]) -> [a]) -> (v, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, [a]) -> [a]
forall a b. (a, b) -> b
snd) [(v, [a])]
xs
                groups :: [[(a, (v, [a]))]]
groups = ((a, (v, [a])) -> a) -> [(a, (v, [a]))] -> [[(a, (v, [a]))]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn (a, (v, [a])) -> a
forall a b. (a, b) -> a
fst [(a
x, (v
a,[a]
xs)) | (v
a,x:xs) <- [(v, [a])]
nonEmpty]