module Yi.TextCompletion (
wordComplete,
wordComplete',
wordCompleteString,
wordCompleteString',
mkWordComplete,
resetComplete,
completeWordB,
CompletionScope(..)
) where
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Data.Binary (Binary, get, put)
import Data.Char (GeneralCategory (..), generalCategory)
import Data.Default (Default, def)
import Data.Function (on)
import Data.List (findIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isJust)
import qualified Data.Text as T (Text, drop, groupBy, head, isPrefixOf, length, null)
import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8)
import Data.Typeable (Typeable)
import Yi.Buffer
import Yi.Completion (completeInList, mkIsPrefixOf)
import Yi.Editor
import Yi.Keymap (YiM)
import qualified Yi.Rope as R (fromText, toText)
import Yi.Types (YiVariable)
import Yi.Utils (nubSet)
newtype Completion = Completion
[T.Text]
deriving (Typeable, Show, Eq)
instance Binary Completion where
put (Completion ts) = put (E.encodeUtf8 <$> ts)
get = Completion . map E.decodeUtf8 <$> get
instance Default Completion where
def = Completion []
instance YiVariable Completion
resetComplete :: EditorM ()
resetComplete = putEditorDyn (Completion [])
mkWordComplete :: YiM T.Text
-> (T.Text -> YiM [T.Text])
-> ([T.Text] -> YiM ())
-> (T.Text -> T.Text -> Bool)
-> YiM T.Text
mkWordComplete extractFn sourceFn msgFn predMatch = do
Completion complList <- withEditor getEditorDyn
case complList of
(x:xs) -> do
msgFn (x:xs)
withEditor . putEditorDyn $ Completion xs
return x
[] -> do
w <- extractFn
ws <- sourceFn w
let comps = nubSet (filter (matches w) ws) ++ [w]
putEditorDyn $ Completion comps
mkWordComplete extractFn sourceFn msgFn predMatch
where matches x y = x `predMatch` y && x/=y
wordCompleteString' :: Bool -> YiM T.Text
wordCompleteString' caseSensitive =
mkWordComplete (withCurrentBuffer $
textRegion =<< regionOfPartB unitWord Backward)
(\_ -> withEditor wordsForCompletion)
(\_ -> return ())
(mkIsPrefixOf caseSensitive)
where
textRegion = fmap R.toText . readRegionB
wordCompleteString :: YiM T.Text
wordCompleteString = wordCompleteString' True
wordComplete' :: Bool -> YiM ()
wordComplete' caseSensitive = do
x <- R.fromText <$> wordCompleteString' caseSensitive
withEditor $ withCurrentBuffer $
flip replaceRegionB x =<< regionOfPartB unitWord Backward
wordComplete :: YiM ()
wordComplete = wordComplete' True
completeWordB :: CompletionScope -> EditorM ()
completeWordB = veryQuickCompleteWord
data CompletionScope = FromCurrentBuffer | FromAllBuffers
deriving (Eq, Show)
veryQuickCompleteWord :: CompletionScope -> EditorM ()
veryQuickCompleteWord scope = do
(curWord, curWords) <- withCurrentBuffer wordsAndCurrentWord
allWords <- fmap concat $ withEveryBuffer $ words' <$> (R.toText <$> elemsB)
let match :: T.Text -> Maybe T.Text
match x = if (curWord `T.isPrefixOf` x) && (x /= curWord)
then Just x
else Nothing
wordsToChooseFrom = if scope == FromCurrentBuffer
then curWords
else allWords
preText <- completeInList curWord match wordsToChooseFrom
if T.null curWord
then printMsg "No word to complete"
else withCurrentBuffer . insertN . R.fromText $ T.drop (T.length curWord) preText
wordsAndCurrentWord :: BufferM (T.Text, [T.Text])
wordsAndCurrentWord =
do curText <- R.toText <$> elemsB
curWord <-
fmap R.toText $ readRegionB =<< regionOfPartB unitWord Backward
return (curWord, words' curText)
wordsForCompletionInBuffer :: BufferM [T.Text]
wordsForCompletionInBuffer = do
let readTextRegion = fmap R.toText . readRegionB
above <- readTextRegion =<< regionOfPartB Document Backward
below <- readTextRegion =<< regionOfPartB Document Forward
return $ reverse (words' above) ++ words' below
wordsForCompletion :: EditorM [T.Text]
wordsForCompletion = do
_ :| bs <- fmap bkey <$> getBufferStack
w0 <- withCurrentBuffer wordsForCompletionInBuffer
contents <- forM bs $ \b -> withGivenBuffer b (R.toText <$> elemsB)
return $ w0 ++ concatMap words' contents
words' :: T.Text -> [T.Text]
words' = filter (isJust . charClass . T.head) . T.groupBy ((==) `on` charClass)
charClass :: Char -> Maybe Int
charClass c = findIndex (generalCategory c `elem`)
[ [ UppercaseLetter, LowercaseLetter, TitlecaseLetter
, ModifierLetter, OtherLetter
, ConnectorPunctuation
, NonSpacingMark, SpacingCombiningMark, EnclosingMark
, DecimalNumber, LetterNumber, OtherNumber
]
, [ MathSymbol, CurrencySymbol, ModifierSymbol, OtherSymbol ]
]