{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      :  Yi.CompletionTree
License     :  GPL-2
Maintainer  :  yi-devel@googlegroups.com
Stability   :  experimental
Portability :  portable

Little helper for completion interfaces.

Intended to be imported qualified:

>import qualified Yi.CompletionTree as CT
-}
module Yi.CompletionTree (
  -- * CompletionTree type
  CompletionTree (CompletionTree),
  -- * Lists
  fromList, toList,
  -- * Modification
  complete, update,
  -- * Debugging
  pretty,
  -- ** Lens
  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)

-- | A CompletionTree is a map of partial completions.
--
-- Example:
--
-- fromList ["put","putStr","putStrLn","print","abc"]
--
-- Gives the following tree:
--
--            / \
--          "p" "abc"
--         /  \
--      "ut"  "rint"
--      /  \
--   "Str"  ""
--   /  \
-- "Ln"  ""
--
-- (The empty strings are needed to denote the end of a word)
-- (A CompletionTree is not limited to a binary tree)
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)

-- | This function converts a list of completable elements to a CompletionTree
-- It finds elements that share a common prefix and groups them.
--
-- prop> fromList . toList = id
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
      -- A parent is the prefix and the children are the items with the parent as prefix
      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

-- | The largest element of a non-empty structure with respect to the
-- given comparison function, Nothing if there are multiple 'largest' elements.
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
         -- This short-circuits if the condition is met n times before the end of the list.
         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 as much as possible without guessing.
--
-- Examples:
--
-- >>> complete $ fromList ["put","putStrLn","putStr"]
-- ("put", fromList ["","Str","StrLn"])
--
-- >>> complete $ fromList ["put","putStr","putStrLn","abc"]
-- ("", fromList ["put","putStr","putStrLn","abc"])
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 the CompletionTree with new information.
-- An empty list means that there is no completion left.
-- A [mempty] means that the end of a word is reached.
--
-- Examples:
--
-- >>> update (fromList ["put","putStr"]) "p"
-- fromList ["ut","utStr"]
--
-- >>> update (fromList ["put","putStr"]) "put"
-- fromList ["","Str"]
--
-- >>> update (fromList ["put","putStr"]) "putS"
-- fromList ["tr"]
--
-- >>> update (fromList ["put"]) "find"
-- fromList []
--
-- >>> update (fromList ["put"]) "put"
-- fromList [""]
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
  -- p is empty, this case just doesn't make sense:
  | 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"
  -- p is a key in the map ct that doesn't have children:
  -- (This means the end of a word is reached)
  | 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
  -- p is a key in the map ct with children:
  | 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
  -- a substring of p is a key in ct:
  | 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
  -- p is a substring of a key in ct:
  | 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)

-- | Converts a CompletionTree to a list of completions.
--
-- prop> toList . fromList = sort . nub
--
-- Examples:
--
-- >>> toList mempty
-- []
--
-- >>> toList (fromList ["a"])
-- ["a"]
--
-- >>> toList (fromList ["a","a","a"])
-- ["a"]
--
-- >>> toList (fromList ["z","x","y"])
-- ["x","y","z"]
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'

-- TODO: make this function display a tree and rename to showTree
-- | For debugging purposes.
--
-- Example:
--
-- >>> putStrLn $ pretty $ fromList ["put", "putStr", "putStrLn"]
-- ["put"[""|"Str"[""|"Ln"]]]
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
"]"