{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ide.Plugin.Cabal.Completion.Completer.Simple where

import           Control.Lens                                ((?~))
import           Data.Function                               ((&))
import qualified Data.List                                   as List
import           Data.Map                                    (Map)
import qualified Data.Map                                    as Map
import           Data.Maybe                                  (fromMaybe)
import           Data.Ord                                    (Down (Down))
import qualified Data.Text                                   as T
import           Ide.Logger                                  (Priority (..),
                                                              logWith)
import           Ide.Plugin.Cabal.Completion.Completer.Types
import           Ide.Plugin.Cabal.Completion.Types           (CabalPrefixInfo (..),
                                                              Log)
import qualified Language.LSP.Protocol.Lens                  as JL
import qualified Language.LSP.Protocol.Types                 as Compls (CompletionItem (..))
import qualified Language.LSP.Protocol.Types                 as LSP
import qualified Text.Fuzzy.Parallel                         as Fuzzy

-- | Completer to be used when no completion suggestions
--  are implemented for the field
noopCompleter :: Completer
noopCompleter :: Completer
noopCompleter Recorder (WithPriority Log)
_ CompleterData
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Completer to be used when no completion suggestions
--  are implemented for the field and a log message should be emitted.
errorNoopCompleter :: Log -> Completer
errorNoopCompleter :: Log -> Completer
errorNoopCompleter Log
l Recorder (WithPriority Log)
recorder CompleterData
_ = do
  forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning Log
l
  forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Completer to be used when a simple set of values
--  can be completed for a field.
constantCompleter :: [T.Text] -> Completer
constantCompleter :: [Text] -> Completer
constantCompleter [Text]
completions Recorder (WithPriority Log)
_ CompleterData
cData = do
  let prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData
      scored :: [Scored Text]
scored = Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
Fuzzy.defChunkSize Int
Fuzzy.defMaxResults (CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo) [Text]
completions
      range :: Range
range = CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scored a -> a
Fuzzy.original) [Scored Text]
scored

-- | Completer to be used for the field @name:@ value.
--
-- This is almost always the name of the cabal file. However,
-- it is not forbidden by the specification to have a different name,
-- it is just forbidden on hackage.
nameCompleter :: Completer
nameCompleter :: Completer
nameCompleter Recorder (WithPriority Log)
_ CompleterData
cData = do
  let scored :: [Scored Text]
scored = Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
Fuzzy.defChunkSize Int
Fuzzy.defMaxResults (CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo) [CabalPrefixInfo -> Text
completionFileName CabalPrefixInfo
prefInfo]
      prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData
      range :: Range
range = CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scored a -> a
Fuzzy.original) [Scored Text]
scored

-- | Completer to be used when a set of values with priority weights
-- attached to some values are to be completed for a field.
--
--  The higher the weight, the higher the priority to show
--  the value in the completion suggestion.
--
--  If the value does not occur in the weighted map its weight is defaulted to zero.
weightedConstantCompleter :: [T.Text] -> Map T.Text Double -> Completer
weightedConstantCompleter :: [Text] -> Map Text Double -> Completer
weightedConstantCompleter [Text]
completions Map Text Double
weights Recorder (WithPriority Log)
_ CompleterData
cData = do
  let scored :: [Text]
scored =
        if Int
perfectScore forall a. Ord a => a -> a -> Bool
> Int
0
          then
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Scored a -> a
Fuzzy.original forall a b. (a -> b) -> a -> b
$
              Int
-> Int
-> Text
-> [Text]
-> (Text -> Text -> Maybe Int)
-> [Scored Text]
Fuzzy.simpleFilter' Int
Fuzzy.defChunkSize Int
Fuzzy.defMaxResults Text
prefix [Text]
completions Text -> Text -> Maybe Int
customMatch
          else [Text]
topTenByWeight
      range :: Range
range = CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range) [Text]
scored
  where
    prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData
    prefix :: Text
prefix = CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo
    -- The perfect score is the score of the word matched with itself
    -- this should never return Nothing since we match the word with itself
    perfectScore :: Int
perfectScore = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"match is broken") forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Int
Fuzzy.match Text
prefix Text
prefix
    -- \| Since the best score is cut off at the perfect score, we use a custom match
    -- which allows for the score to be larger than the perfect score.
    --
    -- This is necessary since the weight is multiplied with the originally matched
    -- score and thus the calculated score may be larger than the perfect score.
    customMatch :: (T.Text -> T.Text -> Maybe Int)
    customMatch :: Text -> Text -> Maybe Int
customMatch Text
toSearch Text
searchSpace = do
      Int
