{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExplicitNamespaces  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
module Ide.Plugin.Cabal.LicenseSuggest
( licenseErrorSuggestion
, licenseErrorAction
  -- * Re-exports
, 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

-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
--   if it represents an "Unknown SPDX license identifier"-error along
--   with a suggestion, then return a 'CodeAction' for replacing the
--   the incorrect license identifier with the suggestion.
licenseErrorAction
  :: Uri
  -- ^ File for which the diagnostic was generated
  -> Diagnostic
  -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
  -> [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
        -- The Cabal parser does not output the _range_ of the incorrect license identifier,
        -- only a single source code position. Consequently, in 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
        -- we define the range to be from the returned position the first column of the next line.
        -- Since the "replace" code action replaces this range, we need to modify the range to
        -- start at the first character of the invalid license identifier. We achieve this by
        -- subtracting the length of the identifier from the beginning of the range.
        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
        -- We must also add a newline character to the replacement since the range returned by
        -- 'Ide.Plugin.Cabal.Diag.errorDiagnostic' ends at the beginning of the following line.
        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

-- | License name of every license supported by cabal
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]

-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
--   provide possible corrections for SPDX license identifiers
--   based on the list specified in Cabal.
--   Results are sorted by best fit, and prefer solutions that have smaller
--   length distance to the original word.
--
-- >>> take 2 $ licenseErrorSuggestion (T.pack "Unknown SPDX license identifier: 'BSD3'")
-- [("BSD3","BSD-3-Clause"),("BSD3","BSD-3-Clause-LBNL")]
licenseErrorSuggestion ::
  T.Text
  -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
  -> [(T.Text, T.Text)]
  -- ^ (Original (incorrect) license identifier, suggested replacement)
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)