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

    -- |
    -- Module      :  Yi.TextCompletion
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Module providing text completion functions.

    module Yi.TextCompletion (
            -- * Word completion
            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)

    -- ---------------------------------------------------------------------
    -- | Word completion
    --
    -- when doing keyword completion, we need to keep track of the word
    -- we're trying to complete.

    newtype Completion = Completion
          [T.Text] -- the list of all possible things we can complete to.
                   -- (this seems very inefficient; but we use laziness to
                   -- our advantage)
        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
    $cshowsPrec :: Int -> Completion -> ShowS
    showsPrec :: Int -> Completion -> ShowS
    $cshow :: Completion -> String
    show :: Completion -> String
    $cshowList :: [Completion] -> ShowS
    showList :: [Completion] -> ShowS
    Show, Completion -> Completion -> Bool
    (Completion -> Completion -> Bool)
    -> (Completion -> Completion -> Bool) -> Eq Completion
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Completion -> Completion -> Bool
    == :: Completion -> Completion -> Bool
    $c/= :: Completion -> Completion -> Bool
    /= :: 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

    -- TODO: put this in keymap state instead
    instance Default Completion where
        def :: Completion
    def = [Text] -> Completion
    Completion []

    instance YiVariable Completion

    -- | Switch out of completion mode.
    resetComplete :: EditorM ()
    resetComplete :: EditorM ()
    resetComplete = Completion -> EditorM ()
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Functor m) =>
    a -> m ()
    putEditorDyn ([Text] -> Completion
    Completion [])

    -- | Try to complete the current word with occurrences found elsewhere in the
    -- editor. Further calls try other options.
    mkWordComplete :: YiM T.Text -- ^ Extract function
                   -> (T.Text -> YiM [T.Text]) -- ^ Source function
                   -> ([T.Text] -> YiM ()) -- ^ Message function
                   -> (T.Text -> T.Text -> Bool) -- ^ Predicate matcher
                   -> 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 complList <- EditorM Completion -> YiM Completion
    forall a. EditorM a -> YiM a
    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 complList of
        (Text
    x:[Text]
    xs) -> do -- more alternatives, use them.
           [Text] -> YiM ()
    msgFn (Text
    xText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    xs)
           EditorM () -> YiM ()
    forall a. EditorM a -> YiM a
    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 a. a -> YiM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    x
        [] -> do -- no alternatives, build them.
          w <- YiM Text
    extractFn
          ws <- sourceFn w
          let 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]
          putEditorDyn $ Completion comps
          -- We put 'w' back at the end so we go back to it after seeing
          -- all possibilities.

          -- to pick the 1st possibility.
          mkWordComplete extractFn sourceFn msgFn 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 a. EditorM a -> YiM a
    forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
    withEditor EditorM [Text]
    wordsForCompletion)
                     (\[Text]
    _ -> () -> YiM ()
    forall a. a -> YiM a
    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 a b. (a -> b) -> BufferM a -> BufferM b
    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
      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
      withEditor $ withCurrentBuffer $
        flip replaceRegionB x =<< regionOfPartB unitWord Backward

    wordComplete :: YiM ()
    wordComplete :: YiM ()
    wordComplete = Bool -> YiM ()
    wordComplete' Bool
    True

    ----------------------------
    -- Alternative Word Completion

    {-
      'completeWordB' is an alternative to 'wordCompleteB'.

      'completeWordB' offers a slightly different interface. The user
      completes the word using the mini-buffer in the same way a user
      completes a buffer or file name when switching buffers or opening a
      file. This means that it never guesses and completes only as much as
      it can without guessing.

      I think there is room for both approaches. The 'wordCompleteB' approach
      which just guesses the completion from a list of possible completion
      and then re-hitting the key-binding will cause it to guess again.
      I think this is very nice for things such as completing a word within
      a TeX-buffer. However using the mini-buffer might be nicer when we allow
      syntax knowledge to allow completion for example we may complete from
      a Hoogle database.
    -}
    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
    $c== :: CompletionScope -> CompletionScope -> Bool
    == :: CompletionScope -> CompletionScope -> Bool
    $c/= :: CompletionScope -> CompletionScope -> Bool
    /= :: 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
    $cshowsPrec :: Int -> CompletionScope -> ShowS
    showsPrec :: Int -> CompletionScope -> ShowS
    $cshow :: CompletionScope -> String
    show :: CompletionScope -> String
    $cshowList :: [CompletionScope] -> ShowS
    showList :: [CompletionScope] -> ShowS
    Show)

    {-
      This is a very quick and dirty way to complete the current word.
      It works in a similar way to the completion of words in the mini-buffer
      it uses the message buffer to give simple feedback such as,
      "Matches:" and "Complete, but not unique:"

      It is by no means perfect but it's also not bad, pretty usable.
    -}
    veryQuickCompleteWord :: CompletionScope -> EditorM ()
    veryQuickCompleteWord :: CompletionScope -> EditorM ()
    veryQuickCompleteWord CompletionScope
    scope = do
      (curWord, curWords) <- BufferM (Text, [Text]) -> EditorM (Text, [Text])
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer BufferM (Text, [Text])
    wordsAndCurrentWord
      allWords <- fmap concat $ withEveryBuffer $ words' <$> (R.toText <$> elemsB)
      let match :: T.Text -> Maybe T.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 = if CompletionScope
    scope CompletionScope -> CompletionScope -> Bool
    forall a. Eq a => a -> a -> Bool
    == CompletionScope
    FromCurrentBuffer
                              then [Text]
    curWords
                              else [Text]
    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 :: BufferM (Text, [Text])
    wordsAndCurrentWord =
      do 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
         curWord          <-
           fmap R.toText $ readRegionB =<< regionOfPartB unitWord Backward
         return (curWord, words' curText)

    wordsForCompletionInBuffer :: BufferM [T.Text]
    wordsForCompletionInBuffer :: BufferM [Text]
    wordsForCompletionInBuffer = do
      let readTextRegion :: Region -> BufferM Text
    readTextRegion = (YiString -> Text) -> BufferM YiString -> BufferM Text
    forall a b. (a -> b) -> BufferM a -> BufferM b
    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
      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
      below <- readTextRegion =<< regionOfPartB Document Forward
      return $ reverse (words' above) ++ words' below

    wordsForCompletion :: EditorM [T.Text]
    wordsForCompletion :: EditorM [Text]
    wordsForCompletion = do
        _ :| bs <- (FBuffer -> BufferRef) -> NonEmpty FBuffer -> NonEmpty BufferRef
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    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
        w0 <- withCurrentBuffer wordsForCompletionInBuffer
        contents <- forM bs $ \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)
        return $ w0 ++ concatMap words' 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
    . HasCallStack => Text -> Char
    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 a. Eq a => a -> [a] -> 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 ]
                    ]

    {-
      Finally obviously we wish to have a much more sophisticated completeword.
      One which spawns a mini-buffer and allows searching in Hoogle databases
      or in other files etc.
    -}