{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.TextCompletion (
wordComplete,
wordComplete',
wordCompleteString,
wordCompleteString',
mkWordComplete,
resetComplete,
completeWordB,
CompletionScope(..)
) where
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, isCasePrefixOf)
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, Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
(Int -> Completion -> ShowS)
-> (Completion -> String)
-> ([Completion] -> ShowS)
-> Show Completion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Completion] -> ShowS
$cshowList :: [Completion] -> ShowS
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> ShowS
$cshowsPrec :: Int -> Completion -> ShowS
Show, Completion -> Completion -> Bool
(Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool) -> Eq Completion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
Eq)
instance Binary Completion where
put :: Completion -> Put
put (Completion [Text]
ts) = [ByteString] -> Put
forall t. Binary t => t -> Put
put (Text -> ByteString
E.encodeUtf8 (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts)
get :: Get Completion
get = [Text] -> Completion
Completion ([Text] -> Completion)
-> ([ByteString] -> [Text]) -> [ByteString] -> Completion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
E.decodeUtf8 ([ByteString] -> Completion) -> Get [ByteString] -> Get Completion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get
instance Default Completion where
def :: Completion
def = [Text] -> Completion
Completion []
instance YiVariable Completion
resetComplete :: EditorM ()
resetComplete :: EditorM ()
resetComplete = Completion -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn ([Text] -> Completion
Completion [])
mkWordComplete :: YiM T.Text
-> (T.Text -> YiM [T.Text])
-> ([T.Text] -> YiM ())
-> (T.Text -> T.Text -> Bool)
-> YiM T.Text
mkWordComplete :: YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete YiM Text
extractFn Text -> YiM [Text]
sourceFn [Text] -> YiM ()
msgFn Text -> Text -> Bool
predMatch = do
Completion [Text]
complList <- EditorM Completion -> YiM Completion
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM Completion
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
case [Text]
complList of
(Text
x:[Text]
xs) -> do
[Text] -> YiM ()
msgFn (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (Completion -> EditorM ()) -> Completion -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Completion -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Completion -> YiM ()) -> Completion -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Completion
Completion [Text]
xs
Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
[] -> do
Text
w <- YiM Text
extractFn
[Text]
ws <- Text -> YiM [Text]
sourceFn Text
w
let comps :: [Text]
comps = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSet ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
matches Text
w) [Text]
ws) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
w]
Completion -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Completion -> YiM ()) -> Completion -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Completion
Completion [Text]
comps
YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete YiM Text
extractFn Text -> YiM [Text]
sourceFn [Text] -> YiM ()
msgFn Text -> Text -> Bool
predMatch
where matches :: Text -> Text -> Bool
matches Text
x Text
y = Text
x Text -> Text -> Bool
`predMatch` Text
y Bool -> Bool -> Bool
&& Text
xText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
y
wordCompleteString' :: Bool -> YiM T.Text
wordCompleteString' :: Bool -> YiM Text
wordCompleteString' Bool
caseSensitive =
YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete (BufferM Text -> YiM Text
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Text -> YiM Text) -> BufferM Text -> YiM Text
forall a b. (a -> b) -> a -> b
$
Region -> BufferM Text
textRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward)
(\Text
_ -> EditorM [Text] -> YiM [Text]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM [Text]
wordsForCompletion)
(\[Text]
_ -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(Bool -> Text -> Text -> Bool
isCasePrefixOf Bool
caseSensitive)
where
textRegion :: Region -> BufferM Text
textRegion = (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> (Region -> BufferM YiString) -> Region -> BufferM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB
wordCompleteString :: YiM T.Text
wordCompleteString :: YiM Text
wordCompleteString = Bool -> YiM Text
wordCompleteString' Bool
True
wordComplete' :: Bool -> YiM ()
wordComplete' :: Bool -> YiM ()
wordComplete' Bool
caseSensitive = do
YiString
x <- Text -> YiString
R.fromText (Text -> YiString) -> YiM Text -> YiM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> YiM Text
wordCompleteString' Bool
caseSensitive
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
(Region -> YiString -> BufferM ())
-> YiString -> Region -> BufferM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Region -> YiString -> BufferM ()
replaceRegionB YiString
x (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward
wordComplete :: YiM ()
wordComplete :: YiM ()
wordComplete = Bool -> YiM ()
wordComplete' Bool
True
completeWordB :: CompletionScope -> EditorM ()
completeWordB :: CompletionScope -> EditorM ()
completeWordB = CompletionScope -> EditorM ()
veryQuickCompleteWord
data CompletionScope = FromCurrentBuffer | FromAllBuffers
deriving (CompletionScope -> CompletionScope -> Bool
(CompletionScope -> CompletionScope -> Bool)
-> (CompletionScope -> CompletionScope -> Bool)
-> Eq CompletionScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionScope -> CompletionScope -> Bool
$c/= :: CompletionScope -> CompletionScope -> Bool
== :: CompletionScope -> CompletionScope -> Bool
$c== :: CompletionScope -> CompletionScope -> Bool
Eq, Int -> CompletionScope -> ShowS
[CompletionScope] -> ShowS
CompletionScope -> String
(Int -> CompletionScope -> ShowS)
-> (CompletionScope -> String)
-> ([CompletionScope] -> ShowS)
-> Show CompletionScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionScope] -> ShowS
$cshowList :: [CompletionScope] -> ShowS
show :: CompletionScope -> String
$cshow :: CompletionScope -> String
showsPrec :: Int -> CompletionScope -> ShowS
$cshowsPrec :: Int -> CompletionScope -> ShowS
Show)
veryQuickCompleteWord :: CompletionScope -> EditorM ()
veryQuickCompleteWord :: CompletionScope -> EditorM ()
veryQuickCompleteWord CompletionScope
scope = do
(Text
curWord, [Text]
curWords) <- BufferM (Text, [Text]) -> EditorM (Text, [Text])
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Text, [Text])
wordsAndCurrentWord
[Text]
allWords <- ([[Text]] -> [Text]) -> EditorM [[Text]] -> EditorM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (EditorM [[Text]] -> EditorM [Text])
-> EditorM [[Text]] -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ BufferM [Text] -> EditorM [[Text]]
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m [a]
withEveryBuffer (BufferM [Text] -> EditorM [[Text]])
-> BufferM [Text] -> EditorM [[Text]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
words' (Text -> [Text]) -> BufferM Text -> BufferM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB)
let match :: T.Text -> Maybe T.Text
match :: Text -> Maybe Text
match Text
x = if (Text
curWord Text -> Text -> Bool
`T.isPrefixOf` Text
x) Bool -> Bool -> Bool
&& (Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
curWord)
then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
else Maybe Text
forall a. Maybe a
Nothing
wordsToChooseFrom :: [Text]
wordsToChooseFrom = if CompletionScope
scope CompletionScope -> CompletionScope -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionScope
FromCurrentBuffer
then [Text]
curWords
else [Text]
allWords
Text
preText <- Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInList Text
curWord Text -> Maybe Text
match [Text]
wordsToChooseFrom
if Text -> Bool
T.null Text
curWord
then Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"No word to complete"
else BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (Text -> BufferM ()) -> Text -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> (Text -> YiString) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
curWord) Text
preText
wordsAndCurrentWord :: BufferM (T.Text, [T.Text])
wordsAndCurrentWord :: BufferM (Text, [Text])
wordsAndCurrentWord =
do Text
curText <- YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB
Text
curWord <-
(YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> BufferM YiString -> BufferM Text
forall a b. (a -> b) -> a -> b
$ Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward
(Text, [Text]) -> BufferM (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
curWord, Text -> [Text]
words' Text
curText)
wordsForCompletionInBuffer :: BufferM [T.Text]
wordsForCompletionInBuffer :: BufferM [Text]
wordsForCompletionInBuffer = do
let readTextRegion :: Region -> BufferM Text
readTextRegion = (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> (Region -> BufferM YiString) -> Region -> BufferM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB
Text
above <- Region -> BufferM Text
readTextRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Document Direction
Backward
Text
below <- Region -> BufferM Text
readTextRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Document Direction
Forward
[Text] -> BufferM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> BufferM [Text]) -> [Text] -> BufferM [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text -> [Text]
words' Text
above) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
words' Text
below
wordsForCompletion :: EditorM [T.Text]
wordsForCompletion :: EditorM [Text]
wordsForCompletion = do
BufferRef
_ :| [BufferRef]
bs <- (FBuffer -> BufferRef) -> NonEmpty FBuffer -> NonEmpty BufferRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey (NonEmpty FBuffer -> NonEmpty BufferRef)
-> EditorM (NonEmpty FBuffer) -> EditorM (NonEmpty BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM (NonEmpty FBuffer)
forall (m :: * -> *). MonadEditor m => m (NonEmpty FBuffer)
getBufferStack
[Text]
w0 <- BufferM [Text] -> EditorM [Text]
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM [Text]
wordsForCompletionInBuffer
[Text]
contents <- [BufferRef] -> (BufferRef -> EditorM Text) -> EditorM [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [BufferRef]
bs ((BufferRef -> EditorM Text) -> EditorM [Text])
-> (BufferRef -> EditorM Text) -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ \BufferRef
b -> BufferRef -> BufferM Text -> EditorM Text
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB)
[Text] -> EditorM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> EditorM [Text]) -> [Text] -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
w0 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
words' [Text]
contents
words' :: T.Text -> [T.Text]
words' :: Text -> [Text]
words' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Text -> Maybe Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Int
charClass (Char -> Maybe Int) -> (Text -> Char) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Int -> Maybe Int -> Bool)
-> (Char -> Maybe Int) -> Char -> Char -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Maybe Int
charClass)
charClass :: Char -> Maybe Int
charClass :: Char -> Maybe Int
charClass Char
c = ([GeneralCategory] -> Bool) -> [[GeneralCategory]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
[ [ GeneralCategory
UppercaseLetter, GeneralCategory
LowercaseLetter, GeneralCategory
TitlecaseLetter
, GeneralCategory
ModifierLetter, GeneralCategory
OtherLetter
, GeneralCategory
ConnectorPunctuation
, GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark, GeneralCategory
EnclosingMark
, GeneralCategory
DecimalNumber, GeneralCategory
LetterNumber, GeneralCategory
OtherNumber
]
, [ GeneralCategory
MathSymbol, GeneralCategory
CurrencySymbol, GeneralCategory
ModifierSymbol, GeneralCategory
OtherSymbol ]
]