{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
module Ide.Plugin.Class
  ( descriptor
  ) where

import           Control.Applicative
import           Control.Lens                            hiding (List, use)
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import           Data.Char
import           Data.List
import qualified Data.Map.Strict                         as Map
import           Data.Maybe
import qualified Data.Text                               as T
import qualified Data.Set                                as Set
import           Development.IDE                         hiding (pluginHandlers)
import           Development.IDE.Core.PositionMapping    (fromCurrentRange,
                                                          toCurrentRange)
import           Development.IDE.GHC.Compat              as Compat hiding (locA)
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.Spans.AtPoint
import qualified GHC.Generics                            as Generics
import           Ide.PluginUtils
import           Ide.Types
import           Language.Haskell.GHC.ExactPrint
import           Language.Haskell.GHC.ExactPrint.Parsers (parseDecl)
import           Language.Haskell.GHC.ExactPrint.Types   hiding (GhcPs, Parens)
import           Language.Haskell.GHC.ExactPrint.Utils   (rs)
import           Language.LSP.Server
import           Language.LSP.Types
import qualified Language.LSP.Types.Lens                 as J

#if MIN_VERSION_ghc(9,2,0)
import           GHC.Hs                                  (AnnsModule(AnnsModule))
import           GHC.Parser.Annotation
#endif

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState]
commands
  , pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCodeAction
-> PluginMethodHandler IdeState 'TextDocumentCodeAction
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction
  }

commands :: [PluginCommand IdeState]
commands :: [PluginCommand IdeState]
commands
  = [ CommandId
-> Text
-> CommandFunction IdeState AddMinimalMethodsParams
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
"addMinimalMethodPlaceholders" Text
"add placeholders for minimal methods" CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders
    ]

-- | Parameter for the addMethods PluginCommand.
data AddMinimalMethodsParams = AddMinimalMethodsParams
  { AddMinimalMethodsParams -> Uri
uri         :: Uri
  , AddMinimalMethodsParams -> Range
range       :: Range
  , AddMinimalMethodsParams -> List Text
methodGroup :: List T.Text
  }
  deriving (Int -> AddMinimalMethodsParams -> ShowS
[AddMinimalMethodsParams] -> ShowS
AddMinimalMethodsParams -> String
(Int -> AddMinimalMethodsParams -> ShowS)
-> (AddMinimalMethodsParams -> String)
-> ([AddMinimalMethodsParams] -> ShowS)
-> Show AddMinimalMethodsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddMinimalMethodsParams] -> ShowS
$cshowList :: [AddMinimalMethodsParams] -> ShowS
show :: AddMinimalMethodsParams -> String
$cshow :: AddMinimalMethodsParams -> String
showsPrec :: Int -> AddMinimalMethodsParams -> ShowS
$cshowsPrec :: Int -> AddMinimalMethodsParams -> ShowS
Show, AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
(AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool)
-> (AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool)
-> Eq AddMinimalMethodsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
$c/= :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
== :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
$c== :: AddMinimalMethodsParams -> AddMinimalMethodsParams -> Bool
Eq, (forall x.
 AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x)
-> (forall x.
    Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams)
-> Generic AddMinimalMethodsParams
forall x. Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams
forall x. AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddMinimalMethodsParams x -> AddMinimalMethodsParams
$cfrom :: forall x. AddMinimalMethodsParams -> Rep AddMinimalMethodsParams x
Generics.Generic, [AddMinimalMethodsParams] -> Encoding
[AddMinimalMethodsParams] -> Value
AddMinimalMethodsParams -> Encoding
AddMinimalMethodsParams -> Value
(AddMinimalMethodsParams -> Value)
-> (AddMinimalMethodsParams -> Encoding)
-> ([AddMinimalMethodsParams] -> Value)
-> ([AddMinimalMethodsParams] -> Encoding)
-> ToJSON AddMinimalMethodsParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AddMinimalMethodsParams] -> Encoding
$ctoEncodingList :: [AddMinimalMethodsParams] -> Encoding
toJSONList :: [AddMinimalMethodsParams] -> Value
$ctoJSONList :: [AddMinimalMethodsParams] -> Value
toEncoding :: AddMinimalMethodsParams -> Encoding
$ctoEncoding :: AddMinimalMethodsParams -> Encoding
toJSON :: AddMinimalMethodsParams -> Value
$ctoJSON :: AddMinimalMethodsParams -> Value
ToJSON, Value -> Parser [AddMinimalMethodsParams]
Value -> Parser AddMinimalMethodsParams
(Value -> Parser AddMinimalMethodsParams)
-> (Value -> Parser [AddMinimalMethodsParams])
-> FromJSON AddMinimalMethodsParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AddMinimalMethodsParams]
$cparseJSONList :: Value -> Parser [AddMinimalMethodsParams]
parseJSON :: Value -> Parser AddMinimalMethodsParams
$cparseJSON :: Value -> Parser AddMinimalMethodsParams
FromJSON)