matched <- Text -> Text -> Maybe Int
Fuzzy.match Text
toSearch Text
searchSpace
      let weight :: Double
weight = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
searchSpace Map Text Double
weights
      let score :: Int
score =
            forall a. Ord a => a -> a -> a
min
              Int
perfectScore
              (forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
matched forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
+ Double
weight)))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
score
    -- \| Sorts the list in descending order based on the map of weights and then
    -- returns the top ten items in the list
    topTenByWeight :: [T.Text]
    topTenByWeight :: [Text]
topTenByWeight = forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.assocs Map Text Double
weights

-- | Creates a CompletionItem with the given text as the label
-- where the completion item kind is keyword.
mkDefaultCompletionItem :: T.Text -> LSP.CompletionItem
mkDefaultCompletionItem :: Text -> CompletionItem
mkDefaultCompletionItem Text
label =
  LSP.CompletionItem
    { $sel:_label:CompletionItem :: Text
Compls._label = Text
label,
      $sel:_labelDetails:CompletionItem :: Maybe CompletionItemLabelDetails
Compls._labelDetails = forall a. Maybe a
Nothing,
      $sel:_kind:CompletionItem :: Maybe CompletionItemKind
Compls._kind = forall a. a -> Maybe a
Just CompletionItemKind
LSP.CompletionItemKind_Keyword,
      $sel:_tags:CompletionItem :: Maybe [CompletionItemTag]
Compls._tags = forall a. Maybe a
Nothing,
      $sel:_detail:CompletionItem :: Maybe Text
Compls._detail = forall a. Maybe a
Nothing,
      $sel:_documentation:CompletionItem :: Maybe (Text |? MarkupContent)
Compls._documentation = forall a. Maybe a
Nothing,
      $sel:_deprecated:CompletionItem :: Maybe Bool
Compls._deprecated = forall a. Maybe a
Nothing,
      $sel:_preselect:CompletionItem :: Maybe Bool
Compls._preselect = forall a. Maybe a
Nothing,
      $sel:_sortText:CompletionItem :: Maybe Text
Compls._sortText = forall a. Maybe a
Nothing,
      $sel:_filterText:CompletionItem :: Maybe Text
Compls._filterText = forall a. Maybe a
Nothing,
      $sel:_insertText:CompletionItem :: Maybe Text
Compls._insertText = forall a. Maybe a
Nothing,
      $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
Compls._insertTextFormat = forall a. Maybe a
Nothing,
      $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
Compls._insertTextMode = forall a. Maybe a
Nothing,
      $sel:_textEdit:CompletionItem :: Maybe (TextEdit |? InsertReplaceEdit)
Compls._textEdit = forall a. Maybe a
Nothing,
      $sel:_textEditText:CompletionItem :: Maybe Text
Compls._textEditText = forall a. Maybe a
Nothing,
      $sel:_additionalTextEdits:CompletionItem :: Maybe [TextEdit]
Compls._additionalTextEdits = forall a. Maybe a
Nothing,
      $sel:_commitCharacters:CompletionItem :: Maybe [Text]
Compls._commitCharacters = forall a. Maybe a
Nothing,
      $sel:_command:CompletionItem :: Maybe Command
Compls._command = forall a. Maybe a
Nothing,
      $sel:_data_:CompletionItem :: Maybe Value
Compls._data_ = forall a. Maybe a
Nothing
    }

-- | Returns a CompletionItem with the given starting position
--  and text to be inserted, where the displayed text is the same as the
--  inserted text.
mkSimpleCompletionItem :: LSP.Range -> T.Text -> LSP.CompletionItem
mkSimpleCompletionItem :: Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range Text
txt =
  Text -> CompletionItem
mkDefaultCompletionItem Text
txt
    forall a b. a -> (a -> b) -> b
& forall s a. HasTextEdit s a => Lens' s a
JL.textEdit forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a b. a -> a |? b
LSP.InL (Range -> Text -> TextEdit
LSP.TextEdit Range
range Text
txt)

-- | Returns a completionItem with the given starting position,
--  text to be inserted and text to be displayed in the completion suggestion.
mkCompletionItem :: LSP.Range -> T.Text -> T.Text -> LSP.CompletionItem
mkCompletionItem :: Range -> Text -> Text -> CompletionItem
mkCompletionItem Range
range Text
insertTxt Text
displayTxt =
  Text -> CompletionItem
mkDefaultCompletionItem Text
displayTxt
    forall a b. a -> (a -> b) -> b
& forall s a. HasTextEdit s a => Lens' s a
JL.textEdit forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a b. a -> a |? b
LSP.InL (Range -> Text -> TextEdit
LSP.TextEdit Range
range Text
insertTxt)