{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ViewPatterns              #-}

module Ide.Plugin.HaddockComments (descriptor) where

import           Control.Monad                         (join)
import           Control.Monad.IO.Class
import qualified Data.HashMap.Strict                   as HashMap
import qualified Data.Map                              as Map
import qualified Data.Text                             as T
import           Development.IDE                       hiding (pluginHandlers)
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.ExactPrint        (GetAnnotatedParsedSource (..))
import           Ide.Types
import           Language.Haskell.GHC.ExactPrint
import           Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)
import           Language.Haskell.GHC.ExactPrint.Utils
import           Language.LSP.Types

-----------------------------------------------------------------------------
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
  (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { 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
codeActionProvider
    }

codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction
codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction
codeActionProvider IdeState
ideState PluginId
_pId (CodeActionParams _ _ (TextDocumentIdentifier uri) range CodeActionContext {_diagnostics = List diags}) =
  do
    let noErr :: Bool
noErr = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Maybe DiagnosticSeverity -> Maybe DiagnosticSeverity -> Bool
forall a. Eq a => a -> a -> Bool
/= DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsError) (Maybe DiagnosticSeverity -> Bool)
-> (Diagnostic -> Maybe DiagnosticSeverity) -> Diagnostic -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Diagnostic -> Maybe DiagnosticSeverity
_severity (Diagnostic -> Bool) -> [Diagnostic] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Diagnostic]
diags
        nfp :: Maybe NormalizedFilePath
nfp = NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    (Maybe (Maybe (Annotated ParsedSource))
-> Maybe (Annotated ParsedSource)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Maybe (Annotated ParsedSource)
pm) <- IO (Maybe (Maybe (Annotated ParsedSource)))
-> LspT Config IO (Maybe (Maybe (Annotated ParsedSource)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Maybe (Annotated ParsedSource)))
 -> LspT Config IO (Maybe (Maybe (Annotated ParsedSource))))
-> IO (Maybe (Maybe (Annotated ParsedSource)))
-> LspT Config IO (Maybe (Maybe (Annotated ParsedSource)))
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action (Maybe (Maybe (Annotated ParsedSource)))
-> IO (Maybe (Maybe (Annotated ParsedSource)))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"HaddockComments.GetAnnotatedParsedSource" IdeState
ideState (Action (Maybe (Maybe (Annotated ParsedSource)))
 -> IO (Maybe (Maybe (Annotated ParsedSource))))