addMethodPlaceholders :: CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders :: CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders IdeState
state AddMinimalMethodsParams{List Text
Uri
Range
methodGroup :: List Text
range :: Range
uri :: Uri
methodGroup :: AddMinimalMethodsParams -> List Text
range :: AddMinimalMethodsParams -> Range
uri :: AddMinimalMethodsParams -> Uri
..} = do
  ClientCapabilities
caps <- LspT Config IO ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
  Maybe WorkspaceEdit
medit <- IO (Maybe WorkspaceEdit) -> LspT Config IO (Maybe WorkspaceEdit)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe WorkspaceEdit) -> LspT Config IO (Maybe WorkspaceEdit))
-> IO (Maybe WorkspaceEdit) -> LspT Config IO (Maybe WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ MaybeT IO WorkspaceEdit -> IO (Maybe WorkspaceEdit)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO WorkspaceEdit -> IO (Maybe WorkspaceEdit))
-> MaybeT IO WorkspaceEdit -> IO (Maybe WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ do
    NormalizedFilePath
docPath <- IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath)
-> (NormalizedUri -> IO (Maybe NormalizedFilePath))
-> NormalizedUri
-> MaybeT IO NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath))
-> (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri
-> IO (Maybe NormalizedFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> MaybeT IO NormalizedFilePath)
-> NormalizedUri -> MaybeT IO NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    ParsedModule
pm <- IO (Maybe ParsedModule) -> MaybeT IO ParsedModule
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ParsedModule) -> MaybeT IO ParsedModule)
-> (Action (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> Action (Maybe ParsedModule)
-> MaybeT IO ParsedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe ParsedModule)
-> IO (Maybe ParsedModule)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin" IdeState
state (Action (Maybe ParsedModule) -> MaybeT IO ParsedModule)
-> Action (Maybe ParsedModule) -> MaybeT IO ParsedModule
forall a b. (a -> b) -> a -> b
$ GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
docPath
    (HscEnv -> DynFlags
hsc_dflags (HscEnv -> DynFlags)
-> (HscEnvEq -> HscEnv) -> HscEnvEq -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> HscEnv
hscEnv -> DynFlags
df) <- IO (Maybe HscEnvEq) -> MaybeT IO HscEnvEq
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe HscEnvEq) -> MaybeT IO HscEnvEq)
-> (Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq))
-> Action (Maybe HscEnvEq)
-> MaybeT IO HscEnvEq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState -> Action (Maybe HscEnvEq) -> IO (Maybe HscEnvEq)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin" IdeState
state (Action (Maybe HscEnvEq) -> MaybeT IO HscEnvEq)
-> Action (Maybe HscEnvEq) -> MaybeT IO HscEnvEq
forall a b. (a -> b) -> a -> b
$ GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
docPath
    (Text
old, Text
new) <- ParsedModule -> DynFlags -> MaybeT IO (Text, Text)
makeEditText ParsedModule
pm DynFlags
df
    WorkspaceEdit -> MaybeT IO WorkspaceEdit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new)

  Maybe WorkspaceEdit
