{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}

{-# OPTIONS -Wno-orphans #-}

module Ide.Plugin.Retrie (descriptor) where

import           Control.Concurrent.STM               (readTVarIO)
import           Control.Exception.Safe               (Exception (..),
                                                       SomeException, catch,
                                                       throwIO, try)
import           Control.Monad                        (forM, unless)
import           Control.Monad.IO.Class               (MonadIO (liftIO))
import           Control.Monad.Trans.Class            (MonadTrans (lift))
import           Control.Monad.Trans.Except           (ExceptT (ExceptT),
                                                       runExceptT)
import           Control.Monad.Trans.Maybe
import           Data.Aeson                           (FromJSON (..),
                                                       ToJSON (..),
                                                       Value (Null))
import           Data.Bifunctor                       (second)
import qualified Data.ByteString                      as BS
import           Data.Coerce
import           Data.Either                          (partitionEithers)
import           Data.Hashable                        (unhashed)
import qualified Data.HashMap.Strict                  as HM
import qualified Data.HashSet                         as Set
import           Data.IORef.Extra                     (atomicModifyIORef'_,
                                                       newIORef, readIORef)
import           Data.List.Extra                      (find, nubOrdOn)
import           Data.String                          (IsString)
import qualified Data.Text                            as T
import qualified Data.Text.Encoding                   as T
import           Data.Typeable                        (Typeable)
import           Development.IDE                      hiding (pluginHandlers)
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.Shake           (ShakeExtras (knownTargetsVar),
                                                       toKnownFiles)
import           Development.IDE.GHC.Compat           (GenLocated (L), GhcPs,
                                                       GhcRn, GhcTc,
                                                       HsBindLR (FunBind),
                                                       HsGroup (..),
                                                       HsValBindsLR (..),
                                                       HscEnv, IdP, LRuleDecls,
                                                       ModSummary (ModSummary, ms_hspp_buf, ms_mod),
                                                       Outputable,
                                                       ParsedModule (..),
                                                       RuleDecl (HsRule),
                                                       RuleDecls (HsRules),
                                                       SourceText (..),
                                                       TyClDecl (SynDecl),
                                                       TyClGroup (..), fun_id,
                                                       hm_iface, isQual,
                                                       isQual_maybe, locA,
                                                       mi_fixities,
                                                       moduleNameString,
                                                       ms_hspp_opts,
                                                       nameModule_maybe,
                                                       nameRdrName, noLocA,
                                                       occNameFS, occNameString,
                                                       pattern IsBoot,
                                                       pattern NotBoot,
                                                       pattern RealSrcSpan,
                                                       pm_parsed_source,
                                                       rdrNameOcc, rds_rules,
                                                       srcSpanFile, topDir,
                                                       unLocA)
import           Development.IDE.GHC.Compat.Util      hiding (catch, try)
import qualified GHC                                  (Module,
                                                       ParsedModule (..),
                                                       moduleName, parseModule)
import           GHC.Generics                         (Generic)
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Server                  (LspM,
                                                       ProgressCancellable (Cancellable),
                                                       sendNotification,
                                                       sendRequest,
                                                       withIndefiniteProgress)
import           Language.LSP.Types                   as J hiding
                                                           (SemanticTokenAbsolute (length, line),
                                                            SemanticTokenRelative (length),
                                                            SemanticTokensEdit (_start))
import           Retrie.CPP                           (CPP (NoCPP), parseCPP)
import           Retrie.ExactPrint                    (Annotated, fix,
                                                       transformA, unsafeMkA)

#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.PkgQual
#endif

#if MIN_VERSION_ghc(9,2,0)
import           Retrie.ExactPrint                    (makeDeltaAst)
#else
import           Retrie.ExactPrint                    (relativiseApiAnns)
#endif
import           Retrie.Fixity                        (mkFixityEnv)
import qualified Retrie.GHC                           as GHC
import           Retrie.Monad                         (addImports, apply,
                                                       getGroundTerms,
                                                       runRetrie)
import qualified Retrie.Options                       as Retrie
import           Retrie.Options                       (defaultOptions,
                                                       getTargetFiles)
import           Retrie.Replace                       (Change (..),
                                                       Replacement (..))
import           Retrie.Rewrites
import           Retrie.SYB                           (listify)
import           Retrie.Util                          (Verbosity (Loud))
import           System.Directory                     (makeAbsolute)

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

retrieCommandName :: T.Text
retrieCommandName :: Text
retrieCommandName = Text
"retrieCommand"

retrieCommand :: PluginCommand IdeState
retrieCommand :: PluginCommand IdeState
retrieCommand =
  forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (coerce :: forall a b. Coercible a b => a -> b
coerce Text
retrieCommandName) Text
"run the refactoring" forall c.
IdeState -> RunRetrieParams -> LspM c (Either ResponseError Value)
runRetrieCmd

-- | Parameters for the runRetrie PluginCommand.
data RunRetrieParams = RunRetrieParams
  { RunRetrieParams -> Text
description               :: T.Text,
    RunRetrieParams -> [RewriteSpec]
rewrites                  :: [RewriteSpec],
    RunRetrieParams -> Uri
originatingFile           :: Uri,
    RunRetrieParams -> Bool
restrictToOriginatingFile :: Bool
  }
  deriving (RunRetrieParams -> RunRetrieParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunRetrieParams -> RunRetrieParams -> Bool
$c/= :: RunRetrieParams -> RunRetrieParams -> Bool
== :: RunRetrieParams -> RunRetrieParams -> Bool
$c== :: RunRetrieParams -> RunRetrieParams -> Bool
Eq, Int -> RunRetrieParams -> ShowS
[RunRetrieParams] -> ShowS
RunRetrieParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunRetrieParams] -> ShowS
$cshowList :: [RunRetrieParams] -> ShowS
show :: RunRetrieParams -> String
$cshow :: RunRetrieParams -> String
showsPrec :: Int -> RunRetrieParams -> ShowS
$cshowsPrec :: Int -> RunRetrieParams -> ShowS
Show, forall x. Rep RunRetrieParams x -> RunRetrieParams
forall x. RunRetrieParams -> Rep RunRetrieParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunRetrieParams x -> RunRetrieParams
$cfrom :: forall x. RunRetrieParams -> Rep RunRetrieParams x
Generic, Value -> Parser [RunRetrieParams]
Value -> Parser RunRetrieParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RunRetrieParams]
$cparseJSONList :: Value -> Parser [RunRetrieParams]
parseJSON :: Value -> Parser RunRetrieParams
$cparseJSON :: Value -> Parser RunRetrieParams
FromJSON, [RunRetrieParams] -> Encoding
[RunRetrieParams] -> Value
RunRetrieParams -> Encoding
RunRetrieParams -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RunRetrieParams] -> Encoding
$ctoEncodingList :: [RunRetrieParams] -> Encoding
toJSONList :: [RunRetrieParams] -> Value
$ctoJSONList :: [RunRetrieParams] -> Value
toEncoding :: RunRetrieParams -> Encoding
$ctoEncoding :: RunRetrieParams -> Encoding
toJSON :: RunRetrieParams -> Value
$ctoJSON :: RunRetrieParams -> Value
ToJSON)
runRetrieCmd ::
  IdeState ->
  RunRetrieParams ->
  LspM c (Either ResponseError Value)
