{-# LANGUAGE OverloadedStrings #-}

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
_ = [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
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
  Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning Log
l
  [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
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
  [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CompletionItem] -> IO [CompletionItem])
-> [CompletionItem] -> IO [CompletionItem]
forall a b. (a -> b) -> a -> b
$ (Scored Text -> CompletionItem)
-> [Scored Text] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range (Text -> CompletionItem)
-> (Scored Text -> Text) -> Scored Text -> CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scored Text -> Text
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
  [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CompletionItem] -> IO [CompletionItem])
-> [CompletionItem] -> IO [CompletionItem]
forall a b. (a -> b) -> a -> b
$ (Scored Text -> CompletionItem)
-> [Scored Text] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Text -> CompletionItem
mkSimpleCompletionItem Range
range (Text -> CompletionItem)
-> (Scored Text -> Text) -> Scored Text -> CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scored Text -> Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          then
            (Scored Text -> Text) -> [Scored Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scored Text -> Text
forall a. Scored a -> a
Fuzzy.original ([Scored Text] -> [Text]) -> [Scored Text] -> [Text]
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
  [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CompletionItem] -> IO [CompletionItem])
-> [CompletionItem] -> IO [CompletionItem]
forall a b. (a -> b) -> a -> b
$ (Text -> CompletionItem) -> [Text] -> [CompletionItem]
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"match is broken") (Maybe Int -> Int) -> Maybe Int -> Int
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 = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
searchSpace Map Text Double
weights
      let score :: Int
score =
            Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
              Int
perfectScore
              (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
matched Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight)))
      Int -> Maybe Int
forall a. a -> Maybe a
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 = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
10 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Double) -> Text) -> [(Text, Double)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Text
forall a b. (a, b) -> a
fst ([(Text, Double)] -> [Text]) -> [(Text, Double)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Double) -> Down Double)
-> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Double -> Down Double
forall a. a -> Down a
Down (Double -> Down Double)
-> ((Text, Double) -> Double) -> (Text, Double) -> Down Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) ([(Text, Double)] -> [(Text, Double)])
-> [(Text, Double)] -> [(Text, Double)]
forall a b. (a -> b) -> a -> b
$ Map Text Double -> [(Text, Double)]
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 = Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing,
      $sel:_kind:CompletionItem :: Maybe CompletionItemKind
Compls._kind = CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
LSP.CompletionItemKind_Keyword,
      $sel:_tags:CompletionItem :: Maybe [CompletionItemTag]
Compls._tags = Maybe [CompletionItemTag]
forall a. Maybe a
Nothing,
      $sel:_detail:CompletionItem :: Maybe Text
Compls._detail = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_documentation:CompletionItem :: Maybe (Text |? MarkupContent)
Compls._documentation = Maybe (Text |? MarkupContent)
forall a. Maybe a
Nothing,
      $sel:_deprecated:CompletionItem :: Maybe Bool
Compls._deprecated = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:_preselect:CompletionItem :: Maybe Bool
Compls._preselect = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:_sortText:CompletionItem :: Maybe Text
Compls._sortText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_filterText:CompletionItem :: Maybe Text
Compls._filterText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_insertText:CompletionItem :: Maybe Text
Compls._insertText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
Compls._insertTextFormat = Maybe InsertTextFormat
forall a. Maybe a
Nothing,
      $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
Compls._insertTextMode = Maybe InsertTextMode
forall a. Maybe a
Nothing,
      $sel:_textEdit:CompletionItem :: Maybe (TextEdit |? InsertReplaceEdit)
Compls._textEdit = Maybe (TextEdit |? InsertReplaceEdit)
forall a. Maybe a
Nothing,
      $sel:_textEditText:CompletionItem :: Maybe Text
Compls._textEditText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_additionalTextEdits:CompletionItem :: Maybe [TextEdit]
Compls._additionalTextEdits = Maybe [TextEdit]
forall a. Maybe a
Nothing,
      $sel:_commitCharacters:CompletionItem :: Maybe [Text]
Compls._commitCharacters = Maybe [Text]
forall a. Maybe a
Nothing,
      $sel:_command:CompletionItem :: Maybe Command
Compls._command = Maybe Command
forall a. Maybe a
Nothing,
      $sel:_data_:CompletionItem :: Maybe Value
Compls._data_ = Maybe Value
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
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe (TextEdit |? InsertReplaceEdit)
 -> Identity (Maybe (TextEdit |? InsertReplaceEdit)))
-> CompletionItem -> Identity CompletionItem
forall s a. HasTextEdit s a => Lens' s a
Lens' CompletionItem (Maybe (TextEdit |? InsertReplaceEdit))
JL.textEdit ((Maybe (TextEdit |? InsertReplaceEdit)
  -> Identity (Maybe (TextEdit |? InsertReplaceEdit)))
 -> CompletionItem -> Identity CompletionItem)
-> (TextEdit |? InsertReplaceEdit)
-> CompletionItem
-> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TextEdit -> TextEdit |? InsertReplaceEdit
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
    CompletionItem
-> (CompletionItem -> CompletionItem) -> CompletionItem
forall a b. a -> (a -> b) -> b
& (Maybe (TextEdit |? InsertReplaceEdit)
 -> Identity (Maybe (TextEdit |? InsertReplaceEdit)))
-> CompletionItem -> Identity CompletionItem
forall s a. HasTextEdit s a => Lens' s a
Lens' CompletionItem (Maybe (TextEdit |? InsertReplaceEdit))
JL.textEdit ((Maybe (TextEdit |? InsertReplaceEdit)
  -> Identity (Maybe (TextEdit |? InsertReplaceEdit)))
 -> CompletionItem -> Identity CompletionItem)
-> (TextEdit |? InsertReplaceEdit)
-> CompletionItem
-> CompletionItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TextEdit -> TextEdit |? InsertReplaceEdit
forall a b. a -> a |? b
LSP.InL (Range -> Text -> TextEdit
LSP.TextEdit Range
range Text
insertTxt)