-> (WorkspaceEdit -> LspT Config IO (LspId 'WorkspaceApplyEdit))
-> LspT Config IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe WorkspaceEdit
medit ((WorkspaceEdit -> LspT Config IO (LspId 'WorkspaceApplyEdit))
 -> LspT Config IO ())
-> (WorkspaceEdit -> LspT Config IO (LspId 'WorkspaceApplyEdit))
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceEdit
edit ->
    SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT Config IO ())
-> LspT Config IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Either ResponseError Value
-> LspM Config (Either ResponseError Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null)
  where
    indent :: Int
indent = Int
2

    workspaceEdit :: ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new
      = ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
caps (Uri
uri, Text
old) Text
new WithDeletions
IncludeDeletions

    toMethodName :: Text -> Text
toMethodName Text
n
      | Just (Char
h, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
n
      , Bool -> Bool
not (Char -> Bool
isAlpha Char
h Bool -> Bool -> Bool
|| Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
      = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      | Bool
otherwise
      = Text
n

#if MIN_VERSION_ghc(9,2,0)
    makeEditText pm df = do
      List mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup
      let ps = makeDeltaAst $ pm_parsed_source pm
          old = T.pack $ exactPrint ps
          (ps', _, _) = runTransform (addMethodDecls ps mDecls)
          new = T.pack $ exactPrint ps'
      pure (old, new)

    makeMethodDecl df mName =
        either (const Nothing) Just . parseDecl df (T.unpack mName) . T.unpack
            $ toMethodName mName <> " = _"

    addMethodDecls ps mDecls = do
      allDecls <- hsDecls ps
      let (before, ((L l inst): after)) = break (containRange range . getLoc) allDecls
      replaceDecls ps (before ++ (L l (addWhere inst)): (map newLine mDecls ++ after))
      where
        -- Add `where` keyword for `instance X where` if `where` is missing.
        --
        -- The `where` in ghc-9.2 is now stored in the instance declaration
        --   directly. More precisely, giving an `HsDecl GhcPs`, we have:
        --   InstD --> ClsInstD --> ClsInstDecl --> XCClsInstDecl --> (EpAnn [AddEpAnn], AnnSortKey),
        --   here `AnnEpAnn` keeps the track of Anns.
        --
        -- See the link for the original definition:
        --   https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl
        addWhere (InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) =
          let ((EpAnn entry anns comments), key) = cid_ext
          in InstD xInstD (ClsInstD ext decl {
            cid_ext = (EpAnn
                        entry
                        (AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns)
                        comments
                      , key)
          })
        addWhere decl = decl

        newLine (L l e) =
          let dp = deltaPos 1 (indent + 1) -- Not sure why there need one more space
          in L (noAnnSrcSpanDP (locA l) dp <> l) e

#else
    makeEditText :: ParsedModule -> DynFlags -> MaybeT IO (Text, Text)
makeEditText ParsedModule
pm DynFlags
df = do
      List ([(Anns, LHsDecl GhcPs)] -> ([Anns], [LHsDecl GhcPs])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([Anns]
mAnns, [LHsDecl GhcPs]
mDecls)) <- IO (Maybe (List (Anns, LHsDecl GhcPs)))
-> MaybeT IO (List (Anns, LHsDecl GhcPs))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (List (Anns, LHsDecl GhcPs)))
 -> MaybeT IO (List (Anns, LHsDecl GhcPs)))
-> (Maybe (List (Anns, LHsDecl GhcPs))
    -> IO (Maybe (List (Anns, LHsDecl GhcPs))))
-> Maybe (List (Anns, LHsDecl GhcPs))
-> MaybeT IO (List (Anns, LHsDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (List (Anns, LHsDecl GhcPs))
-> IO (Maybe (List (Anns, LHsDecl GhcPs)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (List (Anns, LHsDecl GhcPs))
 -> MaybeT IO (List (Anns, LHsDecl GhcPs)))
-> Maybe (List (Anns, LHsDecl GhcPs))
-> MaybeT IO (List (Anns, LHsDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Anns, LHsDecl GhcPs))
-> List Text -> Maybe (List (Anns, LHsDecl GhcPs))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (DynFlags -> Text -> Maybe (Anns, LHsDecl GhcPs)
makeMethodDecl DynFlags
df) List Text
methodGroup
      let ps :: ParsedSource
ps = ParsedModule -> ParsedSource
pm_parsed_source ParsedModule
pm
          anns :: Anns
anns = ParsedSource -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> ApiAnns -> Anns
relativiseApiAnns ParsedSource
ps (ParsedModule -> ApiAnns
pm_annotations ParsedModule
pm)
          old :: Text
old = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint ParsedSource
ps Anns
anns
          (ParsedSource
ps', (Anns
anns', Int
_), [String]
_) = Anns
-> Transform ParsedSource -> (ParsedSource, (Anns, Int), [String])
forall a. Anns -> Transform a -> (a, (Anns, Int), [String])
runTransform (Anns -> Anns -> Anns
mergeAnns ([Anns] -> Anns
mergeAnnList [Anns]
mAnns) Anns
anns) (ParsedSource -> [LHsDecl GhcPs] -> Transform ParsedSource
addMethodDecls ParsedSource
ps [LHsDecl GhcPs]
mDecls)
          new :: Text
new = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParsedSource -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint ParsedSource
ps' Anns
anns'
      (Text, Text) -> MaybeT IO (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
old, Text
new)

    makeMethodDecl :: DynFlags -> Text -> Maybe (Anns, LHsDecl GhcPs)
makeMethodDecl DynFlags
df Text
mName =
      case Parser (LHsDecl GhcPs)
parseDecl DynFlags
df (Text -> String
T.unpack Text
mName) (String -> ParseResult (LHsDecl GhcPs))
-> (Text -> String) -> Text -> ParseResult (LHsDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ParseResult (LHsDecl GhcPs))
-> Text -> ParseResult (LHsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ Text -> Text
toMethodName Text
mName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = _" of
        Right (Anns
ann, LHsDecl GhcPs
d) -> (Anns, LHsDecl GhcPs) -> Maybe (Anns, LHsDecl GhcPs)
forall a. a -> Maybe a
Just (LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
forall a. Data a => Located a -> Int -> Int -> Anns -> Anns
setPrecedingLines LHsDecl GhcPs
d Int
1 Int
indent Anns
ann, LHsDecl GhcPs
d)
        Left ErrorMessages
_         -> Maybe (Anns, LHsDecl GhcPs)
forall a. Maybe a
Nothing

    addMethodDecls :: ParsedSource -> [LHsDecl GhcPs] -> Transform ParsedSource
addMethodDecls ParsedSource
ps [LHsDecl GhcPs]
mDecls = do
      LHsDecl GhcPs
d <- ParsedSource -> Transform (LHsDecl GhcPs)
findInstDecl ParsedSource
ps
      SrcSpan
newSpan <- TransformT Identity SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
      let
        annKey :: AnnKey
annKey = LHsDecl GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsDecl GhcPs
d
        newAnnKey :: AnnKey
newAnnKey = SrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> SrcSpan
rs SrcSpan
newSpan) (String -> AnnConName
CN String
"HsValBinds")
        addWhere :: Anns -> Anns
addWhere mkds :: Anns
mkds@(AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
annKey -> Just Annotation
ann)
          = AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
newAnnKey Annotation
ann2 Anns
mkds2
          where
            ann1 :: Annotation
ann1 = Annotation
ann
                   { annsDP :: [(KeywordId, DeltaPos)]
annsDP = Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
ann [(KeywordId, DeltaPos)]
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnWhere, (Int, Int) -> DeltaPos
DP (Int
0, Int
1))]
                   , annCapturedSpan :: Maybe AnnKey
annCapturedSpan = AnnKey -> Maybe AnnKey
forall a. a -> Maybe a
Just AnnKey
newAnnKey
                   , annSortKey :: Maybe [SrcSpan]
annSortKey = [SrcSpan] -> Maybe [SrcSpan]
forall a. a -> Maybe a
Just ((LHsDecl GhcPs -> SrcSpan) -> [LHsDecl GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan -> SrcSpan
rs (SrcSpan -> SrcSpan)
-> (LHsDecl GhcPs -> SrcSpan) -> LHsDecl GhcPs -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) [LHsDecl GhcPs]
mDecls)
                   }
            mkds2 :: Anns
mkds2 = AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AnnKey
annKey Annotation
ann1 Anns
mkds
            ann2 :: Annotation
ann2 = Annotation
annNone
                   { annEntryDelta :: DeltaPos
annEntryDelta = (Int, Int) -> DeltaPos
DP (Int
1, Int
indent)
                   }
        addWhere Anns
_ = String -> Anns
forall a. String -> a
panic String
"Ide.Plugin.Class.addMethodPlaceholder"
      (Anns -> Anns) -> TransformT Identity ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT Anns -> Anns
addWhere
      (Anns -> Anns) -> TransformT Identity ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT (AnnKey -> [LHsDecl GhcPs] -> Anns -> Anns
forall b. AnnKey -> [Located b] -> Anns -> Anns
captureOrderAnnKey AnnKey
newAnnKey [LHsDecl GhcPs]
mDecls)
      (ParsedSource -> LHsDecl GhcPs -> Transform ParsedSource)
-> ParsedSource -> [LHsDecl GhcPs] -> Transform ParsedSource
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (LHsDecl GhcPs
-> ParsedSource -> LHsDecl GhcPs -> Transform ParsedSource
forall ast old.
HasDecls (Located ast) =>
Located old
-> Located ast -> LHsDecl GhcPs -> Transform (Located ast)
insertAfter LHsDecl GhcPs
d) ParsedSource
ps ([LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall a. [a] -> [a]
reverse [LHsDecl GhcPs]
mDecls)

    findInstDecl :: ParsedSource -> Transform (LHsDecl GhcPs)
    findInstDecl :: ParsedSource -> Transform (LHsDecl GhcPs)
findInstDecl ParsedSource
ps = [LHsDecl GhcPs] -> LHsDecl GhcPs
forall a. [a] -> a
head ([LHsDecl GhcPs] -> LHsDecl GhcPs)
-> ([LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> [LHsDecl GhcPs]
-> LHsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsDecl GhcPs -> Bool) -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall a. (a -> Bool) -> [a] -> [a]
filter (Range -> SrcSpan -> Bool
containRange Range
range (SrcSpan -> Bool)
-> (LHsDecl GhcPs -> SrcSpan) -> LHsDecl GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc) ([LHsDecl GhcPs] -> LHsDecl GhcPs)
-> TransformT Identity [LHsDecl GhcPs] -> Transform (LHsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSource -> TransformT Identity [LHsDecl GhcPs]
forall t (m :: * -> *).
(HasDecls t, Monad m) =>
t -> TransformT m [LHsDecl GhcPs]
hsDecls ParsedSource
ps
#endif

-- |
-- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is
-- sensitive to the format of diagnostic messages from GHC.
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
codeAction :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeAction IdeState
state PluginId
plId (CodeActionParams _ _ docId _ context) = IO (Either ResponseError (List (Command |? CodeAction)))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResponseError (List (Command |? CodeAction)))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> IO (Either ResponseError (List (Command |? CodeAction)))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ (Maybe (Either ResponseError (List (Command |? CodeAction)))
 -> Either ResponseError (List (Command |? CodeAction)))
-> IO (Maybe (Either ResponseError (List (Command |? CodeAction))))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either ResponseError (List (Command |? CodeAction))
-> Maybe (Either ResponseError (List (Command |? CodeAction)))
-> Either ResponseError (List (Command |? CodeAction))
forall a. a -> Maybe a -> a
fromMaybe Either ResponseError (List (Command |? CodeAction))
forall a a. Either a (List a)
errorResult) (IO (Maybe (Either ResponseError (List (Command |? CodeAction))))
 -> IO (Either ResponseError (List (Command |? CodeAction))))
-> (MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
    -> IO
         (Maybe (Either ResponseError (List (Command |? CodeAction)))))
-> MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
-> IO (Maybe (Either ResponseError (List (Command |? CodeAction))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
 -> IO (Either ResponseError (List (Command |? CodeAction))))
-> MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
-> IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ do
  NormalizedFilePath
docPath <- IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath)
-> (NormalizedUri -> IO (Maybe NormalizedFilePath))
-> NormalizedUri
-> MaybeT IO NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath))
-> (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri
-> IO (Maybe NormalizedFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> MaybeT IO NormalizedFilePath)
-> NormalizedUri -> MaybeT IO NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
  [Command |? CodeAction]
actions <- [[Command |? CodeAction]] -> [Command |? CodeAction]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Command |? CodeAction]] -> [Command |? CodeAction])
-> MaybeT IO [[Command |? CodeAction]]
-> MaybeT IO [Command |? CodeAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Diagnostic -> MaybeT IO [Command |? CodeAction])
-> [Diagnostic] -> MaybeT IO [[Command |? CodeAction]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NormalizedFilePath
-> Diagnostic -> MaybeT IO [Command |? CodeAction]
mkActions NormalizedFilePath
docPath) [Diagnostic]
methodDiags
  Either ResponseError (List (Command |? CodeAction))
-> MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List (Command |? CodeAction))
 -> MaybeT IO (Either ResponseError (List (Command |? CodeAction))))
-> ([Command |? CodeAction]
    -> Either ResponseError (List (Command |? CodeAction)))
-> [Command |? CodeAction]
-> MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> ([Command |? CodeAction] -> List (Command |? CodeAction))
-> [Command |? CodeAction]
-> Either ResponseError (List (Command |? CodeAction))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List ([Command |? CodeAction]
 -> MaybeT IO (Either ResponseError (List (Command |? CodeAction))))
-> [Command |? CodeAction]
-> MaybeT IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction]
actions
  where
    errorResult :: Either a (List a)