runRetrieCmd :: forall c.
IdeState -> RunRetrieParams -> LspM c (Either ResponseError Value)
runRetrieCmd IdeState
state RunRetrieParams{originatingFile :: RunRetrieParams -> Uri
originatingFile = Uri
uri, Bool
[RewriteSpec]
Text
restrictToOriginatingFile :: Bool
rewrites :: [RewriteSpec]
description :: Text
restrictToOriginatingFile :: RunRetrieParams -> Bool
rewrites :: RunRetrieParams -> [RewriteSpec]
description :: RunRetrieParams -> Text
..} =
  forall c (m :: * -> *) a.
MonadLsp c m =>
Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress Text
description ProgressCancellable
Cancellable forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
        NormalizedFilePath
nfp <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
        (HscEnvEq
session, PositionMapping
_) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.GhcSessionDeps" IdeState
state forall a b. (a -> b) -> a -> b
$
                forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps
                NormalizedFilePath
nfp
        (ModSummary
ms, [HsBindLR GhcRn GhcRn]
binds, PositionMapping
_, [GenLocated SrcSpanAnnA (RuleDecls GhcRn)]
_, [TyClGroup GhcRn]
_) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.getBinds" IdeState
state forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
getBinds NormalizedFilePath
nfp
        let importRewrites :: [ImportSpec]
importRewrites = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec]
extractImports ModSummary
ms [HsBindLR GhcRn GhcRn]
binds) [RewriteSpec]
rewrites
        ([CallRetrieError]
errors, WorkspaceEdit
edits) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            IdeState
-> HscEnv
-> [Either ImportSpec RewriteSpec]
-> NormalizedFilePath
-> Bool
-> IO ([CallRetrieError], WorkspaceEdit)
callRetrie
                IdeState
state
                (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session)
                (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [RewriteSpec]
rewrites forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [ImportSpec]
importRewrites)
                NormalizedFilePath
nfp
                Bool
restrictToOriginatingFile
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CallRetrieError]
errors) forall a b. (a -> b) -> a -> b
$
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SMethod 'WindowShowMessage
SWindowShowMessage forall a b. (a -> b) -> a -> b
$
                    MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MtWarning forall a b. (a -> b) -> a -> b
$
                    [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
                        Text
"## Found errors during rewrite:" forall a. a -> [a] -> [a]
:
                        [Text
"-" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show CallRetrieError
e) | CallRetrieError
e <- [CallRetrieError]
errors]
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edits) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null

extractImports :: ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec]
extractImports :: ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec]
extractImports ModSummary{Module
ms_mod :: Module
ms_mod :: ModSummary -> Module
ms_mod} [HsBindLR GhcRn GhcRn]
topLevelBinds (Unfold String
thing)
  | Just FunBind {MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches}
  <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\case FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ Name
n} -> Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable Name
n) forall a. Eq a => a -> a -> Bool
== String
thing ; HsBindLR GhcRn GhcRn
_ -> Bool
False) [HsBindLR GhcRn GhcRn]
topLevelBinds
  , [Name]
names <- forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify Name -> Bool
p MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches
  =
    [ AddImport {Bool
String
Maybe String
Maybe (IE String)
ideclThing :: Maybe (IE String)
ideclAsString :: Maybe String
ideclQualifiedBool :: Bool
ideclSource :: Bool
ideclNameString :: String
ideclNameString :: String
ideclThing :: Maybe (IE String)
ideclAsString :: Maybe String
ideclQualifiedBool :: Bool
ideclSource :: Bool
..}
    | let ideclSource :: Bool
ideclSource = Bool
False,
        Name
name <- [Name]
names,
        let r :: RdrName
r = Name -> RdrName
nameRdrName Name
name,
        let ideclQualifiedBool :: Bool
ideclQualifiedBool = RdrName -> Bool
isQual RdrName
r,
        let ideclAsString :: Maybe String
ideclAsString = ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
r,
        let ideclThing :: Maybe (IE String)
ideclThing = forall a. a -> Maybe a
Just (forall name. name -> IE name
IEVar forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
r),
        Just String
ideclNameString <-
        [ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Module
nameModule_maybe Name
name]
    ]
    where
        p :: Name -> Bool
p Name
name = Name -> Maybe Module
nameModule_maybe Name
name forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Module
ms_mod
-- TODO handle imports for all rewrites
extractImports ModSummary
_ [HsBindLR GhcRn GhcRn]
_ RewriteSpec
_ = []

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

provider :: PluginMethodHandler IdeState TextDocumentCodeAction
provider :: PluginMethodHandler IdeState 'TextDocumentCodeAction
provider IdeState
state PluginId
plId (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
range CodeActionContext
ca) = forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse forall a b. (a -> b) -> a -> b
$ do
  let (J.CodeActionContext List Diagnostic
_diags Maybe (List CodeActionKind)
_monly) = CodeActionContext
ca
      nuri :: NormalizedUri
