module Yi.Completion
( completeInList, completeInList'
, completeInListCustomShow
, commonPrefix
, prefixMatch, infixMatch
, subsequenceMatch
, containsMatch', containsMatch, containsMatchCaseInsensitive
, mkIsPrefixOf
)
where
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (on)
import qualified Data.Text as T
import Yi.Editor (EditorM, printMsg, printMsgs)
import Yi.String (commonTPrefix', showT)
import Yi.Utils
mkIsPrefixOf :: Bool
-> T.Text
-> T.Text
-> Bool
mkIsPrefixOf True = T.isPrefixOf
mkIsPrefixOf False = T.isPrefixOf `on` T.toCaseFold
prefixMatch :: T.Text -> T.Text -> Maybe T.Text
prefixMatch prefix s = if prefix `T.isPrefixOf` s then Just s else Nothing
infixMatch :: T.Text -> T.Text -> Maybe T.Text
infixMatch needle haystack = case T.breakOn needle haystack of
(_, t) -> if T.null t then Nothing else Just t
subsequenceMatch :: String -> String -> Bool
subsequenceMatch needle haystack = go needle haystack
where go (n:ns) (h:hs) | n == h = go ns hs
go (n:ns) (h:hs) | n /= h = go (n:ns) hs
go [] _ = True
go _ [] = False
go _ _ = False
containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text
containsMatch' caseSensitive pattern str =
const str <$> find (pattern `tstPrefix`) (T.tails str)
where
tstPrefix = mkIsPrefixOf caseSensitive
containsMatch :: T.Text -> T.Text -> Maybe T.Text
containsMatch = containsMatch' True
containsMatchCaseInsensitive :: T.Text -> T.Text -> Maybe T.Text
containsMatchCaseInsensitive = containsMatch' False
completeInList :: T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInList = completeInListCustomShow id
completeInListCustomShow :: (T.Text -> T.Text)
-> T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInListCustomShow showFunction s match possibilities
| null filtered = printMsg "No match" >> return s
| prefix /= s = return prefix
| isSingleton filtered = printMsg "Sole completion" >> return s
| prefix `elem` filtered =
printMsg ("Complete, but not unique: " <> showT filtered) >> return s
| otherwise = printMsgs (map showFunction filtered)
>> return (bestMatch filtered s)
where
prefix = commonTPrefix' filtered
filtered = filterMatches match possibilities
completeInList' :: T.Text
-> (T.Text -> Maybe T.Text)
-> [T.Text]
-> EditorM T.Text
completeInList' s match l = case filtered of
[] -> printMsg "No match" >> return s
[x] | s == x -> printMsg "Sole completion" >> return s
| otherwise -> return x
_ -> printMsgs filtered >> return (bestMatch filtered s)
where
filtered = filterMatches match l
bestMatch :: [T.Text] -> T.Text -> T.Text
bestMatch fs s = let p = commonTPrefix' fs
in if T.length p > T.length s then p else s
filterMatches :: Eq a => (b -> Maybe a) -> [b] -> [a]
filterMatches match = nub . catMaybes . fmap match
isSingleton :: [a] -> Bool
isSingleton [_] = True
isSingleton _ = False