-> Action (Maybe (Maybe (Annotated ParsedSource)))
-> IO (Maybe (Maybe (Annotated ParsedSource)))
forall a b. (a -> b) -> a -> b
$ GetAnnotatedParsedSource
-> NormalizedFilePath -> Action (Maybe (Annotated ParsedSource))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetAnnotatedParsedSource
GetAnnotatedParsedSource (NormalizedFilePath -> Action (Maybe (Annotated ParsedSource)))
-> Maybe NormalizedFilePath
-> Action (Maybe (Maybe (Annotated ParsedSource)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` Maybe NormalizedFilePath
nfp
    let locDecls :: Maybe [LHsDecl GhcPs]
locDecls = HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> (Annotated ParsedSource -> HsModule GhcPs)
-> Annotated ParsedSource
-> [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedSource -> HsModule GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ParsedSource -> HsModule GhcPs)
-> (Annotated ParsedSource -> ParsedSource)
-> Annotated ParsedSource
-> HsModule GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA (Annotated ParsedSource -> [LHsDecl GhcPs])
-> Maybe (Annotated ParsedSource) -> Maybe [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotated ParsedSource)
pm
        anns :: Maybe Anns
anns = Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA (Annotated ParsedSource -> Anns)
-> Maybe (Annotated ParsedSource) -> Maybe Anns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotated ParsedSource)
pm
        edits :: [Maybe (Text, TextEdit)]
edits = [GenComments
-> Maybe [LHsDecl GhcPs]
-> Maybe Anns
-> Range
-> Maybe (Text, TextEdit)
runGenComments GenComments
gen Maybe [LHsDecl GhcPs]
locDecls Maybe Anns
anns Range
range | Bool
noErr, GenComments
gen <- [GenComments]
genList]
    Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List (Command |? CodeAction))
 -> LspT
      Config IO (Either ResponseError (List (Command |? CodeAction))))
-> Either ResponseError (List (Command |? CodeAction))
-> LspT
     Config IO (Either ResponseError (List (Command |? CodeAction)))
forall a b. (a -> b) -> a -> b
$ List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. b -> Either a b
Right (List (Command |? CodeAction)
 -> Either ResponseError (List (Command |? CodeAction)))
-> List (Command |? CodeAction)
-> Either ResponseError (List (Command |? CodeAction))
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> List (Command |? CodeAction)
forall a. [a] -> List a
List [CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ Text -> Uri -> TextEdit -> CodeAction
toAction Text
title Uri
uri TextEdit
edit | (Just (Text
title, TextEdit
edit)) <- [Maybe (Text, TextEdit)]
edits]

genList :: [GenComments]
genList :: [GenComments]
genList =
  [ GenComments
genForSig,
    GenComments
genForRecord
  ]

-----------------------------------------------------------------------------

-- | Defines how to generate haddock comments by tweaking annotations of AST
data GenComments = forall a.
  GenComments
  { GenComments -> Text
title         :: T.Text,
    ()
fromDecl      :: HsDecl GhcPs -> Maybe a,
    ()
collectKeys   :: a -> [AnnKey],
    GenComments -> Annotation -> Bool
isFresh       :: Annotation -> Bool,
    GenComments -> Annotation -> Annotation
updateAnn     :: Annotation -> Annotation,
    GenComments -> Annotation -> Annotation
updateDeclAnn :: Annotation -> Annotation
  }

runGenComments :: GenComments -> Maybe [LHsDecl GhcPs] -> Maybe Anns -> Range -> Maybe (T.Text, TextEdit)
runGenComments :: GenComments
-> Maybe [LHsDecl GhcPs]
-> Maybe Anns
-> Range
-> Maybe (Text, TextEdit)
runGenComments GenComments {Text
a -> [AnnKey]
HsDecl GhcPs -> Maybe a
Annotation -> Bool
Annotation -> Annotation
updateDeclAnn :: Annotation -> Annotation
updateAnn :: Annotation -> Annotation
isFresh :: Annotation -> Bool
collectKeys :: a -> [AnnKey]
fromDecl :: HsDecl GhcPs -> Maybe a
title :: Text
updateDeclAnn :: GenComments -> Annotation -> Annotation
updateAnn :: GenComments -> Annotation -> Annotation
isFresh :: GenComments -> Annotation -> Bool
collectKeys :: ()
fromDecl :: ()
title :: GenComments -> Text
..} Maybe [LHsDecl GhcPs]
mLocDecls Maybe Anns
mAnns Range
range
  | Just [LHsDecl GhcPs]
locDecls <- Maybe [LHsDecl GhcPs]
mLocDecls,
    Just Anns
anns <- Maybe Anns
mAnns,
    [(LHsDecl GhcPs
locDecl, SrcSpan
src, a
x)] <- [(LHsDecl GhcPs
locDecl, SrcSpan
l, a
x) | locDecl :: LHsDecl GhcPs
locDecl@(L SrcSpan
l (HsDecl GhcPs -> Maybe a
fromDecl -> Just a
x)) <- [LHsDecl GhcPs]
locDecls, Range
range Range -> SrcSpan -> Bool
`isIntersectWith` SrcSpan
l],
    [AnnKey]
annKeys <- a -> [AnnKey]
collectKeys a
x,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [AnnKey] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnnKey]
annKeys,
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (Annotation -> Bool) -> Maybe Annotation -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Annotation -> Bool
isFresh (Maybe Annotation -> Bool)
-> (AnnKey -> Maybe Annotation) -> AnnKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnKey -> Anns -> Maybe Annotation)
-> Anns -> AnnKey -> Maybe Annotation
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Anns
anns (AnnKey -> Bool) -> [AnnKey] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnnKey]
annKeys,
    AnnKey
declKey <- LHsDecl GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsDecl GhcPs
locDecl,
    Anns
anns' <- (Annotation -> Annotation) -> AnnKey -> Anns -> Anns
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Annotation -> Annotation
updateDeclAnn AnnKey
declKey (Anns -> Anns) -> Anns -> Anns
forall a b. (a -> b) -> a -> b
$ (AnnKey -> Anns -> Anns) -> Anns -> [AnnKey] -> Anns
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Annotation -> Annotation) -> AnnKey -> Anns -> Anns
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Annotation -> Annotation
updateAnn) Anns
anns [AnnKey]
annKeys,
    Just Range
range' <- SrcSpan -> Maybe Range
toRange SrcSpan
src,
    Text
result <- Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> Anns -> String
forall ast. Annotate ast => Located ast -> Anns -> String
exactPrint LHsDecl GhcPs
locDecl Anns
anns' =
    (Text, TextEdit) -> Maybe (Text, TextEdit)
forall a. a -> Maybe a
Just (Text
title, Range -> Text -> TextEdit
TextEdit Range
range' Text
result)
  | Bool
otherwise = Maybe (Text, TextEdit)
forall a. Maybe a
Nothing

-----------------------------------------------------------------------------

genForSig :: GenComments
genForSig :: GenComments
genForSig = GenComments :: forall a.
Text
-> (HsDecl GhcPs -> Maybe a)
-> (a -> [AnnKey])
-> (Annotation -> Bool)
-> (Annotation -> Annotation)
-> (Annotation -> Annotation)
-> GenComments
GenComments {Text
HsDecl GhcPs -> Maybe (LHsType GhcPs)
LHsType GhcPs -> [AnnKey]
Annotation -> Bool
Annotation -> Annotation
forall p. HsDecl p -> Maybe (LHsType p)
collectKeys :: LHsType GhcPs -> [AnnKey]
isFresh :: Annotation -> Bool
updateDeclAnn :: Annotation -> Annotation
updateAnn :: Annotation -> Annotation
fromDecl :: forall p. HsDecl p -> Maybe (LHsType p)
title :: Text
updateDeclAnn :: Annotation -> Annotation
updateAnn :: Annotation -> Annotation
isFresh :: Annotation -> Bool
collectKeys :: LHsType GhcPs -> [AnnKey]
fromDecl :: HsDecl GhcPs -> Maybe (LHsType GhcPs)
title :: Text
..}
  where
    title :: Text
title = Text
"Generate signature comments"

    fromDecl :: HsDecl p -> Maybe (LHsType p)
fromDecl (SigD XSigD p
_ (TypeSig XTypeSig p
_ [Located (IdP p)]
_ (HsWC XHsWC p (LHsSigType p)
_ (HsIB XHsIB p (LHsType p)
_ LHsType p
x)))) = LHsType p -> Maybe (LHsType p)
forall a. a -> Maybe a
Just LHsType p
x
    fromDecl HsDecl p
_                                          = Maybe (LHsType p)
forall a. Maybe a
Nothing

    updateAnn :: Annotation -> Annotation
updateAnn Annotation
x = Annotation
x {annEntryDelta :: DeltaPos
annEntryDelta = (Int, Int) -> DeltaPos
DP (Int
0, Int
1), annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
dp}
    updateDeclAnn :: Annotation -> Annotation
updateDeclAnn = Annotation -> Annotation
cleanPriorComments

    isFresh :: Annotation -> Bool
isFresh Ann {[(KeywordId, DeltaPos)]
annsDP :: [(KeywordId, DeltaPos)]
annsDP :: Annotation -> [(KeywordId, DeltaPos)]
annsDP} = [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [() | (AnnComment Comment
_, DeltaPos
_) <- [(KeywordId, DeltaPos)]
annsDP]
    collectKeys :: LHsType GhcPs -> [AnnKey]
collectKeys = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
0

#if MIN_VERSION_ghc(9,2,0)
    comment = mkComment "-- ^ " (spanAsAnchor noSrcSpan)
#elif MIN_VERSION_ghc(9,0,0)
    comment = mkComment "-- ^ " badRealSrcSpan
#else
    comment :: Comment
comment = String -> SrcSpan -> Comment
mkComment String
"-- ^ " SrcSpan
noSrcSpan
#endif
    dp :: [(KeywordId, DeltaPos)]
dp = [(Comment -> KeywordId
AnnComment Comment
comment, (Int, Int) -> DeltaPos
DP (Int
0, Int
1)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnRarrow, (Int, Int) -> DeltaPos
DP (Int
1, Int
2))]

genForRecord :: GenComments
genForRecord :: GenComments
genForRecord = GenComments :: forall a.
Text
-> (HsDecl GhcPs -> Maybe a)
-> (a -> [AnnKey])
-> (Annotation -> Bool)
-> (Annotation -> Annotation)
-> (Annotation -> Annotation)
-> GenComments
GenComments {Text
[HsConDeclDetails GhcPs] -> [AnnKey]
HsDecl GhcPs -> Maybe [HsConDeclDetails GhcPs]
Annotation -> Bool
Annotation -> Annotation
forall p. HsDecl p -> Maybe [HsConDeclDetails p]
collectKeys :: [HsConDeclDetails GhcPs] -> [AnnKey]
isFresh :: Annotation -> Bool
updateDeclAnn :: Annotation -> Annotation
updateAnn :: Annotation -> Annotation
fromDecl :: forall p. HsDecl p -> Maybe [HsConDeclDetails p]
title :: Text
updateDeclAnn :: Annotation -> Annotation
updateAnn :: Annotation -> Annotation
isFresh :: Annotation -> Bool
collectKeys :: [HsConDeclDetails GhcPs] -> [AnnKey]
fromDecl :: HsDecl GhcPs -> Maybe [HsConDeclDetails GhcPs]
title :: Text
..}
  where
    title :: Text
title = Text
"Generate fields comments"

    fromDecl :: HsDecl p -> Maybe [HsConDeclDetails p]
fromDecl (TyClD XTyClD p
_ DataDecl {tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn {dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons = [LConDecl p]
cons}}) =
      [HsConDeclDetails p] -> Maybe [HsConDeclDetails p]
forall a. a -> Maybe a
Just [HsConDeclDetails p
x | (L SrcSpan
_ ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args = HsConDeclDetails p
x}) <- [LConDecl p]
cons]
    fromDecl HsDecl p
_ = Maybe [HsConDeclDetails p]
forall a. Maybe a
Nothing

    updateAnn :: Annotation -> Annotation
updateAnn Annotation
x = Annotation
x {annEntryDelta :: DeltaPos
annEntryDelta = (Int, Int) -> DeltaPos
DP (Int
1, Int
2), annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = [(Comment
comment, (Int, Int) -> DeltaPos
DP (Int
1, Int
2))]}
    updateDeclAnn :: Annotation -> Annotation
updateDeclAnn = Annotation -> Annotation
cleanPriorComments

    isFresh :: Annotation -> Bool
isFresh Ann {[(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments} = [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Comment, DeltaPos)]
annPriorComments

    collectKeys :: [HsConDeclDetails GhcPs] -> [AnnKey]
collectKeys = [HsConDeclDetails GhcPs] -> [AnnKey]
keyFromCon

#if MIN_VERSION_ghc(9,2,0)
    comment = mkComment "-- | " (spanAsAnchor noSrcSpan)
#elif MIN_VERSION_ghc(9,0,0)
    comment = mkComment "-- | " badRealSrcSpan
#else
    comment :: Comment
comment = String -> SrcSpan -> Comment
mkComment String
"-- | " SrcSpan
noSrcSpan
#endif

-----------------------------------------------------------------------------

toAction :: T.Text -> Uri -> TextEdit -> CodeAction
toAction :: Text -> Uri -> TextEdit -> CodeAction
toAction Text
title Uri
uri TextEdit
edit = CodeAction :: Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe Bool
-> Maybe Reason
-> Maybe WorkspaceEdit
-> Maybe Command
-> Maybe Value
-> CodeAction
CodeAction {Maybe Bool
Maybe Value
Maybe WorkspaceEdit
Maybe (List Diagnostic)
Maybe Reason
Maybe CodeActionKind
Maybe Command
Text
forall a. Maybe a
$sel:_title:CodeAction :: Text
$sel:_kind:CodeAction :: Maybe CodeActionKind
$sel:_diagnostics:CodeAction :: Maybe (List Diagnostic)
$sel:_isPreferred:CodeAction :: Maybe Bool
$sel:_disabled:CodeAction :: Maybe Reason
$sel:_edit:CodeAction :: Maybe WorkspaceEdit
$sel:_command:CodeAction :: Maybe Command
$sel:_xdata:CodeAction :: Maybe Value
_xdata :: forall a. Maybe a
_disabled :: forall a. Maybe a
_isPreferred :: forall a. Maybe a
_edit :: Maybe WorkspaceEdit
_command :: forall a. Maybe a
_diagnostics :: forall a. Maybe a
_kind :: Maybe CodeActionKind
_title :: Text
..}
  where
    _title :: Text
_title = Text
title
    _kind :: Maybe CodeActionKind
_kind = CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
CodeActionQuickFix
    _diagnostics :: Maybe a
_diagnostics = Maybe a
forall a. Maybe a
Nothing
    _command :: Maybe a
_command = Maybe a
forall a. Maybe a
Nothing
    _changes :: Maybe (HashMap Uri (List TextEdit))
_changes = HashMap Uri (List TextEdit) -> Maybe (HashMap Uri (List TextEdit))
forall a. a -> Maybe a
Just (HashMap Uri (List TextEdit)
 -> Maybe (HashMap Uri (List TextEdit)))
-> HashMap Uri (List TextEdit)
-> Maybe (HashMap Uri (List TextEdit))
forall a b. (a -> b) -> a -> b
$ Uri -> List TextEdit -> HashMap Uri (List TextEdit)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Uri
uri (List TextEdit -> HashMap Uri (List TextEdit))
-> List TextEdit -> HashMap Uri (List TextEdit)
forall a b. (a -> b) -> a -> b
$ [TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edit]
    _documentChanges :: Maybe a
_documentChanges = Maybe a
forall a. Maybe a
Nothing
    _edit :: Maybe WorkspaceEdit
_edit = WorkspaceEdit -> Maybe WorkspaceEdit
forall a. a -> Maybe a
Just WorkspaceEdit :: Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit {Maybe (HashMap Uri (List TextEdit))
Maybe ChangeAnnotationMap
Maybe (List DocumentChange)
forall a. Maybe a
$sel:_changes:WorkspaceEdit :: Maybe (HashMap Uri (List TextEdit))
$sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
$sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations :: forall a. Maybe a
_documentChanges :: forall a. Maybe a
_changes :: Maybe (HashMap Uri (List TextEdit))
..}
    _isPreferred :: Maybe a
_isPreferred = Maybe a
forall a. Maybe a
Nothing
    _disabled :: Maybe a
_disabled = Maybe a
forall a. Maybe a
Nothing
    _xdata :: Maybe a
_xdata = Maybe a
forall a. Maybe a
Nothing
    _changeAnnotations :: Maybe a
_changeAnnotations = Maybe a
forall a. Maybe a
Nothing


toRange :: SrcSpan -> Maybe Range
toRange :: SrcSpan -> Maybe Range
toRange SrcSpan
src
  | (RealSrcSpan RealSrcSpan
s Maybe ()
_) <- SrcSpan
src,
    Range
range' <- RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
s =
    Range -> Maybe Range
forall a. a -> Maybe a
Just Range
range'
  | Bool
otherwise = Maybe Range
forall a. Maybe a
Nothing

isIntersectWith :: Range -> SrcSpan -> Bool
isIntersectWith :: Range -> SrcSpan -> Bool
isIntersectWith Range {Position
_start :: Range -> Position
_start :: Position
_start, Position
_end :: Range -> Position
_end :: Position
_end} SrcSpan
x = Position -> SrcSpan -> Bool
isInsideSrcSpan Position
_start SrcSpan
x Bool -> Bool -> Bool
|| Position -> SrcSpan -> Bool
isInsideSrcSpan Position
_end SrcSpan
x

-- clean prior comments, since src span we get from 'LHsDecl' does not include them
cleanPriorComments :: Annotation -> Annotation
cleanPriorComments :: Annotation -> Annotation
cleanPriorComments Annotation
x = Annotation
x {annPriorComments :: [(Comment, DeltaPos)]
annPriorComments = []}

-----------------------------------------------------------------------------

keyFromTyVar :: Int -> LHsType GhcPs -> [AnnKey]
#if MIN_VERSION_ghc(9,0,0)
-- GHC9 HsFunTy has 4 arguments, we could extract this
keyFromTyVar dep c@(L _ (HsFunTy _ _ x y))
#else
keyFromTyVar :: Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep c :: LHsType GhcPs
c@(L SrcSpan
_ (HsFunTy XFunTy GhcPs
_ LHsType GhcPs
x LHsType GhcPs
y))
#endif
  | Int
dep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = LHsType GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey LHsType GhcPs
c AnnKey -> [AnnKey] -> [AnnKey]
forall a. a -> [a] -> [a]
: Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep LHsType GhcPs
x [AnnKey] -> [AnnKey] -> [AnnKey]
forall a. [a] -> [a] -> [a]
++ Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep LHsType GhcPs
y
  | Bool
otherwise = []
keyFromTyVar Int
dep (L SrcSpan
_ t :: HsType GhcPs
t@HsForAllTy {}) = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep (HsType GhcPs -> LHsType GhcPs
forall pass. HsType pass -> LHsType pass
hst_body HsType GhcPs
t)
keyFromTyVar Int
dep (L SrcSpan
_ t :: HsType GhcPs
t@HsQualTy {}) = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep (HsType GhcPs -> LHsType GhcPs
forall pass. HsType pass -> LHsType pass
hst_body HsType GhcPs
t)
keyFromTyVar Int
dep (L SrcSpan
_ (HsKindSig XKindSig GhcPs
_ LHsType GhcPs
x LHsType GhcPs
_)) = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep LHsType GhcPs
x
keyFromTyVar Int
dep (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
x)) = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar (Int -> Int
forall a. Enum a => a -> a
succ Int
dep) LHsType GhcPs
x
keyFromTyVar Int
dep (L SrcSpan
_ (HsBangTy XBangTy GhcPs
_ HsSrcBang
_ LHsType GhcPs
x)) = Int -> LHsType GhcPs -> [AnnKey]
keyFromTyVar Int
dep LHsType GhcPs
x
keyFromTyVar Int
_ LHsType GhcPs
_ = []

keyFromCon :: [HsConDeclDetails GhcPs] -> [AnnKey]
keyFromCon :: [HsConDeclDetails GhcPs] -> [AnnKey]
keyFromCon [HsConDeclDetails GhcPs]
cons = [[AnnKey]] -> [AnnKey]
forall a. Monoid a => [a] -> a
mconcat [LConDeclField GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey (LConDeclField GhcPs -> AnnKey)
-> [LConDeclField GhcPs] -> [AnnKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LConDeclField GhcPs]
xs | (RecCon (L SrcSpan
_ [LConDeclField GhcPs]
xs)) <- [HsConDeclDetails GhcPs]
cons]

-----------------------------------------------------------------------------