nuri = Uri -> NormalizedUri
toNormalizedUri Uri
uri
  NormalizedFilePath
nfp <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"uri" forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
nuri

  (ModSummary{Module
ms_mod :: Module
ms_mod :: ModSummary -> Module
ms_mod}, [HsBindLR GhcRn GhcRn]
topLevelBinds, PositionMapping
posMapping, [GenLocated SrcSpanAnnA (RuleDecls GhcRn)]
hs_ruleds, [TyClGroup GhcRn]
hs_tyclds)
    <- forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"typecheck" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"retrie" IdeState
state forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
getBinds NormalizedFilePath
nfp

  Position
pos <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"pos" forall a b. (a -> b) -> a -> b
$ Range -> Position
_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
posMapping Range
range
  let rewrites :: [(Text, CodeActionKind, RunRetrieParams)]
rewrites =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Uri
-> Position
-> Module
-> HsBindLR GhcRn GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites Uri
uri Position
pos Module
ms_mod) [HsBindLR GhcRn GhcRn]
topLevelBinds
          forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Uri
-> Position
-> Module
-> LRuleDecls GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites Uri
uri Position
pos Module
ms_mod) [GenLocated SrcSpanAnnA (RuleDecls GhcRn)]
hs_ruleds
          forall a. [a] -> [a] -> [a]
++ [ (Text, CodeActionKind, RunRetrieParams)
r
               | TyClGroup {[LTyClDecl GhcRn]
group_tyclds :: forall pass. TyClGroup pass -> [LTyClDecl pass]
group_tyclds :: [LTyClDecl GhcRn]
group_tyclds} <- [TyClGroup GhcRn]
hs_tyclds,
                 L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) TyClDecl GhcRn
g <- [LTyClDecl GhcRn]
group_tyclds,
                 Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l,
                 (Text, CodeActionKind, RunRetrieParams)
r <- Outputable (IdP GhcRn) =>
Uri
-> Module
-> TyClDecl GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites Uri
uri Module
ms_mod TyClDecl GhcRn
g

             ]

  [CodeAction]
commands <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, CodeActionKind, RunRetrieParams)]
rewrites forall a b. (a -> b) -> a -> b
$ \(Text
title, CodeActionKind
kind, RunRetrieParams
params) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      let c :: Command
c = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId (coerce :: forall a b. Coercible a b => a -> b
coerce Text
retrieCommandName) Text
title (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON RunRetrieParams
params])
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. a -> Maybe a
Just CodeActionKind
kind) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Command
c) forall a. Maybe a
Nothing

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
J.List [forall a b. b -> a |? b
InR CodeAction
c | CodeAction
c <- [CodeAction]
commands]

getBinds :: NormalizedFilePath -> Action (Maybe (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping, [LRuleDecls GhcRn], [TyClGroup GhcRn]))
getBinds :: NormalizedFilePath
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
getBinds NormalizedFilePath
nfp = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  (TcModuleResult
tm, PositionMapping
posMapping) <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
nfp
  -- we use the typechecked source instead of the parsed source
  -- to be able to extract module names from the Ids,
  -- so that we can include adding the required imports in the retrie command
  let rn :: RenamedSource
rn = TcModuleResult -> RenamedSource
tmrRenamed TcModuleResult
tm
      ( HsGroup
          { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds =
              XValBindsLR
                (GHC.NValBinds [(RecFlag, LHsBinds GhcRn)]
binds [LSig GhcRn]
_sigs :: GHC.NHsValBindsLR GhcRn),
            [LRuleDecls GhcRn]
hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
hs_ruleds :: [LRuleDecls GhcRn]
hs_ruleds,
            [TyClGroup GhcRn]
hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds :: [TyClGroup GhcRn]
hs_tyclds
          },
        [LImportDecl GhcRn]
_,
        Maybe [(LIE GhcRn, Avails)]
_,
        Maybe LHsDocString
_
        ) = RenamedSource
rn

      topLevelBinds :: [HsBindLR GhcRn GhcRn]
topLevelBinds =
        [ HsBindLR GhcRn GhcRn
decl
          | (RecFlag
_, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
bagBinds) <- [(RecFlag, LHsBinds GhcRn)]
binds,
            L SrcSpanAnnA
_ HsBindLR GhcRn GhcRn
decl <- forall a. Bag a -> [a]
GHC.bagToList Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
bagBinds
        ]
  forall (m :: * -> *) a. Monad m => a -> m a
return (TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tm, [HsBindLR GhcRn GhcRn]
topLevelBinds, PositionMapping
posMapping, [LRuleDecls GhcRn]
hs_ruleds, [TyClGroup GhcRn]
hs_tyclds)

suggestBindRewrites ::
  Uri ->
  Position ->
  GHC.Module ->
  HsBindLR GhcRn GhcRn ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites :: Uri
-> Position
-> Module
-> HsBindLR GhcRn GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites Uri
originatingFile Position
pos Module
ms_mod FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l') Name
rdrName}
  | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l' =
    let pprNameText :: Text
pprNameText = forall a. Outputable a => a -> Text
printOutputable Name
rdrName
        pprName :: String
pprName = Text -> String
T.unpack Text
pprNameText
        unfoldRewrite :: Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
restrictToOriginatingFile =
            let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
Unfold (Module -> ShowS
qualify Module
ms_mod String
pprName)]
                description :: Text
description = Text
"Unfold " forall a. Semigroup a => a -> a -> a
<> Text
pprNameText forall a. Semigroup a => a -> a -> a
<> forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
            in (Text
description, CodeActionKind
CodeActionRefactorInline, RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..})
        foldRewrite :: Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
restrictToOriginatingFile =
          let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
Fold (Module -> ShowS
qualify Module
ms_mod String
pprName)]
              description :: Text