errorResult = List a -> Either a (List a)
forall a b. b -> Either a b
Right ([a] -> List a
forall a. [a] -> List a
List [])
    uri :: Uri
uri = TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
J.uri
    List [Diagnostic]
diags = CodeActionContext
context CodeActionContext
-> Getting (List Diagnostic) CodeActionContext (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. Getting (List Diagnostic) CodeActionContext (List Diagnostic)
forall s a. HasDiagnostics s a => Lens' s a
J.diagnostics

    ghcDiags :: [Diagnostic]
ghcDiags = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Diagnostic
d -> Diagnostic
d Diagnostic
-> Getting (Maybe Text) Diagnostic (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Diagnostic (Maybe Text)
forall s a. HasSource s a => Lens' s a
J.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"typecheck") [Diagnostic]
diags
    methodDiags :: [Diagnostic]
methodDiags = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Diagnostic
d -> Text -> Bool
isClassMethodWarning (Diagnostic
d Diagnostic -> Getting Text Diagnostic Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Diagnostic Text
forall s a. HasMessage s a => Lens' s a
J.message)) [Diagnostic]
ghcDiags

    mkActions :: NormalizedFilePath
-> Diagnostic -> MaybeT IO [Command |? CodeAction]
mkActions NormalizedFilePath
docPath Diagnostic
diag = do
      Either ModuleName Name
