{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Cabal.LicenseSuggest
( licenseErrorSuggestion
, licenseErrorAction
, T.Text
, Diagnostic(..)
)
where
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import Language.LSP.Types (CodeAction (CodeAction),
CodeActionKind (CodeActionQuickFix),
Diagnostic (..), List (List),
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
:: Uri
-> Diagnostic
-> [CodeAction]
licenseErrorAction :: Uri -> Diagnostic -> [CodeAction]
licenseErrorAction Uri
uri Diagnostic
diag =
(Text, Text) -> CodeAction
mkCodeAction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, Text)]
licenseErrorSuggestion (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 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
original))) Position
rangeTo
title :: Text
title = Text
"Replace with " forall a. Semigroup a => a -> a -> a
<> Text
suggestion
tedit :: [TextEdit]
tedit = [Range -> Text -> TextEdit
TextEdit (Range -> Range
adjustRange forall a b. (a -> b) -> a -> b
$ Diagnostic -> Range
_range Diagnostic
diag) (Text
suggestion forall a. Semigroup a => a -> a -> a
<> Text
"\n")]
edit :: WorkspaceEdit
edit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
in Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []) forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just WorkspaceEdit
edit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
licenseNames :: [T.Text]
licenseNames :: [Text]
licenseNames = forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. LicenseId -> String
licenseId) [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
licenseErrorSuggestion ::
T.Text
-> [(T.Text, T.Text)]
licenseErrorSuggestion :: Text -> [(Text, Text)]
licenseErrorSuggestion Text
msg =
((Text, Text, Text, [Text]) -> [Text]
getMatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
msg forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
regex) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Text
original] ->
let matches :: [Text]
matches = forall a b. (a -> b) -> [a] -> [b]
map forall a. Scored a -> a
Fuzzy.original forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
1000 Int
10 Text
original [Text]
licenseNames
in [(Text
original,Text
candidate) | Text
candidate <- forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Text -> Text -> Text -> Ordering
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 -> Text -> Ordering
lengthDistance Text
original Text
x1 Text
x2 = forall a. Num a => a -> a
abs (Text -> Int
T.length Text
original forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
x1) forall a. Ord a => a -> a -> Ordering
`compare` forall a. Num a => a -> a
abs (Text -> Int
T.length Text
original forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
x2)