description = Text
"Fold " forall a. Semigroup a => a -> a -> a
<> Text
pprNameText forall a. Semigroup a => a -> a -> a
<> forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorExtract, RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..})
     in [Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
False, Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
True, Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
False, Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
True]
suggestBindRewrites Uri
_ Position
_ Module
_ HsBindLR GhcRn GhcRn
_ = []

describeRestriction :: IsString p => Bool -> p
describeRestriction :: forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile =
        if Bool
restrictToOriginatingFile then p
" in current file" else p
""

suggestTypeRewrites ::
  (Outputable (IdP GhcRn)) =>
  Uri ->
  GHC.Module ->
  TyClDecl GhcRn ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites :: Outputable (IdP GhcRn) =>
Uri
-> Module
-> TyClDecl GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites Uri
originatingFile Module
ms_mod SynDecl {LIdP GhcRn
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcRn
tcdLName} =
    let pprNameText :: Text
pprNameText = forall a. Outputable a => a -> Text
printOutputable (forall (pass :: Pass) a. XRec (GhcPass pass) a -> a
unLocA LIdP GhcRn
tcdLName)
        pprName :: String
pprName = Text -> String
T.unpack Text
pprNameText
        unfoldRewrite :: Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
restrictToOriginatingFile =
            let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
TypeForward (Module -> ShowS
qualify Module
ms_mod String
pprName)]
                description :: Text
description = Text
"Unfold " forall a. Semigroup a => a -> a -> a
<> Text
pprNameText forall a. Semigroup a => a -> a -> a
<> forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorInline, RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..})
        foldRewrite :: Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
restrictToOriginatingFile =
          let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
TypeBackward (Module -> ShowS
qualify Module
ms_mod String
pprName)]
              description :: Text
description = Text
"Fold " forall a. Semigroup a => a -> a -> a
<> Text
pprNameText forall a. Semigroup a => a -> a -> a
<> forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorExtract, RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..})
     in [Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
False, Bool -> (Text, CodeActionKind, RunRetrieParams)
unfoldRewrite Bool
True, Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
False, Bool -> (Text, CodeActionKind, RunRetrieParams)
foldRewrite Bool
True]
suggestTypeRewrites Uri
_ Module
_ TyClDecl GhcRn
_ = []

suggestRuleRewrites ::
  Uri ->
  Position ->
  GHC.Module ->
  LRuleDecls GhcRn ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites :: Uri
-> Position
-> Module
-> LRuleDecls GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites Uri
originatingFile Position
pos Module
ms_mod (L SrcSpanAnnA
_ HsRules {[LRuleDecl GhcRn]
rds_rules :: [LRuleDecl GhcRn]
rds_rules :: forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_rules}) =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [ String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
forwardRewrite   String
ruleName Bool
True
          , String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
forwardRewrite   String
ruleName Bool
False
          , String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
backwardsRewrite String
ruleName Bool
True
          , String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
backwardsRewrite String
ruleName Bool
False
          ]
        | L (forall a. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
l) RuleDecl GhcRn
r  <- [LRuleDecl GhcRn]
rds_rules,
          Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l,
          let HsRule {rd_name :: forall pass. RuleDecl pass -> XRec pass (SourceText, RuleName)
rd_name = L SrcSpan
_ (SourceText
_, RuleName
rn)} = RuleDecl GhcRn
r,
          let ruleName :: String
ruleName = RuleName -> String
unpackFS RuleName
rn
      ]
  where
    forwardRewrite :: String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
forwardRewrite String
ruleName Bool
restrictToOriginatingFile =
        let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
RuleForward (Module -> ShowS
qualify Module
ms_mod String
ruleName)]
            description :: Text
description = Text
"Apply rule " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ruleName forall a. Semigroup a => a -> a -> a
<> Text
" forward" forall a. Semigroup a => a -> a -> a
<>
                            forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile

        in ( Text
description,
            CodeActionKind
CodeActionRefactor,
            RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..}
            )
    backwardsRewrite :: String -> Bool -> (Text, CodeActionKind, RunRetrieParams)
backwardsRewrite String
ruleName Bool
restrictToOriginatingFile =
          let rewrites :: [RewriteSpec]
rewrites = [String -> RewriteSpec
RuleBackward (Module -> ShowS
qualify Module
ms_mod String
ruleName)]
              description :: Text
description = Text
"Apply rule " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ruleName forall a. Semigroup a => a -> a -> a
<> Text
" backwards" forall a. Semigroup a => a -> a -> a
<>
                              forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in ( Text
description,
                CodeActionKind
CodeActionRefactor,
                RunRetrieParams {Bool
[RewriteSpec]
Text
Uri
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: Uri
restrictToOriginatingFile :: Bool
originatingFile :: Uri
rewrites :: [RewriteSpec]
description :: Text
..}
              )
suggestRuleRewrites Uri
_ Position
_ Module
_ LRuleDecls GhcRn
_ = []

qualify :: GHC.Module -> String -> String
qualify :: Module -> ShowS
qualify Module
ms_mod String
x = Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable Module
ms_mod) forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> String
x

-------------------------------------------------------------------------------
-- Retrie driving code

data CallRetrieError
  = CallRetrieInternalError String NormalizedFilePath
  | NoParse NormalizedFilePath
  | GHCParseError NormalizedFilePath String
  | NoTypeCheck NormalizedFilePath
  deriving (CallRetrieError -> CallRetrieError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallRetrieError -> CallRetrieError -> Bool
$c/= :: CallRetrieError -> CallRetrieError -> Bool
== :: CallRetrieError -> CallRetrieError -> Bool
$c== :: CallRetrieError -> CallRetrieError -> Bool
Eq, Typeable)

instance Show CallRetrieError where
  show :: CallRetrieError -> String
show (CallRetrieInternalError String
msg NormalizedFilePath
f) = String
msg forall a. Semigroup a => a -> a -> a
<> String
" - " forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f
  show (NoParse NormalizedFilePath
f) = String
"Cannot parse: " forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f
  show (GHCParseError NormalizedFilePath
f String
m) = String
"Cannot parse " forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f forall a. Semigroup a => a -> a -> a
<> String
" : " forall a. Semigroup a => a -> a -> a
<> String
m
  show (NoTypeCheck NormalizedFilePath
f) = String
"File does not typecheck: " forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f