ident <- NormalizedFilePath -> Range -> MaybeT IO (Either ModuleName Name)
findClassIdentifier NormalizedFilePath
docPath Range
range
      Class
cls <- NormalizedFilePath -> Either ModuleName Name -> MaybeT IO Class
findClassFromIdentifier NormalizedFilePath
docPath Either ModuleName Name
ident
      IO [Command |? CodeAction] -> MaybeT IO [Command |? CodeAction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Command |? CodeAction] -> MaybeT IO [Command |? CodeAction])
-> (Class -> IO [Command |? CodeAction])
-> Class
-> MaybeT IO [Command |? CodeAction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> IO (Command |? CodeAction))
-> [[Text]] -> IO [Command |? CodeAction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Text] -> IO (Command |? CodeAction)
mkAction ([[Text]] -> IO [Command |? CodeAction])
-> (Class -> [[Text]]) -> Class -> IO [Command |? CodeAction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BooleanFormula Name -> [[Text]]
minDefToMethodGroups (BooleanFormula Name -> [[Text]])
-> (Class -> BooleanFormula Name) -> Class -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> BooleanFormula Name
classMinimalDef (Class -> MaybeT IO [Command |? CodeAction])
-> Class -> MaybeT IO [Command |? CodeAction]
forall a b. (a -> b) -> a -> b
$ Class
cls
      where
        range :: Range
range = Diagnostic
diag Diagnostic -> Getting Range Diagnostic Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range Diagnostic Range
forall s a. HasRange s a => Lens' s a
J.range

        mkAction :: [Text] -> IO (Command |? CodeAction)
mkAction [Text]
methodGroup
          = (Command |? CodeAction) -> IO (Command |? CodeAction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Command |? CodeAction) -> IO (Command |? CodeAction))
