{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Yi.CompletionTree (
CompletionTree (CompletionTree),
fromList, toList,
complete, update,
pretty,
unCompletionTree
) where
import Control.Arrow (first)
import Data.Function (on)
import Data.List (partition, maximumBy, intercalate)
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import Data.Maybe (isJust, fromJust, listToMaybe, catMaybes)
import qualified Data.ListLike as LL
import Data.ListLike (ListLike)
import Lens.Micro.Platform (over, Lens', _2, (.~), (&))
import Data.Binary (Binary)
import Data.Semigroup (Semigroup)
newtype CompletionTree a = CompletionTree {CompletionTree a -> Map a (CompletionTree a)
_unCompletionTree :: (Map a (CompletionTree a))}
deriving (b -> CompletionTree a -> CompletionTree a
NonEmpty (CompletionTree a) -> CompletionTree a
CompletionTree a -> CompletionTree a -> CompletionTree a
(CompletionTree a -> CompletionTree a -> CompletionTree a)
-> (NonEmpty (CompletionTree a) -> CompletionTree a)
-> (forall b.
Integral b =>
b -> CompletionTree a -> CompletionTree a)
-> Semigroup (CompletionTree a)
forall b. Integral b => b -> CompletionTree a -> CompletionTree a
forall a. Ord a => NonEmpty (CompletionTree a) -> CompletionTree a
forall a.
Ord a =>
CompletionTree a -> CompletionTree a -> CompletionTree a
forall a b.
(Ord a, Integral b) =>
b -> CompletionTree a -> CompletionTree a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CompletionTree a -> CompletionTree a
$cstimes :: forall a b.
(Ord a, Integral b) =>
b -> CompletionTree a -> CompletionTree a
sconcat :: NonEmpty (CompletionTree a) -> CompletionTree a
$csconcat :: forall a. Ord a => NonEmpty (CompletionTree a) -> CompletionTree a
<> :: CompletionTree a -> CompletionTree a -> CompletionTree a
$c<> :: forall a.
Ord a =>
CompletionTree a -> CompletionTree a -> CompletionTree a
Semigroup, Semigroup (CompletionTree a)
CompletionTree a
Semigroup (CompletionTree a)
-> CompletionTree a
-> (CompletionTree a -> CompletionTree a -> CompletionTree a)
-> ([CompletionTree a] -> CompletionTree a)
-> Monoid (CompletionTree a)
[CompletionTree a] -> CompletionTree a
CompletionTree a -> CompletionTree a -> CompletionTree a
forall a. Ord a => Semigroup (CompletionTree a)
forall a. Ord a => CompletionTree a
forall a. Ord a => [CompletionTree a] -> CompletionTree a
forall a.
Ord a =>
CompletionTree a -> CompletionTree a -> CompletionTree a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CompletionTree a] -> CompletionTree a
$cmconcat :: forall a. Ord a => [CompletionTree a] -> CompletionTree a
mappend :: CompletionTree a -> CompletionTree a -> CompletionTree a
$cmappend :: forall a.
Ord a =>
CompletionTree a -> CompletionTree a -> CompletionTree a
mempty :: CompletionTree a
$cmempty :: forall a. Ord a => CompletionTree a
$cp1Monoid :: forall a. Ord a => Semigroup (CompletionTree a)
Monoid, CompletionTree a -> CompletionTree a -> Bool
(CompletionTree a -> CompletionTree a -> Bool)
-> (CompletionTree a -> CompletionTree a -> Bool)
-> Eq (CompletionTree a)
forall a. Eq a => CompletionTree a -> CompletionTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionTree a -> CompletionTree a -> Bool
$c/= :: forall a. Eq a => CompletionTree a -> CompletionTree a -> Bool
== :: CompletionTree a -> CompletionTree a -> Bool
$c== :: forall a. Eq a => CompletionTree a -> CompletionTree a -> Bool
Eq, Get (CompletionTree a)
[CompletionTree a] -> Put
CompletionTree a -> Put
(CompletionTree a -> Put)
-> Get (CompletionTree a)
-> ([CompletionTree a] -> Put)
-> Binary (CompletionTree a)
forall a. Binary a => Get (CompletionTree a)
forall a. Binary a => [CompletionTree a] -> Put
forall a. Binary a => CompletionTree a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CompletionTree a] -> Put
$cputList :: forall a. Binary a => [CompletionTree a] -> Put
get :: Get (CompletionTree a)
$cget :: forall a. Binary a => Get (CompletionTree a)
put :: CompletionTree a -> Put
$cput :: forall a. Binary a => CompletionTree a -> Put
Binary)
unCompletionTree :: Lens' (CompletionTree a) (Map a (CompletionTree a))
unCompletionTree :: (Map a (CompletionTree a) -> f (Map a (CompletionTree a)))
-> CompletionTree a -> f (CompletionTree a)
unCompletionTree Map a (CompletionTree a) -> f (Map a (CompletionTree a))
f CompletionTree a
ct = (\Map a (CompletionTree a)
unCompletionTree' -> CompletionTree a
ct {_unCompletionTree :: Map a (CompletionTree a)
_unCompletionTree = Map a (CompletionTree a)
unCompletionTree'}) (Map a (CompletionTree a) -> CompletionTree a)
-> f (Map a (CompletionTree a)) -> f (CompletionTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Map a (CompletionTree a) -> f (Map a (CompletionTree a))
f (CompletionTree a -> Map a (CompletionTree a)
forall a. CompletionTree a -> Map a (CompletionTree a)
_unCompletionTree CompletionTree a
ct)
instance (Ord a, Show a, ListLike a i) => Show (CompletionTree a) where
show :: CompletionTree a -> String
show CompletionTree a
ct = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (CompletionTree a -> [a]
forall a i. (Ord a, ListLike a i) => CompletionTree a -> [a]
toList CompletionTree a
ct)
fromList :: (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList :: [a] -> CompletionTree a
fromList [] = CompletionTree a
forall a. Monoid a => a
mempty
fromList (a
x:[a]
xs)
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
-> (Map a (CompletionTree a) -> Map a (CompletionTree a))
-> CompletionTree a
-> CompletionTree a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
forall a. Lens' (CompletionTree a) (Map a (CompletionTree a))
unCompletionTree (a
-> CompletionTree a
-> Map a (CompletionTree a)
-> Map a (CompletionTree a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
forall a. Monoid a => a
mempty CompletionTree a
forall a. Monoid a => a
mempty) ([a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList [a]
xs)
| Bool
otherwise = case (a -> a -> Ordering) -> [a] -> Maybe a
forall a. Eq a => (a -> a -> Ordering) -> [a] -> Maybe a
maximumBy' (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering) -> (a -> Int) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [a] -> a -> Int
forall a i. (ListLike a i, Eq i) => [a] -> a -> Int
childrenIn [a]
xs) ([a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall full item full'.
(ListLike full item, ListLike full' full) =>
full -> full'
LL.inits a
x) of
Maybe a
Nothing -> ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
-> (Map a (CompletionTree a) -> Map a (CompletionTree a))
-> CompletionTree a
-> CompletionTree a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
forall a. Lens' (CompletionTree a) (Map a (CompletionTree a))
unCompletionTree (a
-> CompletionTree a
-> Map a (CompletionTree a)
-> Map a (CompletionTree a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
x CompletionTree a
forall a. Monoid a => a
mempty) ([a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList [a]
xs)
Just a
parent -> case ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a
parent a -> a -> Bool
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Bool
`LL.isPrefixOf`) [a]
xs of
([a
_],[a]
rest) -> ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
-> (Map a (CompletionTree a) -> Map a (CompletionTree a))
-> CompletionTree a
-> CompletionTree a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
forall a. Lens' (CompletionTree a) (Map a (CompletionTree a))
unCompletionTree (a
-> CompletionTree a
-> Map a (CompletionTree a)
-> Map a (CompletionTree a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
parent CompletionTree a
forall a. Monoid a => a
mempty) (CompletionTree a -> CompletionTree a)
-> CompletionTree a -> CompletionTree a
forall a b. (a -> b) -> a -> b
$ [a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList [a]
rest
([a]
hasParent, [a]
rest) -> ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
-> (Map a (CompletionTree a) -> Map a (CompletionTree a))
-> CompletionTree a
-> CompletionTree a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(CompletionTree a)
(CompletionTree a)
(Map a (CompletionTree a))
(Map a (CompletionTree a))
forall a. Lens' (CompletionTree a) (Map a (CompletionTree a))
unCompletionTree (a
-> CompletionTree a
-> Map a (CompletionTree a)
-> Map a (CompletionTree a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
parent ([a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList ([a] -> CompletionTree a) -> [a] -> CompletionTree a
forall a b. (a -> b) -> a -> b
$
(a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Maybe a
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Maybe full
LL.stripPrefix a
parent) [a]
hasParent)) (CompletionTree a -> CompletionTree a)
-> CompletionTree a -> CompletionTree a
forall a b. (a -> b) -> a -> b
$ [a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList [a]
rest
where
childrenIn :: (ListLike a i, Eq i) => [a] -> a -> Int
childrenIn :: [a] -> a -> Int
childrenIn [a]
list a
parent = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
parent a -> a -> Bool
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Bool
`LL.isPrefixOf`) [a]
list
maximumBy' :: Eq a => (a -> a -> Ordering) -> [a] -> Maybe a
maximumBy' :: (a -> a -> Ordering) -> [a] -> Maybe a
maximumBy' a -> a -> Ordering
cmp [a]
l | Int -> (a -> Bool) -> [a] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atleast Int
2 (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
max') [a]
l = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
max'
where max' :: a
max' = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy a -> a -> Ordering
cmp [a]
l
atleast :: Int -> (a -> Bool) -> [a] -> Bool
atleast :: Int -> (a -> Bool) -> [a] -> Bool
atleast Int
0 a -> Bool
_ [a]
_ = Bool
True
atleast Int
_ a -> Bool
_ [] = Bool
False
atleast Int
n a -> Bool
cmp' (a
x:[a]
xs) | a -> Bool
cmp' a
x = Int -> (a -> Bool) -> [a] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atleast (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> Bool
cmp' [a]
xs
| Bool
otherwise = Int -> (a -> Bool) -> [a] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atleast Int
n a -> Bool
cmp' [a]
xs
complete :: (Eq i, Ord a, ListLike a i) => CompletionTree a -> (a, CompletionTree a)
complete :: CompletionTree a -> (a, CompletionTree a)
complete (CompletionTree Map a (CompletionTree a)
ct)
| Map a (CompletionTree a) -> Int
forall k a. Map k a -> Int
M.size Map a (CompletionTree a)
ct Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = if (a, CompletionTree a) -> CompletionTree a
forall a b. (a, b) -> b
snd (Int -> Map a (CompletionTree a) -> (a, CompletionTree a)
forall k a. Int -> Map k a -> (k, a)
M.elemAt Int
0 Map a (CompletionTree a)
ct) CompletionTree a -> CompletionTree a -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionTree a
forall a. Monoid a => a
mempty
then Int -> Map a (CompletionTree a) -> (a, CompletionTree a)
forall k a. Int -> Map k a -> (k, a)
M.elemAt Int
0 Map a (CompletionTree a)
ct (a, CompletionTree a)
-> ((a, CompletionTree a) -> (a, CompletionTree a))
-> (a, CompletionTree a)
forall a b. a -> (a -> b) -> b
& (CompletionTree a -> Identity (CompletionTree a))
-> (a, CompletionTree a) -> Identity (a, CompletionTree a)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((CompletionTree a -> Identity (CompletionTree a))
-> (a, CompletionTree a) -> Identity (a, CompletionTree a))
-> CompletionTree a
-> (a, CompletionTree a)
-> (a, CompletionTree a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [a] -> CompletionTree a
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
fromList [a
forall a. Monoid a => a
mempty]
else Int -> Map a (CompletionTree a) -> (a, CompletionTree a)
forall k a. Int -> Map k a -> (k, a)
M.elemAt Int
0 Map a (CompletionTree a)
ct
| Bool
otherwise = (a
forall a. Monoid a => a
mempty,Map a (CompletionTree a) -> CompletionTree a
forall a. Map a (CompletionTree a) -> CompletionTree a
CompletionTree Map a (CompletionTree a)
ct)
update :: (Ord a, ListLike a i, Eq i) => CompletionTree a -> a -> CompletionTree a
update :: CompletionTree a -> a -> CompletionTree a
update (CompletionTree Map a (CompletionTree a)
ct) a
p
| a
forall a. Monoid a => a
mempty a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
p = String -> CompletionTree a
forall a. HasCallStack => String -> a
error String
"Can't update a CompletionTree with a mempty"
| Maybe (CompletionTree a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CompletionTree a)
one Bool -> Bool -> Bool
&& CompletionTree a
forall a. Monoid a => a
mempty CompletionTree a -> CompletionTree a -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (CompletionTree a) -> CompletionTree a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (CompletionTree a)
one = Map a (CompletionTree a) -> CompletionTree a
forall a. Map a (CompletionTree a) -> CompletionTree a
CompletionTree (Map a (CompletionTree a) -> CompletionTree a)
-> Map a (CompletionTree a) -> CompletionTree a
forall a b. (a -> b) -> a -> b
$ a -> CompletionTree a -> Map a (CompletionTree a)
forall k a. k -> a -> Map k a
M.singleton a
forall a. Monoid a => a
mempty CompletionTree a
forall a. Monoid a => a
mempty
| Maybe (CompletionTree a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CompletionTree a)
one = Maybe (CompletionTree a) -> CompletionTree a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (CompletionTree a)
one
| Maybe (CompletionTree a, a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CompletionTree a, a)
remaining = (CompletionTree a -> a -> CompletionTree a)
-> (CompletionTree a, a) -> CompletionTree a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CompletionTree a -> a -> CompletionTree a
forall a i.
(Ord a, ListLike a i, Eq i) =>
CompletionTree a -> a -> CompletionTree a
update ((CompletionTree a, a) -> CompletionTree a)
-> (CompletionTree a, a) -> CompletionTree a
forall a b. (a -> b) -> a -> b
$ Maybe (CompletionTree a, a) -> (CompletionTree a, a)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (CompletionTree a, a)
remaining
| Bool
otherwise = Map a (CompletionTree a) -> CompletionTree a
forall a. Map a (CompletionTree a) -> CompletionTree a
CompletionTree (Map a (CompletionTree a) -> CompletionTree a)
-> Map a (CompletionTree a) -> CompletionTree a
forall a b. (a -> b) -> a -> b
$ (Maybe a -> a)
-> Map (Maybe a) (CompletionTree a) -> Map a (CompletionTree a)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust
(Map (Maybe a) (CompletionTree a) -> Map a (CompletionTree a))
-> Map (Maybe a) (CompletionTree a) -> Map a (CompletionTree a)
forall a b. (a -> b) -> a -> b
$ (Maybe a -> CompletionTree a -> Bool)
-> Map (Maybe a) (CompletionTree a)
-> Map (Maybe a) (CompletionTree a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (Bool -> CompletionTree a -> Bool
forall a b. a -> b -> a
const (Bool -> CompletionTree a -> Bool)
-> (Maybe a -> Bool) -> Maybe a -> CompletionTree a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Bool
forall a. Maybe a -> Bool
isJust)
(Map (Maybe a) (CompletionTree a)
-> Map (Maybe a) (CompletionTree a))
-> Map (Maybe a) (CompletionTree a)
-> Map (Maybe a) (CompletionTree a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a)
-> Map a (CompletionTree a) -> Map (Maybe a) (CompletionTree a)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (a -> a -> Maybe a
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Maybe full
LL.stripPrefix a
p) Map a (CompletionTree a)
ct
where
one :: Maybe (CompletionTree a)
one = a -> Map a (CompletionTree a) -> Maybe (CompletionTree a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
p Map a (CompletionTree a)
ct
remaining :: Maybe (CompletionTree a, a)
remaining = [(CompletionTree a, a)] -> Maybe (CompletionTree a, a)
forall a. [a] -> Maybe a
listToMaybe ([(CompletionTree a, a)] -> Maybe (CompletionTree a, a))
-> ([Maybe (CompletionTree a, a)] -> [(CompletionTree a, a)])
-> [Maybe (CompletionTree a, a)]
-> Maybe (CompletionTree a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (CompletionTree a, a)] -> [(CompletionTree a, a)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CompletionTree a, a)] -> Maybe (CompletionTree a, a))
-> [Maybe (CompletionTree a, a)] -> Maybe (CompletionTree a, a)
forall a b. (a -> b) -> a -> b
$
(a -> Maybe (CompletionTree a, a))
-> [a] -> [Maybe (CompletionTree a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
p' -> (,Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> Maybe a
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Maybe full
LL.stripPrefix a
p' a
p) (CompletionTree a -> (CompletionTree a, a))
-> Maybe (CompletionTree a) -> Maybe (CompletionTree a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Map a (CompletionTree a) -> Maybe (CompletionTree a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
p' Map a (CompletionTree a)
ct) ([a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall full item full'.
(ListLike full item, ListLike full' full) =>
full -> full'
LL.inits a
p)
toList :: (Ord a, ListLike a i) => CompletionTree a -> [a]
toList :: CompletionTree a -> [a]
toList CompletionTree a
ct
| CompletionTree a
forall a. Monoid a => a
mempty CompletionTree a -> CompletionTree a -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionTree a
ct = []
| Bool
otherwise = CompletionTree a -> [a]
forall a i. (Ord a, ListLike a i) => CompletionTree a -> [a]
toList' CompletionTree a
ct
where
toList' :: (Ord a, ListLike a i) => CompletionTree a -> [a]
toList' :: CompletionTree a -> [a]
toList' (CompletionTree Map a (CompletionTree a)
ct')
| Map a (CompletionTree a) -> Bool
forall k a. Map k a -> Bool
M.null Map a (CompletionTree a)
ct' = [a
forall a. Monoid a => a
mempty]
| Bool
otherwise = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ Map a [a] -> [[a]]
forall k a. Map k a -> [a]
M.elems (Map a [a] -> [[a]]) -> Map a [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (a -> CompletionTree a -> [a])
-> Map a (CompletionTree a) -> Map a [a]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\a
k CompletionTree a
v -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
k a -> a -> a
forall full item. ListLike full item => full -> full -> full
`LL.append`) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ CompletionTree a -> [a]
forall a i. (Ord a, ListLike a i) => CompletionTree a -> [a]
toList' CompletionTree a
v) Map a (CompletionTree a)
ct'
pretty :: Show a => CompletionTree a -> String
pretty :: CompletionTree a -> String
pretty (CompletionTree Map a (CompletionTree a)
ct)
| Map a (CompletionTree a) -> Bool
forall k a. Map k a -> Bool
M.null Map a (CompletionTree a)
ct = String
""
| Bool
otherwise = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (Map a String -> [String]
forall k a. Map k a -> [a]
M.elems ((a -> CompletionTree a -> String)
-> Map a (CompletionTree a) -> Map a String
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\a
k CompletionTree a
v -> a -> ShowS
forall a. Show a => a -> ShowS
shows a
k (CompletionTree a -> String
forall a. Show a => CompletionTree a -> String
pretty CompletionTree a
v)) Map a (CompletionTree a)
ct)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"