instance Exception CallRetrieError

callRetrie ::
  IdeState ->
  HscEnv ->
  [Either ImportSpec RewriteSpec] ->
  NormalizedFilePath ->
  Bool ->
  IO ([CallRetrieError], WorkspaceEdit)
callRetrie :: IdeState
-> HscEnv
-> [Either ImportSpec RewriteSpec]
-> NormalizedFilePath
-> Bool
-> IO ([CallRetrieError], WorkspaceEdit)
callRetrie IdeState
state HscEnv
session [Either ImportSpec RewriteSpec]
rewrites NormalizedFilePath
origin Bool
restrictToOriginatingFile = do
  HashSet NormalizedFilePath
knownFiles <- KnownTargets -> HashSet NormalizedFilePath
toKnownFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashed a -> a
unhashed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TVar a -> IO a
readTVarIO (ShakeExtras -> TVar (Hashed KnownTargets)
knownTargetsVar forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state)
#if MIN_VERSION_ghc(9,2,0)
  -- retrie needs the libdir for `parseRewriteSpecs`
  String
libdir <- DynFlags -> String
topDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> DynFlags
ms_hspp_opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummaryResult -> ModSummary
msrModSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"Retrie.GetModSummary" (String -> NormalizedFilePath -> CallRetrieError
CallRetrieInternalError String
"file not found") GetModSummary
GetModSummary NormalizedFilePath
origin
#endif
  let reuseParsedModule :: NormalizedFilePath -> IO (FixityEnv, Annotated ParsedSource)
reuseParsedModule NormalizedFilePath
f = do
        ParsedModule
pm <- forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"Retrie.GetParsedModule" NormalizedFilePath -> CallRetrieError
NoParse GetParsedModule
GetParsedModule NormalizedFilePath
f
        (FixityEnv
fixities, Annotated ParsedSource
pm') <- forall {ast2}.
Data ast2 =>
NormalizedFilePath
-> Annotated ast2 -> IO (FixityEnv, Annotated ast2)
fixFixities NormalizedFilePath
f (ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule
pm)
        forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ParsedSource
pm')
      getCPPmodule :: String -> IO (FixityEnv, CPP (Annotated ParsedSource))
getCPPmodule String
t = do
        NormalizedFilePath
nt <- String -> NormalizedFilePath
toNormalizedFilePath' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
makeAbsolute String
t
        let getParsedModule :: NormalizedFilePath
-> String -> IO (FixityEnv, Annotated ParsedSource)
getParsedModule NormalizedFilePath
f String
contents = do
              ModSummary
modSummary <- ModSummaryResult -> ModSummary
msrModSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"Retrie.GetModSummary" (String -> NormalizedFilePath -> CallRetrieError
CallRetrieInternalError String
"file not found") GetModSummary
GetModSummary NormalizedFilePath
nt
              let ms' :: ModSummary
ms' =
                    ModSummary
modSummary
                      { ms_hspp_buf :: Maybe StringBuffer
ms_hspp_buf =
                          forall a. a -> Maybe a
Just (String -> StringBuffer
stringToStringBuffer String
contents)
                      }
              Logger -> Priority -> Text -> IO ()
logPriority (IdeState -> Logger
ideLogger IdeState
state) Priority
Info forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Parsing module: " forall a. Semigroup a => a -> a -> a
<> String
t
              ParsedModule
parsed <- forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
session (forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
GHC.parseModule ModSummary
ms')
                  forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (NormalizedFilePath -> String -> CallRetrieError
GHCParseError NormalizedFilePath
nt (forall a. Show a => a -> String
show @SomeException SomeException
e))
              (FixityEnv
fixities, Annotated ParsedSource
parsed) <- forall {ast2}.
Data ast2 =>
NormalizedFilePath
-> Annotated ast2 -> IO (FixityEnv, Annotated ast2)
fixFixities NormalizedFilePath
f (ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule
parsed)
              forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ParsedSource
parsed)

        Text
contents <- do
          (UTCTime
_, Maybe Text
mbContentsVFS) <-
            forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.GetFileContents" IdeState
state forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
nt
          case Maybe Text
mbContentsVFS of
            Just Text
contents -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
contents
            Maybe Text
Nothing       -> ByteString -> Text
T.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nt)
        if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
T.isPrefixOf Text
"#if" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower) (Text -> [Text]
T.lines Text
contents)
          then do
            IORef FixityEnv
fixitiesRef <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
            let parseModule :: String -> IO (Annotated ParsedSource)
parseModule String
x = do
                  (FixityEnv
fix, Annotated ParsedSource
res) <- NormalizedFilePath
-> String -> IO (FixityEnv, Annotated ParsedSource)
getParsedModule NormalizedFilePath
nt String
x
                  forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef FixityEnv
fixitiesRef (FixityEnv
fix forall a. Semigroup a => a -> a -> a
<>)
                  forall (m :: * -> *) a. Monad m => a -> m a
return Annotated ParsedSource
res
            CPP (Annotated ParsedSource)
res <- forall (m :: * -> *).
Monad m =>
(String -> m (Annotated ParsedSource))
-> Text -> m (CPP (Annotated ParsedSource))
parseCPP String -> IO (Annotated ParsedSource)
parseModule Text
contents
            FixityEnv
fixities <- forall a. IORef a -> IO a
readIORef IORef FixityEnv
fixitiesRef
            forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, CPP (Annotated ParsedSource)
res)
          else do
            (FixityEnv
fixities, Annotated ParsedSource
pm) <- NormalizedFilePath -> IO (FixityEnv, Annotated ParsedSource)
reuseParsedModule NormalizedFilePath
nt
            forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, forall a. a -> CPP a
NoCPP Annotated ParsedSource
pm)

      -- TODO cover all workspaceFolders
      target :: String