-> (Command |? CodeAction) -> IO (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$ Text -> Command -> Command |? CodeAction
forall a. Text -> Command -> a |? CodeAction
mkCodeAction Text
title (Command -> Command |? CodeAction)
-> Command -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
"addMinimalMethodPlaceholders" Text
title ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
cmdParams)
          where
            title :: Text
title = [Text] -> Text
forall a. (IsString a, Monoid a) => [a] -> a
mkTitle [Text]
methodGroup
            cmdParams :: [Value]
cmdParams = [Text] -> [Value]
mkCmdParams [Text]
methodGroup

        mkTitle :: [a] -> a
mkTitle [a]
methodGroup
          = a
"Add placeholders for "
          a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [a] -> a
forall a. Monoid a => [a] -> a
mconcat (a -> [a] -> [a]
forall a. a -> [a] -> [a]
intersperse a
", " ((a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
m -> a
"'" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"'") [a]
methodGroup))

        mkCmdParams :: [Text] -> [Value]
mkCmdParams [Text]
methodGroup = [AddMinimalMethodsParams -> Value
forall a. ToJSON a => a -> Value
toJSON (Uri -> Range -> List Text -> AddMinimalMethodsParams
AddMinimalMethodsParams Uri
uri Range
range ([Text] -> List Text
forall a. [a] -> List a
List [Text]
methodGroup))]

        mkCodeAction :: Text -> Command -> a |? CodeAction
mkCodeAction Text
title Command
cmd
          = CodeAction -> a |? CodeAction
forall a b. b -> a |? b
InR
          (CodeAction -> a |? CodeAction) -> CodeAction -> a |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix) (List Diagnostic -> Maybe (List Diagnostic)
forall a. a -> Maybe a
Just ([Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [])) Maybe Bool
forall a. Maybe a
Nothing Maybe Reason
forall a. Maybe a
Nothing Maybe WorkspaceEdit
forall a. Maybe a
Nothing (Command -> Maybe Command
forall a. a -> Maybe a
Just Command
cmd) Maybe Value
forall a. Maybe a
Nothing

    findClassIdentifier :: NormalizedFilePath -> Range -> MaybeT IO (Either ModuleName Name)
findClassIdentifier NormalizedFilePath
docPath Range
range = do
      (HieAstResult
hieAstResult, PositionMapping
pmap) <- IO (Maybe (HieAstResult, PositionMapping))
-> MaybeT IO (HieAstResult, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (HieAstResult, PositionMapping))
 -> MaybeT IO (HieAstResult, PositionMapping))
-> (Action (Maybe (HieAstResult, PositionMapping))
    -> IO (Maybe (HieAstResult, PositionMapping)))
