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

import           BooleanFormula
import           Class
import           ConLike
import           Control.Applicative
import           Control.Lens hiding (List, use)
import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import           Data.Char
import qualified Data.HashMap.Strict as H
import           Data.List
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.Text as T
import           Development.IDE
import           Development.IDE.Core.PositionMapping (fromCurrentRange, toCurrentRange)
import           Development.IDE.GHC.Compat hiding (getLoc)
import           Development.IDE.Spans.AtPoint
import qualified GHC.Generics as Generics
import           GhcPlugins hiding (Var, getLoc, (<>))
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.LSP.Core
import           Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types.Lens as J
import           SrcLoc
import           TcEnv
import           TcRnMonad

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
  , pluginCodeActionProvider :: Maybe (CodeActionProvider IdeState)
pluginCodeActionProvider = CodeActionProvider IdeState -> Maybe (CodeActionProvider IdeState)
forall a. a -> Maybe a
Just CodeActionProvider IdeState
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 LspFuncs Config
lf IdeState
state AddMinimalMethodsParams{List Text
Uri
Range
methodGroup :: List Text
range :: Range
uri :: Uri
methodGroup :: AddMinimalMethodsParams -> List Text
range :: AddMinimalMethodsParams -> Range
uri :: AddMinimalMethodsParams -> Uri
..} = (Maybe
   (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
 -> (Either ResponseError Value,
     Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> Maybe
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a. a -> Maybe a -> a
fromMaybe (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a a. (Either a Value, Maybe a)
errorResult) (IO
   (Maybe
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> (MaybeT
      IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams))
    -> IO
         (Maybe
            (Either ResponseError Value,
             Maybe (ServerMethod, ApplyWorkspaceEditParams))))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT
  IO
  (Either ResponseError Value,
   Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Maybe
        (Either ResponseError Value,
         Maybe (ServerMethod, ApplyWorkspaceEditParams)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   IO
   (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
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
  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

  (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
  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
    (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'

  (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> MaybeT
     IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, (ServerMethod, ApplyWorkspaceEditParams)
-> Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. a -> Maybe a
Just (ServerMethod
WorkspaceApplyEdit, WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams (ClientCapabilities -> Text -> Text -> WorkspaceEdit
workspaceEdit ClientCapabilities
caps Text
old Text
new)))
  where
    errorResult :: (Either a Value, Maybe a)
errorResult = (Value -> Either a Value
forall a b. b -> Either a b
Right Value
Null, Maybe a
forall a. Maybe a
Nothing)

    caps :: ClientCapabilities
caps = LspFuncs Config -> ClientCapabilities
forall c. LspFuncs c -> ClientCapabilities
clientCapabilities LspFuncs Config
lf
    indent :: Int
indent = Int
2

    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 (Located (HsModule GhcPs))
    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
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 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

    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

-- |
-- This implementation is ad-hoc in a sense that the diagnostic detection mechanism is
-- sensitive to the format of diagnostic messages from GHC.
codeAction :: CodeActionProvider IdeState
codeAction :: CodeActionProvider IdeState
codeAction LspFuncs Config
_ IdeState
state PluginId
plId TextDocumentIdentifier
docId Range
_ CodeActionContext
context = (Maybe (Either ResponseError (List CAResult))
 -> Either ResponseError (List CAResult))
-> IO (Maybe (Either ResponseError (List CAResult)))
-> IO (Either ResponseError (List CAResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either ResponseError (List CAResult)
-> Maybe (Either ResponseError (List CAResult))
-> Either ResponseError (List CAResult)
forall a. a -> Maybe a -> a
fromMaybe Either ResponseError (List CAResult)
forall a a. Either a (List a)
errorResult) (IO (Maybe (Either ResponseError (List CAResult)))
 -> IO (Either ResponseError (List CAResult)))
-> (MaybeT IO (Either ResponseError (List CAResult))
    -> IO (Maybe (Either ResponseError (List CAResult))))
-> MaybeT IO (Either ResponseError (List CAResult))
-> IO (Either ResponseError (List CAResult))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT IO (Either ResponseError (List CAResult))
-> IO (Maybe (Either ResponseError (List CAResult)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (Either ResponseError (List CAResult))
 -> IO (Either ResponseError (List CAResult)))
-> MaybeT IO (Either ResponseError (List CAResult))
-> IO (Either ResponseError (List CAResult))
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
  [CAResult]
actions <- [[CAResult]] -> [CAResult]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[CAResult]] -> [CAResult])
-> MaybeT IO [[CAResult]] -> MaybeT IO [CAResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Diagnostic -> MaybeT IO [CAResult])
-> [Diagnostic] -> MaybeT IO [[CAResult]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NormalizedFilePath -> Diagnostic -> MaybeT IO [CAResult]
mkActions NormalizedFilePath
docPath) [Diagnostic]
methodDiags
  Either ResponseError (List CAResult)
-> MaybeT IO (Either ResponseError (List CAResult))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List CAResult)
 -> MaybeT IO (Either ResponseError (List CAResult)))
-> ([CAResult] -> Either ResponseError (List CAResult))
-> [CAResult]
-> MaybeT IO (Either ResponseError (List CAResult))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List CAResult -> Either ResponseError (List CAResult)
forall a b. b -> Either a b
Right (List CAResult -> Either ResponseError (List CAResult))
-> ([CAResult] -> List CAResult)
-> [CAResult]
-> Either ResponseError (List CAResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CAResult] -> List CAResult
forall a. [a] -> List a
List ([CAResult] -> MaybeT IO (Either ResponseError (List CAResult)))
-> [CAResult] -> MaybeT IO (Either ResponseError (List CAResult))
forall a b. (a -> b) -> a -> b
$ [CAResult]
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 [CAResult]
mkActions NormalizedFilePath
docPath Diagnostic
diag = do
      Identifier
ident <- NormalizedFilePath -> Range -> MaybeT IO Identifier
findClassIdentifier NormalizedFilePath
docPath Range
range
      Class
cls <- NormalizedFilePath -> Identifier -> MaybeT IO Class
findClassFromIdentifier NormalizedFilePath
docPath Identifier
ident
      IO [CAResult] -> MaybeT IO [CAResult]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [CAResult] -> MaybeT IO [CAResult])
-> (Class -> IO [CAResult]) -> Class -> MaybeT IO [CAResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> IO CAResult) -> [[Text]] -> IO [CAResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Text] -> IO CAResult
mkAction ([[Text]] -> IO [CAResult])
-> (Class -> [[Text]]) -> Class -> IO [CAResult]
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 [CAResult]) -> Class -> MaybeT IO [CAResult]
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 CAResult
mkAction [Text]
methodGroup
          = Text -> Command -> CAResult
mkCodeAction Text
title
            (Command -> CAResult) -> IO Command -> IO CAResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PluginId -> CommandId -> Text -> Maybe [Value] -> IO 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 -> CAResult
mkCodeAction Text
title
          = CodeAction -> CAResult
CACodeAction
          (CodeAction -> CAResult)
-> (Command -> CodeAction) -> Command -> CAResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe WorkspaceEdit
-> Maybe Command
-> 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 WorkspaceEdit
forall a. Maybe a
Nothing
          (Maybe Command -> CodeAction)
-> (Command -> Maybe Command) -> Command -> CodeAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Maybe Command
forall a. a -> Maybe a
Just

    findClassIdentifier :: NormalizedFilePath -> Range -> MaybeT IO Identifier
findClassIdentifier NormalizedFilePath
docPath Range
range = do
      (HieAstResult -> HieASTs Type
hieAst -> HieASTs Type
hf, 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
      Identifier -> MaybeT IO Identifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Identifier -> MaybeT IO Identifier)
-> Identifier -> MaybeT IO Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
forall a. [a] -> a
head ([Identifier] -> Identifier)
-> ([[Identifier]] -> [Identifier]) -> [[Identifier]] -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Identifier]] -> [Identifier]
forall a. [a] -> a
head
        ([[Identifier]] -> Identifier) -> [[Identifier]] -> Identifier
forall a b. (a -> b) -> a -> b
$ HieASTs Type
-> Position -> (HieAST Type -> [Identifier]) -> [[Identifier]]
forall a. HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
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
& (Int -> Identity Int) -> Position -> Identity Position
forall s a. HasCharacter s a => Lens' s a
J.character ((Int -> Identity Int) -> Position -> Identity Position)
-> Int -> Position -> Position
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1)
          ( (Map Identifier (IdentifierDetails Type) -> [Identifier]
forall k a. Map k a -> [k]
Map.keys (Map Identifier (IdentifierDetails Type) -> [Identifier])
-> (HieAST Type -> Map Identifier (IdentifierDetails Type))
-> HieAST Type
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierDetails Type -> Bool)
-> Map Identifier (IdentifierDetails Type)
-> Map Identifier (IdentifierDetails Type)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter IdentifierDetails Type -> Bool
forall a. IdentifierDetails a -> Bool
isClassNodeIdentifier (Map Identifier (IdentifierDetails Type)
 -> Map Identifier (IdentifierDetails Type))
-> (HieAST Type -> Map Identifier (IdentifierDetails Type))
-> HieAST Type
-> Map Identifier (IdentifierDetails Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Type -> Map Identifier (IdentifierDetails Type)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Type -> Map Identifier (IdentifierDetails Type))
-> (HieAST Type -> NodeInfo Type)
-> HieAST Type
-> Map Identifier (IdentifierDetails Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Type -> NodeInfo Type
forall a. HieAST a -> NodeInfo a
nodeInfo)
            (HieAST Type -> [Identifier])
-> (HieAST Type -> [HieAST Type]) -> HieAST Type -> [Identifier]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< HieAST Type -> [HieAST Type]
forall a. HieAST a -> [HieAST a]
nodeChildren
          )

    findClassFromIdentifier :: NormalizedFilePath -> Identifier -> 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 = 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

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)