target = String
"."

      retrieOptions :: Retrie.Options
      retrieOptions :: Options
retrieOptions = (forall rewrites imports.
(Default rewrites, Default imports) =>
String -> Options_ rewrites imports
defaultOptions String
target)
        {verbosity :: Verbosity
Retrie.verbosity = Verbosity
Loud
        ,targetFiles :: [String]
Retrie.targetFiles = forall a b. (a -> b) -> [a] -> [b]
map NormalizedFilePath -> String
fromNormalizedFilePath forall a b. (a -> b) -> a -> b
$
            if Bool
restrictToOriginatingFile
                then [NormalizedFilePath
origin]
                else forall a. HashSet a -> [a]
Set.toList HashSet NormalizedFilePath
knownFiles
        }

      ([ImportSpec]
theImports, [RewriteSpec]
theRewrites) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ImportSpec RewriteSpec]
rewrites

      annotatedImports :: Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
annotatedImports =
#if MIN_VERSION_ghc(9,2,0)
        forall ast. ast -> Int -> Annotated ast
unsafeMkA (forall a b. (a -> b) -> [a] -> [b]
map (forall a an. a -> LocatedAn an a
noLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportSpec -> ImportDecl GhcPs
toImportDecl) [ImportSpec]
theImports) Int
0
#else
        unsafeMkA (map (noLocA . toImportDecl) theImports) mempty 0
#endif

  (FixityEnv
originFixities, Annotated ParsedSource
originParsedModule) <- NormalizedFilePath -> IO (FixityEnv, Annotated ParsedSource)
reuseParsedModule NormalizedFilePath
origin
  Retrie ()
retrie <-
    (\[Rewrite Universe]
specs -> [Rewrite Universe] -> Retrie ()
apply [Rewrite Universe]
specs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotatedImports -> Retrie ()
addImports Annotated [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
annotatedImports)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (String -> IO (CPP (Annotated ParsedSource)))
-> FixityEnv
-> [RewriteSpec]
-> IO [Rewrite Universe]
parseRewriteSpecs
#if MIN_VERSION_ghc(9,2,0)
        String
libdir
#endif
        (\String
_f -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> CPP a
NoCPP Annotated ParsedSource
originParsedModule)
        FixityEnv
originFixities
        [RewriteSpec]
theRewrites

  [String]
targets <- forall a b. Options_ a b -> [GroundTerms] -> IO [String]
getTargetFiles Options
retrieOptions (forall a. Retrie a -> [GroundTerms]
getGroundTerms Retrie ()
retrie)

  [Either CallRetrieError [(Uri, TextEdit)]]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
targets forall a b. (a -> b) -> a -> b
$ \String
t -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    (FixityEnv
fixityEnv, CPP (Annotated ParsedSource)
cpp) <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO (FixityEnv, CPP (Annotated ParsedSource))
getCPPmodule String
t
    -- TODO add the imports to the resulting edits
    (()
_user, CPP (Annotated ParsedSource)
ast, change :: Change
change@(Change [Replacement]
_replacements [AnnotatedImports]
_imports)) <-
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a.
FixityEnv
-> Retrie a
-> CPP (Annotated ParsedSource)
-> IO (a, CPP (Annotated ParsedSource), Change)
runRetrie FixityEnv
fixityEnv Retrie ()
retrie CPP (Annotated ParsedSource)
cpp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Change -> [(Uri, TextEdit)]
asTextEdits Change
change

  let ([CallRetrieError]
errors :: [CallRetrieError], [[(Uri, TextEdit)]]
replacements) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CallRetrieError [(Uri, TextEdit)]]
results
      editParams :: WorkspaceEdit
      editParams :: WorkspaceEdit
editParams =
        Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [[(Uri, TextEdit)]] -> WorkspaceEditMap
asEditMap [[(Uri, TextEdit)]]
replacements) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

  forall (m :: * -> *) a. Monad m => a -> m a
return ([CallRetrieError]
errors, WorkspaceEdit
editParams)
  where
    useOrFail ::
      IdeRule r v =>
      String ->
      (NormalizedFilePath -> CallRetrieError) ->
      r ->
      NormalizedFilePath ->
      IO (RuleResult r)
    useOrFail :: forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
lbl NormalizedFilePath -> CallRetrieError
mkException r
rule NormalizedFilePath
f =
      forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
useRule String
lbl IdeState
state r
rule NormalizedFilePath
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> CallRetrieError
mkException NormalizedFilePath
f) forall (m :: * -> *) a. Monad m => a -> m a
return
    fixityEnvFromModIface :: ModIface_ phase -> FixityEnv
fixityEnvFromModIface ModIface_ phase
modIface =
      [(RuleName, (RuleName, Fixity))] -> FixityEnv
mkFixityEnv
        [ (RuleName
fs, (RuleName
fs, Fixity
fixity))
          | (OccName
n, Fixity
fixity) <- forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities ModIface_ phase
modIface,
            let fs :: RuleName
fs = OccName -> RuleName
occNameFS OccName
n
        ]
    fixFixities :: NormalizedFilePath
-> Annotated ast2 -> IO (FixityEnv, Annotated ast2)
fixFixities NormalizedFilePath
f Annotated ast2
pm = do
      HiFileResult {ModIface
hirModIface :: HiFileResult -> ModIface
hirModIface :: ModIface
hirModIface} <-
        forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"GetModIface" NormalizedFilePath -> CallRetrieError
NoTypeCheck GetModIface
GetModIface NormalizedFilePath
f
      let fixities :: FixityEnv
fixities = forall {phase :: ModIfacePhase}. ModIface_ phase -> FixityEnv
fixityEnvFromModIface ModIface
hirModIface
      Annotated ast2
res <- forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ast2
pm (forall ast (m :: * -> *).
(Data ast, MonadIO m) =>
FixityEnv -> ast -> TransformT m ast
fix FixityEnv
fixities)
      forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ast2
res)
#if MIN_VERSION_ghc(9,2,0)
    fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns GHC.ParsedModule{ParsedSource
pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source :: ParsedSource
pm_parsed_source} = forall ast. ast -> Int -> Annotated ast
unsafeMkA (forall ast. ExactPrint ast => ast -> ast
makeDeltaAst ParsedSource
pm_parsed_source) Int
0
#else
    fixAnns GHC.ParsedModule {..} =
      let ranns = relativiseApiAnns pm_parsed_source pm_annotations
       in unsafeMkA pm_parsed_source ranns 0
#endif

asEditMap :: [[(Uri, TextEdit)]] -> WorkspaceEditMap
asEditMap :: [[(Uri, TextEdit)]] -> WorkspaceEditMap
asEditMap = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HM.fromListWith forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (f :: * -> *) a. Applicative f => a -> f a
pure))

asTextEdits :: Change -> [(Uri, TextEdit)]
asTextEdits :: Change -> [(Uri, TextEdit)]
asTextEdits Change
NoChange = []
asTextEdits (Change [Replacement]
reps [AnnotatedImports]
_imports) =
  [ (String -> Uri
filePathToUri String
spanLoc, TextEdit
edit)
    | Replacement {String
SrcSpan
replLocation :: Replacement -> SrcSpan
replOriginal :: Replacement -> String
replReplacement :: Replacement -> String
replReplacement :: String
replOriginal :: String
replLocation :: SrcSpan
..} <- forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (SrcSpan -> Maybe RealSrcSpan
realSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> SrcSpan
replLocation) [Replacement]
reps,
      (RealSrcSpan RealSrcSpan
rspan Maybe BufSpan
_) <- [SrcSpan
replLocation],
      let spanLoc :: String
spanLoc = RuleName -> String
unpackFS forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> RuleName
srcSpanFile RealSrcSpan
rspan,
      let edit :: TextEdit
edit = Range -> Text -> TextEdit
TextEdit (RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
rspan) (String -> Text
T.pack String
replReplacement)
  ]

-------------------------------------------------------------------------------
-- Rule wrappers

_useRuleBlocking,
  _useRuleStale,
  useRule ::
    (IdeRule k v) =>
    String ->
    IdeState ->
    k ->
    NormalizedFilePath ->
    IO (Maybe (RuleResult k))
_useRuleBlocking :: forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleBlocking String
label IdeState
state k
rule NormalizedFilePath
f = forall a. String -> IdeState -> Action a -> IO a
runAction String
label IdeState
state (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use k
rule NormalizedFilePath
f)
_useRuleStale :: forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleStale String
label IdeState
state k
rule NormalizedFilePath
f =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
label (IdeState -> ShakeExtras
shakeExtras IdeState
state) (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast k
rule NormalizedFilePath
f)

-- | Chosen approach for calling ghcide Shake rules
useRule :: forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
useRule String
label = forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleStale (String
"Retrie." forall a. Semigroup a => a -> a -> a
<> String
label)

-------------------------------------------------------------------------------
-- Serialization wrappers and instances

deriving instance Eq RewriteSpec

deriving instance Show RewriteSpec

deriving instance Generic RewriteSpec

deriving instance FromJSON RewriteSpec

deriving instance ToJSON RewriteSpec

data QualName = QualName {QualName -> String
qual, QualName -> String
name :: String}
  deriving (QualName -> QualName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualName -> QualName -> Bool
$c/= :: QualName -> QualName -> Bool
== :: QualName -> QualName -> Bool
$c== :: QualName -> QualName -> Bool
Eq, Int -> QualName -> ShowS
[QualName] -> ShowS
QualName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualName] -> ShowS
$cshowList :: [QualName] -> ShowS
show :: QualName -> String
$cshow :: QualName -> String
showsPrec :: Int -> QualName -> ShowS
$cshowsPrec :: Int -> QualName -> ShowS
Show, forall x. Rep QualName x -> QualName
forall x. QualName -> Rep QualName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QualName x -> QualName
$cfrom :: forall x. QualName -> Rep QualName x
Generic, Value -> Parser [QualName]
Value -> Parser QualName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [QualName]
$cparseJSONList :: Value -> Parser [QualName]
parseJSON :: Value -> Parser QualName
$cparseJSON :: Value -> Parser QualName
FromJSON, [QualName] -> Encoding
[QualName] -> Value
QualName -> Encoding
QualName -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [QualName] -> Encoding
$ctoEncodingList :: [QualName] -> Encoding
toJSONList :: [QualName] -> Value
$ctoJSONList :: [QualName] -> Value
toEncoding :: QualName -> Encoding
$ctoEncoding :: QualName -> Encoding
toJSON :: QualName -> Value
$ctoJSON :: QualName -> Value
ToJSON)

newtype IE name
  = IEVar name
  deriving (IE name -> IE name -> Bool
forall name. Eq name => IE name -> IE name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IE name -> IE name -> Bool
$c/= :: forall name. Eq name => IE name -> IE name -> Bool
== :: IE name -> IE name -> Bool
$c== :: forall name. Eq name => IE name -> IE name -> Bool
Eq, Int -> IE name -> ShowS
forall name. Show name => Int -> IE name -> ShowS
forall name. Show name => [IE name] -> ShowS
forall name. Show name => IE name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IE name] -> ShowS
$cshowList :: forall name. Show name => [IE name] -> ShowS
show :: IE name -> String
$cshow :: forall name. Show name => IE name -> String
showsPrec :: Int -> IE name -> ShowS
$cshowsPrec :: forall name. Show name => Int -> IE name -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall name x. Rep (IE name) x -> IE name
forall name x. IE name -> Rep (IE name) x
$cto :: forall name x. Rep (IE name) x -> IE name
$cfrom :: forall name x. IE name -> Rep (IE name) x
Generic, forall name. FromJSON name => Value -> Parser [IE name]
forall name. FromJSON name => Value -> Parser (IE name)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IE name]
$cparseJSONList :: forall name. FromJSON name => Value -> Parser [IE name]
parseJSON :: Value -> Parser (IE name)
$cparseJSON :: forall name. FromJSON name => Value -> Parser (IE name)
FromJSON, forall name. ToJSON name => [IE name] -> Encoding
forall name. ToJSON name => [IE name] -> Value
forall name. ToJSON name => IE name -> Encoding
forall name. ToJSON name => IE name -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IE name] -> Encoding
$ctoEncodingList :: forall name. ToJSON name => [IE name] -> Encoding
toJSONList :: [IE name] -> Value
$ctoJSONList :: forall name. ToJSON name => [IE name] -> Value
toEncoding :: IE name -> Encoding
$ctoEncoding :: forall name. ToJSON name => IE name -> Encoding
toJSON :: IE name -> Value
$ctoJSON :: forall name. ToJSON name => IE name -> Value
ToJSON)

data ImportSpec = AddImport
  { ImportSpec -> String
ideclNameString    :: String,
    ImportSpec -> Bool
ideclSource        :: Bool,
    ImportSpec -> Bool
ideclQualifiedBool :: Bool,
    ImportSpec -> Maybe String
ideclAsString      :: Maybe String,
    ImportSpec -> Maybe (IE String)
ideclThing         :: Maybe (IE String)
  }
  deriving (ImportSpec -> ImportSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSpec -> ImportSpec -> Bool
$c/= :: ImportSpec -> ImportSpec -> Bool
== :: ImportSpec -> ImportSpec -> Bool
$c== :: ImportSpec -> ImportSpec -> Bool
Eq, Int -> ImportSpec -> ShowS
[ImportSpec] -> ShowS
ImportSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSpec] -> ShowS
$cshowList :: [ImportSpec] -> ShowS
show :: ImportSpec -> String
$cshow :: ImportSpec -> String
showsPrec :: Int -> ImportSpec -> ShowS
$cshowsPrec :: Int -> ImportSpec -> ShowS
Show, forall x. Rep ImportSpec x -> ImportSpec
forall x. ImportSpec -> Rep ImportSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSpec x -> ImportSpec
$cfrom :: forall x. ImportSpec -> Rep ImportSpec x
Generic, Value -> Parser [ImportSpec]
Value -> Parser ImportSpec
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ImportSpec]
$cparseJSONList :: Value -> Parser [ImportSpec]
parseJSON :: Value -> Parser ImportSpec
$cparseJSON :: Value -> Parser ImportSpec
FromJSON, [ImportSpec] -> Encoding
[ImportSpec] -> Value
ImportSpec -> Encoding
ImportSpec -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ImportSpec] -> Encoding
$ctoEncodingList :: [ImportSpec] -> Encoding
toJSONList :: [ImportSpec] -> Value
$ctoJSONList :: [ImportSpec] -> Value
toEncoding :: ImportSpec -> Encoding
$ctoEncoding :: ImportSpec -> Encoding
toJSON :: ImportSpec -> Value
$ctoJSON :: ImportSpec -> Value
ToJSON)

toImportDecl :: ImportSpec -> GHC.ImportDecl GHC.GhcPs
toImportDecl :: ImportSpec -> ImportDecl GhcPs
toImportDecl AddImport {Bool
String
Maybe String
Maybe (IE String)
ideclThing :: Maybe (IE String)
ideclAsString :: Maybe String
ideclQualifiedBool :: Bool
ideclSource :: Bool
ideclNameString :: String
ideclThing :: ImportSpec -> Maybe (IE String)
ideclAsString :: ImportSpec -> Maybe String
ideclQualifiedBool :: ImportSpec -> Bool
ideclSource :: ImportSpec -> Bool
ideclNameString :: ImportSpec -> String
..} = GHC.ImportDecl {ideclSource :: IsBootInterface
ideclSource = IsBootInterface
ideclSource', Bool
Maybe (LocatedAn AnnListItem ModuleName)
ImportDeclQualifiedStyle
SourceText
LocatedAn AnnListItem ModuleName
forall a. Maybe a
forall {ann}. EpAnn ann
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclExt :: XCImportDecl GhcPs
ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclImplicit :: Bool
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: Maybe StringLiteral
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSourceSrc :: SourceText
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (LocatedAn AnnListItem ModuleName)
ideclExt :: forall {ann}. EpAnn ann
ideclSourceSrc :: SourceText
ideclHiding :: forall a. Maybe a
ideclImplicit :: Bool
ideclSafe :: Bool
ideclPkgQual :: forall a. Maybe a
ideclName :: LocatedAn AnnListItem ModuleName
..}
  where
    ideclSource' :: IsBootInterface
ideclSource' = if Bool
ideclSource then IsBootInterface
IsBoot else IsBootInterface
NotBoot
    toMod :: String -> LocatedAn an ModuleName
toMod = forall a an. a -> LocatedAn an a
noLocA forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
GHC.mkModuleName
    ideclName :: LocatedAn AnnListItem ModuleName
ideclName = forall {an}. String -> LocatedAn an ModuleName
toMod String
ideclNameString
#if MIN_VERSION_ghc(9,3,0)
    ideclPkgQual = NoRawPkgQual
#else
    ideclPkgQual :: Maybe a
ideclPkgQual = forall a. Maybe a
Nothing
#endif
    ideclSafe :: Bool
ideclSafe = Bool
False
    ideclImplicit :: Bool
ideclImplicit = Bool
False
    ideclHiding :: Maybe a
ideclHiding = forall a. Maybe a
Nothing
    ideclSourceSrc :: SourceText
ideclSourceSrc = SourceText
NoSourceText
#if MIN_VERSION_ghc(9,2,0)
    ideclExt :: EpAnn ann
ideclExt = forall {ann}. EpAnn ann
GHC.EpAnnNotUsed
#else
    ideclExt = GHC.noExtField
#endif
    ideclAs :: Maybe (LocatedAn AnnListItem ModuleName)
ideclAs = forall {an}. String -> LocatedAn an ModuleName
toMod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
ideclAsString
    ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = if Bool
ideclQualifiedBool then ImportDeclQualifiedStyle
GHC.QualifiedPre else ImportDeclQualifiedStyle
GHC.NotQualified