-> Action (Maybe (HieAstResult, PositionMapping))
-> MaybeT IO (HieAstResult, PositionMapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe (HieAstResult, PositionMapping))
-> IO (Maybe (HieAstResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin" IdeState
state (Action (Maybe (HieAstResult, PositionMapping))
 -> MaybeT IO (HieAstResult, PositionMapping))
-> Action (Maybe (HieAstResult, PositionMapping))
-> MaybeT IO (HieAstResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GetHieAst
-> NormalizedFilePath
-> Action (Maybe (HieAstResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetHieAst
GetHieAst NormalizedFilePath
docPath
      case HieAstResult
hieAstResult of
        HAR {hieAst :: ()
hieAst = HieASTs a
hf} ->
          Either ModuleName Name -> MaybeT IO (Either ModuleName Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either ModuleName Name -> MaybeT IO (Either ModuleName Name))
-> Either ModuleName Name -> MaybeT IO (Either ModuleName Name)
forall a b. (a -> b) -> a -> b
$ [Either ModuleName Name] -> Either ModuleName Name
forall a. [a] -> a
head ([Either ModuleName Name] -> Either ModuleName Name)
-> ([[Either ModuleName Name]] -> [Either ModuleName Name])
-> [[Either ModuleName Name]]
-> Either ModuleName Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Either ModuleName Name]] -> [Either ModuleName Name]
forall a. [a] -> a
head
            ([[Either ModuleName Name]] -> Either ModuleName Name)
-> [[Either ModuleName Name]] -> Either ModuleName Name
forall a b. (a -> b) -> a -> b
$ HieASTs a
-> Position
-> (HieAST a -> [Either ModuleName Name])
-> [[Either ModuleName Name]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf (Maybe Range -> Range
forall a. HasCallStack => Maybe a -> a
fromJust (PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
pmap Range
range) Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasStart s a => Lens' s a
J.start Position -> (Position -> Position) -> Position
forall a b. a -> (a -> b) -> b
& (UInt -> Identity UInt) -> Position -> Identity Position
forall s a. HasCharacter s a => Lens' s a
J.character ((UInt -> Identity UInt) -> Position -> Identity Position)
-> UInt -> Position -> Position
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ UInt
1)
              ( (Map (Either ModuleName Name) (IdentifierDetails a)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
Map.keys (Map (Either ModuleName Name) (IdentifierDetails a)
 -> [Either ModuleName Name])
-> (HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a))
-> HieAST a
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierDetails a -> Bool)
-> Map (Either ModuleName Name) (IdentifierDetails a)
-> Map (Either ModuleName Name) (IdentifierDetails a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter IdentifierDetails a -> Bool
forall a. IdentifierDetails a -> Bool
isClassNodeIdentifier (Map (Either ModuleName Name) (IdentifierDetails a)
 -> Map (Either ModuleName Name) (IdentifierDetails a))
-> (HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a))
-> HieAST a
-> Map (Either ModuleName Name) (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map (Either ModuleName Name) (IdentifierDetails a)
forall a. HieAST a -> NodeIdentifiers a
Compat.getNodeIds)
                (HieAST a -> [Either ModuleName Name])
-> (HieAST a -> [HieAST a]) -> HieAST a -> [Either ModuleName Name]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren
              )

    findClassFromIdentifier :: NormalizedFilePath -> Either ModuleName Name -> MaybeT IO Class
findClassFromIdentifier NormalizedFilePath
docPath (Right Name
name) = do
      (HscEnvEq -> HscEnv
hscEnv -> HscEnv
hscenv, PositionMapping
_) <- IO (Maybe (HscEnvEq, PositionMapping))
-> MaybeT IO (HscEnvEq, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (HscEnvEq, PositionMapping))
 -> MaybeT IO (HscEnvEq, PositionMapping))
-> (Action (Maybe (HscEnvEq, PositionMapping))
    -> IO (Maybe (HscEnvEq, PositionMapping)))
-> Action (Maybe (HscEnvEq, PositionMapping))
-> MaybeT IO (HscEnvEq, PositionMapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin" IdeState
state (Action (Maybe (HscEnvEq, PositionMapping))
 -> MaybeT IO (HscEnvEq, PositionMapping))
-> Action (Maybe (HscEnvEq, PositionMapping))
-> MaybeT IO (HscEnvEq, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
docPath
      (TcModuleResult -> TcGblEnv
tmrTypechecked -> TcGblEnv
thisMod, PositionMapping
_) <- IO (Maybe (TcModuleResult, PositionMapping))
-> MaybeT IO (TcModuleResult, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (TcModuleResult, PositionMapping))
 -> MaybeT IO (TcModuleResult, PositionMapping))
-> (Action (Maybe (TcModuleResult, PositionMapping))
    -> IO (Maybe (TcModuleResult, PositionMapping)))
-> Action (Maybe (TcModuleResult, PositionMapping))
-> MaybeT IO (TcModuleResult, PositionMapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> IdeState
-> Action (Maybe (TcModuleResult, PositionMapping))
-> IO (Maybe (TcModuleResult, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"classplugin" IdeState
state (Action (Maybe (TcModuleResult, PositionMapping))
 -> MaybeT IO (TcModuleResult, PositionMapping))
-> Action (Maybe (TcModuleResult, PositionMapping))
-> MaybeT IO (TcModuleResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ TypeCheck
-> NormalizedFilePath
-> Action (Maybe (TcModuleResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
docPath
      IO (Maybe Class) -> MaybeT IO Class
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Class) -> MaybeT IO Class)
-> (TcM Class -> IO (Maybe Class)) -> TcM Class -> MaybeT IO Class
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Messages, Maybe Class) -> Maybe Class)
-> IO (Messages, Maybe Class) -> IO (Maybe Class)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Messages, Maybe Class) -> Maybe Class
forall a b. (a, b) -> b
snd (IO (Messages, Maybe Class) -> IO (Maybe Class))
-> (TcM Class -> IO (Messages, Maybe Class))
-> TcM Class
-> IO (Maybe Class)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM Class
-> IO (Messages, Maybe Class)
forall r.
HscEnv
-> TcGblEnv -> RealSrcSpan -> TcM r -> IO (Messages, Maybe r)
initTcWithGbl HscEnv
hscenv TcGblEnv
thisMod RealSrcSpan
ghostSpan (TcM Class -> MaybeT IO Class) -> TcM Class -> MaybeT IO Class
forall a b. (a -> b) -> a -> b
$ do
        TcTyThing
tcthing <- Name -> TcM TcTyThing
tcLookup Name
name
        case TcTyThing
tcthing of
          AGlobal (AConLike (RealDataCon DataCon
con))
            | Just Class
cls <- TyCon -> Maybe Class
tyConClass_maybe (DataCon -> TyCon
dataConOrigTyCon DataCon
con) -> Class -> TcM Class
forall (f :: * -> *) a. Applicative f => a -> f a
pure Class
cls
          TcTyThing
_ -> String -> TcM Class
forall a. String -> a
panic String
"Ide.Plugin.Class.findClassFromIdentifier"
    findClassFromIdentifier NormalizedFilePath
_ (Left ModuleName
_) = String -> MaybeT IO Class
forall a. String -> a
panic String
"Ide.Plugin.Class.findClassIdentifier"

ghostSpan :: RealSrcSpan
ghostSpan :: RealSrcSpan
ghostSpan = RealSrcLoc -> RealSrcSpan
realSrcLocSpan (RealSrcLoc -> RealSrcSpan) -> RealSrcLoc -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
fsLit String
"<haskell-language-sever>") Int
1 Int
1

containRange :: Range -> SrcSpan -> Bool
containRange :: Range -> SrcSpan -> Bool
containRange Range
range SrcSpan
x = Position -> SrcSpan -> Bool
isInsideSrcSpan (Range
range Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasStart s a => Lens' s a
J.start) SrcSpan
x Bool -> Bool -> Bool
|| Position -> SrcSpan -> Bool
isInsideSrcSpan (Range
range Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasEnd s a => Lens' s a
J.end) SrcSpan
x

isClassNodeIdentifier :: IdentifierDetails a -> Bool
isClassNodeIdentifier :: IdentifierDetails a -> Bool
isClassNodeIdentifier IdentifierDetails a
ident = (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool)
-> (IdentifierDetails a -> Maybe a) -> IdentifierDetails a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType) IdentifierDetails a
ident Bool -> Bool -> Bool
&& ContextInfo
Use ContextInfo -> Set ContextInfo -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
ident)

isClassMethodWarning :: T.Text -> Bool
isClassMethodWarning :: Text -> Bool
isClassMethodWarning = Text -> Text -> Bool
T.isPrefixOf Text
"• No explicit implementation for"

minDefToMethodGroups :: BooleanFormula Name -> [[T.Text]]
minDefToMethodGroups :: BooleanFormula Name -> [[Text]]
minDefToMethodGroups = BooleanFormula Name -> [[Text]]
forall name. HasOccName name => BooleanFormula name -> [[Text]]
go
  where
    go :: BooleanFormula name -> [[Text]]
go (Var name
mn)   = [[String -> Text
T.pack (String -> Text) -> (name -> String) -> name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString (OccName -> String) -> (name -> OccName) -> name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> OccName
forall name. HasOccName name => name -> OccName
occName (name -> Text) -> name -> Text
forall a b. (a -> b) -> a -> b
$ name
mn]]
    go (Or [LBooleanFormula name]
ms)    = (LBooleanFormula name -> [[Text]])
-> [LBooleanFormula name] -> [[Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BooleanFormula name -> [[Text]]
go (BooleanFormula name -> [[Text]])
-> (LBooleanFormula name -> BooleanFormula name)
-> LBooleanFormula name
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula name -> BooleanFormula name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LBooleanFormula name]
ms
    go (And [LBooleanFormula name]
ms)   = ([[Text]] -> [[Text]] -> [[Text]])
-> [[Text]] -> [[[Text]]] -> [[Text]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([Text] -> [Text] -> [Text]) -> [[Text]] -> [[Text]] -> [[Text]]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>)) [[]] ((LBooleanFormula name -> [[Text]])
-> [LBooleanFormula name] -> [[[Text]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BooleanFormula name -> [[Text]]
go (BooleanFormula name -> [[Text]])
-> (LBooleanFormula name -> BooleanFormula name)
-> LBooleanFormula name
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula name -> BooleanFormula name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LBooleanFormula name]
ms)
    go (Parens LBooleanFormula name
m) = BooleanFormula name -> [[Text]]
go (LBooleanFormula name -> SrcSpanLess (LBooleanFormula name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LBooleanFormula name
m)