module Development.IDE.Plugin.Plugins.FillTypeWildcard
  ( suggestFillTypeWildcard
  ) where

import           Data.Char
import qualified Data.Text                   as T
import           Language.LSP.Protocol.Types (Diagnostic (..),
                                              TextEdit (TextEdit))

suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)]
suggestFillTypeWildcard :: Diagnostic -> [(Text, TextEdit)]
suggestFillTypeWildcard Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
_range,Maybe [DiagnosticRelatedInformation]
Maybe [DiagnosticTag]
Maybe Value
Maybe Text
Maybe DiagnosticSeverity
Maybe CodeDescription
Maybe (Int32 |? Text)
Text
_severity :: Maybe DiagnosticSeverity
_code :: Maybe (Int32 |? Text)
_codeDescription :: Maybe CodeDescription
_source :: Maybe Text
_message :: Text
_tags :: Maybe [DiagnosticTag]
_relatedInformation :: Maybe [DiagnosticRelatedInformation]
_data_ :: Maybe Value
$sel:_code:Diagnostic :: Diagnostic -> Maybe (Int32 |? Text)
$sel:_codeDescription:Diagnostic :: Diagnostic -> Maybe CodeDescription
$sel:_data_:Diagnostic :: Diagnostic -> Maybe Value
$sel:_message:Diagnostic :: Diagnostic -> Text
$sel:_relatedInformation:Diagnostic :: Diagnostic -> Maybe [DiagnosticRelatedInformation]
$sel:_severity:Diagnostic :: Diagnostic -> Maybe DiagnosticSeverity
$sel:_source:Diagnostic :: Diagnostic -> Maybe Text
$sel:_tags:Diagnostic :: Diagnostic -> Maybe [DiagnosticTag]
..}
-- Foo.hs:3:8: error:
--     * Found type wildcard `_' standing for `p -> p1 -> p'
    | Text
"Found type wildcard" Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
" standing for " Text -> Text -> Bool
`T.isInfixOf` Text
_message
    , Text
typeSignature <- Text -> Text
extractWildCardTypeSignature Text
_message
        =  [(Text
"Use type signature: ‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeSignature Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’", Range -> Text -> TextEdit
TextEdit Range
_range Text
typeSignature)]
    | Bool
otherwise = []

-- | Extract the type and surround it in parentheses except in obviously safe cases.
--
-- Inferring when parentheses are actually needed around the type signature would
-- require understanding both the precedence of the context of the hole and of
-- the signature itself. Inserting them (almost) unconditionally is ugly but safe.
extractWildCardTypeSignature :: T.Text -> T.Text
extractWildCardTypeSignature :: Text -> Text
extractWildCardTypeSignature Text
msg
  | Bool
enclosed Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isApp Bool -> Bool -> Bool
|| Bool
isToplevelSig = Text
sig
  | Bool
otherwise                              = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    msgSigPart :: Text
msgSigPart      = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"standing for " Text
msg
    (Text
sig, Text
rest)     = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'’') (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'‘') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'‘') (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
msgSigPart
    -- If we're completing something like ‘foo :: _’ parens can be safely omitted.
    isToplevelSig :: Bool
isToplevelSig   = Text -> Bool
errorMessageRefersToToplevelHole Text
rest
    -- Parenthesize type applications, e.g. (Maybe Char).
    isApp :: Bool
isApp           = (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
sig
    -- Do not add extra parentheses to lists, tuples and already parenthesized types.
    enclosed :: Bool
enclosed        =
      case Text -> Maybe (Char, Text)
T.uncons Text
sig of
        Maybe (Char, Text)
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"GHC provided invalid type"
        Just (Char
firstChr, Text
_) -> Bool -> Bool
not (Text -> Bool
T.null Text
sig) Bool -> Bool -> Bool
&& (Char
firstChr, HasCallStack => Text -> Char
Text -> Char
T.last Text
sig) (Char, Char) -> [(Char, Char)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Char
'(', Char
')'), (Char
'[', Char
']')]

-- | Detect whether user wrote something like @foo :: _@ or @foo :: (_, Int)@.
-- The former is considered toplevel case for which the function returns 'True',
-- the latter is not toplevel and the returned value is 'False'.
--
-- When type hole is at toplevel then there’s a line starting with
-- "• In the type signature" which ends with " :: _" like in the
-- following snippet:
--
-- source/library/Language/Haskell/Brittany/Internal.hs:131:13: error:
--     • Found type wildcard ‘_’ standing for ‘HsDecl GhcPs’
--       To use the inferred type, enable PartialTypeSignatures
--     • In the type signature: decl :: _
--       In an equation for ‘splitAnnots’:
--           splitAnnots m@HsModule {hsmodAnn, hsmodDecls}
--             = undefined
--             where
--                 ann :: SrcSpanAnnA
--                 decl :: _
--                 L ann decl = head hsmodDecls
--     • Relevant bindings include
--       [REDACTED]
--
-- When type hole is not at toplevel there’s a stack of where
-- the hole was located ending with "In the type signature":
--
-- source/library/Language/Haskell/Brittany/Internal.hs:130:20: error:
--     • Found type wildcard ‘_’ standing for ‘GhcPs’
--       To use the inferred type, enable PartialTypeSignatures
--     • In the first argument of ‘HsDecl’, namely ‘_’
--       In the type ‘HsDecl _’
--       In the type signature: decl :: HsDecl _
--     • Relevant bindings include
--       [REDACTED]
errorMessageRefersToToplevelHole :: T.Text -> Bool
errorMessageRefersToToplevelHole :: Text -> Bool
errorMessageRefersToToplevelHole Text
msg =
  Bool -> Bool
not (Text -> Bool
T.null Text
prefix) Bool -> Bool -> Bool
&& Text
" :: _" Text -> Text -> Bool
`T.isSuffixOf` (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
rest
  where
    (Text
prefix, Text
rest) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"• In the type signature:" Text
msg