module Development.IDE.Plugin.Plugins.FillHole
  ( suggestFillHole
  ) where

import           Control.Monad                             (guard)
import           Data.Char
import qualified Data.Text                                 as T
import           Development.IDE.Plugin.Plugins.Diagnostic
import           Language.LSP.Protocol.Types               (Diagnostic (..),
                                                            TextEdit (TextEdit))
import           Text.Regex.TDFA                           (MatchResult (..),
                                                            (=~))

suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]
suggestFillHole :: Diagnostic -> [(Text, TextEdit)]
suggestFillHole 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]
..}
    | Just Text
holeName <- Text -> Maybe Text
extractHoleName Text
_message
    , ([Text]
holeFits, [Text]
refFits) <- [Text] -> ([Text], [Text])
processHoleSuggestions (Text -> [Text]
T.lines Text
_message) =
      let isInfixHole :: Bool
isInfixHole = Text
_message Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
addBackticks Text
holeName :: Bool in
        (Text -> (Text, TextEdit)) -> [Text] -> [(Text, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
False Bool
isInfixHole) [Text]
holeFits
        [(Text, TextEdit)] -> [(Text, TextEdit)] -> [(Text, TextEdit)]
forall a. [a] -> [a] -> [a]
++ (Text -> (Text, TextEdit)) -> [Text] -> [(Text, TextEdit)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
True Bool
isInfixHole) [Text]
refFits
    | Bool
otherwise = []
    where
      extractHoleName :: Text -> Maybe Text
extractHoleName = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Text] -> Text
forall {a}. [Char] -> [a] -> a
headOrThrow [Char]
"impossible") (Maybe [Text] -> Maybe Text)
-> (Text -> Maybe [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Maybe [Text]) -> Text -> Text -> Maybe [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Maybe [Text]
matchRegexUnifySpaces Text
"Found hole: ([^ ]*)"
      addBackticks :: a -> a
addBackticks a
text = a
"`" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
text a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"`"
      addParens :: a -> a
addParens a
text = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
text a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
      proposeHoleFit :: Text -> Bool -> Bool -> Text -> (Text, TextEdit)
proposeHoleFit Text
holeName Bool
parenthise Bool
isInfixHole Text
name =
        case Text -> Maybe (Char, Text)
T.uncons Text
name of
          Maybe (Char, Text)
Nothing -> [Char] -> (Text, TextEdit)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: empty name provided by ghc"
          Just (Char
firstChr, Text
_) ->
            let isInfixOperator :: Bool
isInfixOperator = Char
firstChr Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
                name' :: Text
name' = Bool -> Bool -> Text -> Text
getOperatorNotation Bool
isInfixHole Bool
isInfixOperator Text
name in
              ( Text
"replace " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
holeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
              , Range -> Text -> TextEdit
TextEdit Range
_range (if Bool
parenthise then Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
addParens Text
name' else Text
name')
              )
      getOperatorNotation :: Bool -> Bool -> Text -> Text
getOperatorNotation Bool
True Bool
False Text
name                    = Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
addBackticks Text
name
      getOperatorNotation Bool
True Bool
True Text
name                     = Int -> Text -> Text
T.drop Int
1 (Int -> Text -> Text
T.dropEnd Int
1 Text
name)
      getOperatorNotation Bool
_isInfixHole Bool
_isInfixOperator Text
name = Text
name
      headOrThrow :: [Char] -> [a] -> a
headOrThrow [Char]
msg = \case
        [] -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
msg
        (a
x:[a]
_) -> a
x

processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text])
processHoleSuggestions :: [Text] -> ([Text], [Text])
processHoleSuggestions [Text]
mm = ([Text]
holeSuggestions, [Text]
refSuggestions)
{-
    • Found hole: _ :: LSP.Handlers

      Valid hole fits include def
      Valid refinement hole fits include
        fromMaybe (_ :: LSP.Handlers) (_ :: Maybe LSP.Handlers)
        fromJust (_ :: Maybe LSP.Handlers)
        haskell-lsp-types-0.22.0.0:Language.LSP.Types.Window.$sel:_value:ProgressParams (_ :: ProgressParams
                                                                                                        LSP.Handlers)
        T.foldl (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                (_ :: LSP.Handlers)
                (_ :: T.Text)
        T.foldl' (_ :: LSP.Handlers -> Char -> LSP.Handlers)
                 (_ :: LSP.Handlers)
                 (_ :: T.Text)
-}
  where
    t :: Text -> Text
t = forall a. a -> a
id @T.Text
    holeSuggestions :: [Text]
holeSuggestions = do
      -- get the text indented under Valid hole fits
      [Text]
validHolesSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include") [Text]
mm
      -- the Valid hole fits line can contain a hole fit
      Text
holeFitLine <-
        (Text -> Text) -> [Text] -> [Text]
forall {a}. (a -> a) -> [a] -> [a]
mapHead
            (MatchResult Text -> Text
forall a. MatchResult a -> a
mrAfter (MatchResult Text -> Text)
-> (Text -> MatchResult Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> MatchResult Text
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid (hole fits|substitutions) include"))
            [Text]
validHolesSection
      let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Text
holeFitLine
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
holeFit Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
"Some hole fits suppressed"
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
holeFit
      Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit
    refSuggestions :: [Text]
refSuggestions = do -- @[]
      -- get the text indented under Valid refinement hole fits
      [Text]
refinementSection <-
        (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy (Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
" *Valid refinement hole fits include") [Text]
mm
      case [Text]
refinementSection of
        [] -> [Char] -> [Text]
forall a. HasCallStack => [Char] -> a
error [Char]
"GHC provided invalid hole fit options"
        (Text
_:[Text]
refinementSection) -> do
          -- get the text for each hole fit
          [Text]
holeFitLines <- [Text] -> [[Text]]
getIndentedGroups [Text]
refinementSection
          let holeFit :: Text
holeFit = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
holeFitLines
          Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
holeFit Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> Text
t Text
"Some refinement hole fits suppressed"
          Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Text
holeFit

    mapHead :: (a -> a) -> [a] -> [a]
mapHead a -> a
f (a
a:[a]
aa) = a -> a
f a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
aa
    mapHead a -> a
_ []     = []

-- > getIndentedGroups [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1,", "  l1", "  l2"], [" H2", "  l3"]]
getIndentedGroups :: [T.Text] -> [[T.Text]]
getIndentedGroups :: [Text] -> [[Text]]
getIndentedGroups [] = []
getIndentedGroups ll :: [Text]
ll@(Text
l:[Text]
_) = (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
indentation Text
l) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
indentation) [Text]
ll
-- |
-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", "  l1", "  l2", " H2", "  l3"] = [[" H1", "  l1", "  l2"], [" H2", "  l3"]]
getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]]
getIndentedGroupsBy :: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
inp = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Bool
pred) [Text]
inp of
    (Text
l:[Text]
ll) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Text
l' -> Text -> Int
indentation Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
indentation Text
l') [Text]
ll of
        ([Text]
indented, [Text]
rest) -> (Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
indented) [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Text] -> [[Text]]
getIndentedGroupsBy Text -> Bool
pred [Text]
rest
    [Text]
_ -> []

indentation :: T.Text -> Int
indentation :: Text -> Int
indentation = Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace