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

-- | 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 (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Uri
uri [TextEdit]
tedit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
      in Text
-> Maybe CodeActionKind
-> Maybe [Diagnostic]
-> Maybe Bool
-> Maybe (Rec (("reason" .== Text) .+ Empty))
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (forall a. a -> Maybe a
Just CodeActionKind
CodeActionKind_QuickFix) (forall a. a -> Maybe a
Just []) 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
Fuzzy.defChunkSize Int
Fuzzy.defMaxResults 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)