{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Completion
( completeInList, completeInList'
, completeInListCustomShow
, commonPrefix
, prefixMatch, infixUptoEndMatch
, subsequenceMatch, subsequenceTextMatch
, containsMatch', containsMatch, containsMatchCaseInsensitive
, isCasePrefixOf
)
where
import Data.Function (on)
import Data.List (find, nub)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T (Text, breakOn, isPrefixOf, length, null, tails, toCaseFold, splitAt)
import Yi.Editor (EditorM, printMsg, printMsgs)
import Yi.String (commonTPrefix', showT)
import Yi.Utils (commonPrefix)
isCasePrefixOf :: Bool
-> T.Text
-> T.Text
-> Bool
isCasePrefixOf :: Bool -> Text -> Text -> Bool
isCasePrefixOf True = Text -> Text -> Bool
T.isPrefixOf
isCasePrefixOf False = Text -> Text -> Bool
T.isPrefixOf (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toCaseFold
prefixMatch :: T.Text -> T.Text -> Maybe T.Text
prefixMatch :: Text -> Text -> Maybe Text
prefixMatch prefix :: Text
prefix s :: Text
s = if Text
prefix Text -> Text -> Bool
`T.isPrefixOf` Text
s then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s else Maybe Text
forall a. Maybe a
Nothing
infixUptoEndMatch :: T.Text -> T.Text -> Maybe T.Text
infixUptoEndMatch :: Text -> Text -> Maybe Text
infixUptoEndMatch "" haystack :: Text
haystack = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
haystack
infixUptoEndMatch needle :: Text
needle haystack :: Text
haystack = case Text -> Text -> (Text, Text)
T.breakOn Text
needle Text
haystack of
(_, t :: Text
t) -> if Text -> Bool
T.null Text
t then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
subsequenceMatch :: String -> String -> Bool
subsequenceMatch :: String -> String -> Bool
subsequenceMatch needle :: String
needle haystack :: String
haystack = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
go String
needle String
haystack
where go :: [a] -> [a] -> Bool
go (n :: a
n:ns :: [a]
ns) (h :: a
h:hs :: [a]
hs) | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h = [a] -> [a] -> Bool
go [a]
ns [a]
hs
go (n :: a
n:ns :: [a]
ns) (h :: a
h:hs :: [a]
hs) | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
h = [a] -> [a] -> Bool
go (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ns) [a]
hs
go [] _ = Bool
True
go _ [] = Bool
False
go _ _ = Bool
False
subsequenceTextMatch :: Text -> Text -> Bool
subsequenceTextMatch :: Text -> Text -> Bool
subsequenceTextMatch needle :: Text
needle haystack :: Text
haystack
| Text -> Bool
T.null Text
needle = Bool
True
| Text -> Bool
T.null Text
haystack = Bool
False
| Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
h = Text -> Text -> Bool
subsequenceTextMatch Text
ns Text
hs
| Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
h = Text -> Text -> Bool
subsequenceTextMatch Text
needle Text
hs
| Bool
otherwise = Bool
False
where
n,ns,h,hs :: Text
(n :: Text
n,ns :: Text
ns) = Int -> Text -> (Text, Text)
T.splitAt 1 Text
needle
(h :: Text
h,hs :: Text
hs) = Int -> Text -> (Text, Text)
T.splitAt 1 Text
haystack
containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text
containsMatch' :: Bool -> Text -> Text -> Maybe Text
containsMatch' caseSensitive :: Bool
caseSensitive pattern :: Text
pattern str :: Text
str =
Text -> Text -> Text
forall a b. a -> b -> a
const Text
str (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text
pattern Text -> Text -> Bool
`tstPrefix`) (Text -> [Text]
T.tails Text
str)
where
tstPrefix :: Text -> Text -> Bool
tstPrefix = Bool -> Text -> Text -> Bool
isCasePrefixOf Bool
caseSensitive
containsMatch :: T.Text -> T.Text -> Maybe T.Text
containsMatch :: Text -> Text -> Maybe Text
containsMatch = Bool -> Text -> Text -> Maybe Text
containsMatch' Bool
True
containsMatchCaseInsensitive :: T.Text -> T.Text -> Maybe T.Text
containsMatchCaseInsensitive :: Text -> Text -> Maybe Text
containsMatchCaseInsensitive = Bool -> Text -> Text -> Maybe Text
containsMatch' Bool
False
completeInList :: T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInList :: Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInList = (Text -> Text)
-> Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInListCustomShow Text -> Text
forall a. a -> a
id
completeInListCustomShow :: (T.Text -> T.Text)
-> T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInListCustomShow :: (Text -> Text)
-> Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInListCustomShow showFunction :: Text -> Text
showFunction s :: Text
s match :: Text -> Maybe Text
match possibilities :: [Text]
possibilities
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
filtered = Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg "No match" EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
| Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
s = Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
prefix
| [Text] -> Bool
forall a. [a] -> Bool
isSingleton [Text]
filtered = Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg "Sole completion" EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
| Text
prefix Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
filtered =
Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg ("Complete, but not unique: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showT [Text]
filtered) EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
| Bool
otherwise = [Text] -> EditorM ()
forall (m :: * -> *). MonadEditor m => [Text] -> m ()
printMsgs ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
showFunction [Text]
filtered)
EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text -> Text
bestMatch [Text]
filtered Text
s)
where
prefix :: Text
prefix = [Text] -> Text
commonTPrefix' [Text]
filtered
filtered :: [Text]
filtered = (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. Eq a => (b -> Maybe a) -> [b] -> [a]
filterMatches Text -> Maybe Text
match [Text]
possibilities
completeInList' :: T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInList' :: Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInList' s :: Text
s match :: Text -> Maybe Text
match l :: [Text]
l = case [Text]
filtered of
[] -> Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg "No match" EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
[x :: Text
x] | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x -> Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg "Sole completion" EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
| Bool
otherwise -> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
_ -> [Text] -> EditorM ()
forall (m :: * -> *). MonadEditor m => [Text] -> m ()
printMsgs [Text]
filtered EditorM () -> EditorM Text -> EditorM Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> EditorM Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text -> Text
bestMatch [Text]
filtered Text
s)
where
filtered :: [Text]
filtered = (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. Eq a => (b -> Maybe a) -> [b] -> [a]
filterMatches Text -> Maybe Text
match [Text]
l
bestMatch :: [T.Text] -> T.Text -> T.Text
bestMatch :: [Text] -> Text -> Text
bestMatch fs :: [Text]
fs s :: Text
s = let p :: Text
p = [Text] -> Text
commonTPrefix' [Text]
fs
in if Text -> Int
T.length Text
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
s then Text
p else Text
s
filterMatches :: Eq a => (b -> Maybe a) -> [b] -> [a]
filterMatches :: (b -> Maybe a) -> [b] -> [a]
filterMatches match :: b -> Maybe a
match = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> ([b] -> [a]) -> [b] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> ([b] -> [Maybe a]) -> [b] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe a) -> [b] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe a
match
isSingleton :: [a] -> Bool
isSingleton :: [a] -> Bool
isSingleton [_] = Bool
True
isSingleton _ = Bool
False