{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Completion
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Collection of functions for completion and matching.

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)


-------------------------------------------
-- General completion

-- | Like usual 'T.isPrefixOf' but user can specify case sensitivity.
-- See 'T.toCaseFold' for exotic unicode gotchas.
isCasePrefixOf :: Bool -- ^ Is case-sensitive?
             -> T.Text
             -> T.Text
             -> Bool
isCasePrefixOf :: Bool -> Text -> Text -> Bool
isCasePrefixOf Bool
True = Text -> Text -> Bool
T.isPrefixOf
isCasePrefixOf Bool
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

-- | Prefix matching function, for use with 'completeInList'
prefixMatch :: T.Text -> T.Text -> Maybe T.Text
prefixMatch :: Text -> Text -> Maybe Text
prefixMatch Text
prefix 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

-- | Text from the match up to the end, for use with 'completeInList'
infixUptoEndMatch :: T.Text -> T.Text -> Maybe T.Text
infixUptoEndMatch :: Text -> Text -> Maybe Text
infixUptoEndMatch Text
"" Text
haystack = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
haystack
infixUptoEndMatch Text
needle Text
haystack = case Text -> Text -> (Text, Text)
T.breakOn Text
needle Text
haystack of
  (Text
_, 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

-- | A simple fuzzy match algorithm. Example: "abc" matches "a1b2c"
subsequenceMatch :: String -> String -> Bool
subsequenceMatch :: String -> String -> Bool
subsequenceMatch String
needle String
haystack = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
go String
needle String
haystack
  where go :: [a] -> [a] -> Bool
go (a
n:[a]
ns) (a
h:[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 (a
n:[a]
ns) (a
h:[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 [] [a]
_ = Bool
True
        go [a]
_ [] = Bool
False
        go [a]
_ [a]
_  = Bool
False

-- | A simple fuzzy match algorithm. Example: "abc" matches "a1b2c"
subsequenceTextMatch :: Text -> Text -> Bool
subsequenceTextMatch :: Text -> Text -> Bool
subsequenceTextMatch Text
needle 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
    (Text
n,Text
ns) = Int -> Text -> (Text, Text)
T.splitAt Int
1 Text
needle
    (Text
h,Text
hs) = Int -> Text -> (Text, Text)
T.splitAt Int
1 Text
haystack


-- | TODO: this is a terrible function, isn't this just
-- case-insensitive infix? – Fūzetsu
containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text
containsMatch' :: Bool -> Text -> Text -> Maybe Text
containsMatch' Bool
caseSensitive Text
pattern 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


-- | Complete a string given a user input string, a matching function
-- and a list of possibilites. Matching function should return the
-- part of the string that matches the user string.
completeInList :: T.Text -- ^ Input to match on
               -> (T.Text -> Maybe T.Text) -- ^ matcher function
               -> [T.Text] -- ^ items to match against
               -> 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

-- | Same as 'completeInList', but maps @showFunction@ on possible
-- matches when printing
completeInListCustomShow :: (T.Text -> T.Text) -- ^ Show function
                         -> T.Text -- ^ Input to match on
                         -> (T.Text -> Maybe T.Text) -- ^ matcher function
                         -> [T.Text] -- ^ items to match against
                         -> EditorM T.Text
completeInListCustomShow :: (Text -> Text)
-> Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInListCustomShow Text -> Text
showFunction Text
s Text -> Maybe Text
match [Text]
possibilities
    | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
filtered = Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"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 Text
"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 (Text
"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' Text
s Text -> Maybe Text
match [Text]
l = case [Text]
filtered of
  [] -> Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"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
x] | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x    -> Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"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]
_ -> [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

-- | This function attempts to provide a better tab completion result in
-- cases where more than one file matches our prefix. Consider directory with
-- following files: @["Main.hs", "Main.hi", "Main.o", "Test.py", "Foo.hs"]@.
--
-- After inserting @Mai@ into the minibuffer and attempting to complete, the
-- possible matches will be filtered in 'completeInList'' to
-- @["Main.hs", "Main.hi", "Main.o"]@ however because of multiple matches,
-- the buffer will not be updated to say @Main.@ but will instead stay at @Mai@.
--
-- This is extremely tedious when trying to complete filenames in directories
-- with many files so here we try to catch common prefixes of filtered files and
-- if the result is longer than what we have, we use it instead.
bestMatch :: [T.Text] -> T.Text -> T.Text
bestMatch :: [Text] -> Text -> Text
bestMatch [Text]
fs 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 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

-- Not really necessary but a bit faster than @(length l) == 1@
isSingleton :: [a] -> Bool
isSingleton :: [a] -> Bool
isSingleton [a
_] = Bool
True
isSingleton [a]
_   = Bool
False