{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Cabal.LicenseSuggest
( licenseErrorSuggestion
, licenseErrorAction
, licenseNames
, T.Text
, Diagnostic(..)
)
where
import qualified Data.Map as Map
import qualified Data.Text as T
import Language.LSP.Protocol.Types (CodeAction (CodeAction),
CodeActionKind (CodeActionKind_QuickFix),
Diagnostic (..),
Position (Position),
Range (Range),
TextEdit (TextEdit), Uri,
WorkspaceEdit (WorkspaceEdit))
import Text.Regex.TDFA
import qualified Data.List as List
import Distribution.SPDX.LicenseId (licenseId)
import qualified Text.Fuzzy.Parallel as Fuzzy
licenseErrorAction
:: Int
-> Uri
-> Diagnostic
-> [CodeAction]
licenseErrorAction :: Int -> Uri -> Diagnostic -> [CodeAction]
licenseErrorAction Int
maxCompletions Uri
uri Diagnostic
diag =
(Text, Text) -> CodeAction
mkCodeAction ((Text, Text) -> CodeAction) -> [(Text, Text)] -> [CodeAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> [(Text, Text)]
licenseErrorSuggestion Int
maxCompletions (Diagnostic -> Text
_message Diagnostic
diag)
where
mkCodeAction :: (Text, Text) -> CodeAction
mkCodeAction (Text
original, Text
suggestion) =
let
adjustRange :: Range -> Range
adjustRange (Range (Position UInt
line UInt
col) Position
rangeTo) =
Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
line (UInt
col UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
original))) Position
rangeTo
title :: Text
title = Text
"Replace with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suggestion
tedit :: [TextEdit]
tedit = [Range -> Text -> TextEdit
TextEdit (Range -> Range
adjustRange (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ Diagnostic -> Range
_range Diagnostic
diag) (Text
suggestion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")]
edit :: WorkspaceEdit
edit = Maybe (Map Uri [TextEdit])
-> Maybe
[TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit]))
-> Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a b. (a -> b) -> a -> b
$ Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
uri [TextEdit]
tedit) Maybe
[TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
in Text
-> Maybe CodeActionKind
-> Maybe [Diagnostic]
-> Maybe Bool
-> Maybe CodeActionDisabled
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix) ([Diagnostic] -> Maybe [Diagnostic]
forall a. a -> Maybe a
Just []) Maybe Bool
forall a. Maybe a
Nothing Maybe CodeActionDisabled
forall a. Maybe a
Nothing (WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit
edit) Maybe Command
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing
licenseNames :: [T.Text]
licenseNames :: [Text]
licenseNames = (LicenseId -> Text) -> [LicenseId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (LicenseId -> String) -> LicenseId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LicenseId -> String
licenseId) [LicenseId
forall a. Bounded a => a
minBound .. LicenseId
forall a. Bounded a => a
maxBound]
licenseErrorSuggestion ::
Int
-> T.Text
-> [(T.Text, T.Text)]
licenseErrorSuggestion :: Int -> Text -> [(Text, Text)]
licenseErrorSuggestion Int
maxCompletions Text
msg =
((Text, Text, Text, [Text]) -> [Text]
getMatch ((Text, Text, Text, [Text]) -> [Text])
-> [(Text, Text, Text, [Text])] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
msg Text -> Text -> [(Text, Text, Text, [Text])]
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex) [[Text]] -> ([Text] -> [(Text, Text)]) -> [(Text, Text)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Text
original] ->
let matches :: [Text]
matches = (Scored Text -> Text) -> [Scored Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map 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] -> [Scored Text]
Fuzzy.simpleFilter Int
Fuzzy.defChunkSize Int
maxCompletions Text
original [Text]
licenseNames
in [(Text
original,Text
candidate) | Text
candidate <- (Text -> Int) -> [Text] -> [Text]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Text -> Text -> Int
lengthDistance Text
original) [Text]
matches]
[Text]
_ -> []
where
regex :: T.Text
regex :: Text
regex = Text
"Unknown SPDX license identifier: '(.*)'"
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text]
getMatch :: (Text, Text, Text, [Text]) -> [Text]
getMatch (Text
_, Text
_, Text
_, [Text]
results) = [Text]
results
lengthDistance :: Text -> Text -> Int
lengthDistance Text
original Text
x = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
original Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
x