{-# LANGUAGE CPP          #-}
{-# LANGUAGE RankNTypes   #-}
{-# LANGUAGE TypeFamilies #-}

module Development.IDE.Plugin.Completions
    ( descriptor
    , LocalCompletions(..)
    , NonLocalCompletions(..)
    ) where

import           Control.Concurrent.Async                     (concurrently)
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Maybe
import           Data.Aeson
import qualified Data.HashMap.Strict                          as Map
import qualified Data.HashSet                                 as Set
import           Data.List                                    (find)
import           Data.Maybe
import qualified Data.Text                                    as T
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Error                    (rangeToSrcSpan)
import           Development.IDE.GHC.ExactPrint               (Annotated (annsA),
                                                               GetAnnotatedParsedSource (GetAnnotatedParsedSource),
                                                               astA)
import           Development.IDE.GHC.Util                     (prettyPrint)
import           Development.IDE.Graph
import           Development.IDE.Graph.Classes
import           Development.IDE.Plugin.CodeAction            (newImport,
                                                               newImportToEdit)
import           Development.IDE.Plugin.CodeAction.ExactPrint
import           Development.IDE.Plugin.Completions.Logic
import           Development.IDE.Plugin.Completions.Types
import           Development.IDE.Types.Exports
import           Development.IDE.Types.HscEnvEq               (HscEnvEq (envPackageExports),
                                                               hscEnv)
import           Development.IDE.Types.Location
import           GHC.Exts                                     (fromList, toList)
import           GHC.Generics
import           Ide.Plugin.Config                            (Config)
import           Ide.Types
import qualified Language.LSP.Server                          as LSP
import           Language.LSP.Types
import qualified Language.LSP.VFS                             as VFS
#if MIN_VERSION_ghc(9,0,0)
import           GHC.Tc.Module                                (tcRnImportDecls)
#else
import           TcRnDriver                                   (tcRnImportDecls)
#endif

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { pluginRules :: Rules ()
pluginRules = Rules ()
produceCompletions
  , pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCompletion
-> PluginMethodHandler IdeState 'TextDocumentCompletion
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCompletion
STextDocumentCompletion PluginMethodHandler IdeState 'TextDocumentCompletion
IdeState
-> PluginId
-> CompletionParams
-> LspM
     Config
     (Either ResponseError (ResponseResult 'TextDocumentCompletion))
getCompletionsLSP
  , pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
extendImportCommand]
  , pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {configCustomConfig :: CustomConfig
configCustomConfig = Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
-> CustomConfig
forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties}
  }

produceCompletions :: Rules ()
produceCompletions :: Rules ()
produceCompletions = do
    (LocalCompletions
 -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((LocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (LocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \LocalCompletions
LocalCompletions NormalizedFilePath
file -> do
        let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
        Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> Action (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetParsedModule
GetParsedModule NormalizedFilePath
file
        case Maybe (ParsedModule, PositionMapping)
pm of
            Just (ParsedModule
pm, PositionMapping
_) -> do
                let cdata :: CachedCompletions
cdata = Uri -> ParsedModule -> CachedCompletions
localCompletionsForParsedModule Uri
uri ParsedModule
pm
                IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
            Maybe (ParsedModule, PositionMapping)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
    (NonLocalCompletions
 -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((NonLocalCompletions
  -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
 -> Rules ())
-> (NonLocalCompletions
    -> NormalizedFilePath -> Action (IdeResult CachedCompletions))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NonLocalCompletions
NonLocalCompletions NormalizedFilePath
file -> do
        -- For non local completions we avoid depending on the parsed module,
        -- synthetizing a fake module with an empty body from the buffer
        -- in the ModSummary, which preserves all the imports
        Maybe ModSummaryResult
ms <- ((ModSummaryResult, PositionMapping) -> ModSummaryResult)
-> Maybe (ModSummaryResult, PositionMapping)
-> Maybe ModSummaryResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummaryResult, PositionMapping) -> ModSummaryResult
forall a b. (a, b) -> a
fst (Maybe (ModSummaryResult, PositionMapping)
 -> Maybe ModSummaryResult)
-> Action (Maybe (ModSummaryResult, PositionMapping))
-> Action (Maybe ModSummaryResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe (ModSummaryResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        Maybe HscEnvEq
sess <- ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst (Maybe (HscEnvEq, PositionMapping) -> Maybe HscEnvEq)
-> Action (Maybe (HscEnvEq, PositionMapping))
-> Action (Maybe HscEnvEq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file

        case (Maybe ModSummaryResult
ms, Maybe HscEnvEq
sess) of
            (Just ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
msrFingerprint :: ModSummaryResult -> Fingerprint
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrModSummary :: ModSummaryResult -> ModSummary
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
..}, Just HscEnvEq
sess) -> do
              let env :: HscEnv
env = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
              -- We do this to be able to provide completions of items that are not restricted to the explicit list
              ((Messages, Maybe GlobalRdrEnv)
global, (Messages, Maybe GlobalRdrEnv)
inScope) <- IO ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
-> Action
     ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
 -> Action
      ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv)))
-> IO
     ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
-> Action
     ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall a b. (a -> b) -> a -> b
$ HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env (LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl (LImportDecl GhcPs -> LImportDecl GhcPs)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LImportDecl GhcPs]
msrImports) IO (Messages, Maybe GlobalRdrEnv)
-> IO (Messages, Maybe GlobalRdrEnv)
-> IO
     ((Messages, Maybe GlobalRdrEnv), (Messages, Maybe GlobalRdrEnv))
forall a b. IO a -> IO b -> IO (a, b)
`concurrently` HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
tcRnImportDecls HscEnv
env [LImportDecl GhcPs]
msrImports
              case ((Messages, Maybe GlobalRdrEnv)
global, (Messages, Maybe GlobalRdrEnv)
inScope) of
                  ((Messages
_, Just GlobalRdrEnv
globalEnv), (Messages
_, Just GlobalRdrEnv
inScopeEnv)) -> do
                      let uri :: Uri
uri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
                      CachedCompletions
cdata <- IO CachedCompletions -> Action CachedCompletions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CachedCompletions -> Action CachedCompletions)
-> IO CachedCompletions -> Action CachedCompletions
forall a b. (a -> b) -> a -> b
$ Uri
-> HscEnvEq
-> Module
-> GlobalRdrEnv
-> GlobalRdrEnv
-> [LImportDecl GhcPs]
-> IO CachedCompletions
cacheDataProducer Uri
uri HscEnvEq
sess (ModSummary -> Module
ms_mod ModSummary
msrModSummary) GlobalRdrEnv
globalEnv GlobalRdrEnv
inScopeEnv [LImportDecl GhcPs]
msrImports
                      return ([], CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
cdata)
                  ((Messages, Maybe GlobalRdrEnv)
_diag, (Messages, Maybe GlobalRdrEnv)
_) ->
                      IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)
            (Maybe ModSummaryResult, Maybe HscEnvEq)
_ -> IdeResult CachedCompletions -> Action (IdeResult CachedCompletions)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe CachedCompletions
forall a. Maybe a
Nothing)

-- Drop any explicit imports in ImportDecl if not hidden
dropListFromImportDecl :: GenLocated SrcSpan (ImportDecl GhcPs) -> GenLocated SrcSpan (ImportDecl GhcPs)
dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
dropListFromImportDecl LImportDecl GhcPs
iDecl = let
    f :: ImportDecl pass -> ImportDecl pass
f d :: ImportDecl pass
d@ImportDecl {Maybe (Bool, Located [LIE pass])
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE pass])
ideclHiding} = case Maybe (Bool, Located [LIE pass])
ideclHiding of
        Just (Bool
False, Located [LIE pass]
_) -> ImportDecl pass
d {ideclHiding :: Maybe (Bool, Located [LIE pass])
ideclHiding=Maybe (Bool, Located [LIE pass])
forall a. Maybe a
Nothing}
        -- if hiding or Nothing just return d
        Maybe (Bool, Located [LIE pass])
_               -> ImportDecl pass
d
    f ImportDecl pass
x = ImportDecl pass
x
    in ImportDecl GhcPs -> ImportDecl GhcPs
forall pass. ImportDecl pass -> ImportDecl pass
f (ImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs -> LImportDecl GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LImportDecl GhcPs
iDecl

-- | Produce completions info for a file
type instance RuleResult LocalCompletions = CachedCompletions
type instance RuleResult NonLocalCompletions = CachedCompletions

data LocalCompletions = LocalCompletions
    deriving (LocalCompletions -> LocalCompletions -> Bool
(LocalCompletions -> LocalCompletions -> Bool)
-> (LocalCompletions -> LocalCompletions -> Bool)
-> Eq LocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCompletions -> LocalCompletions -> Bool
$c/= :: LocalCompletions -> LocalCompletions -> Bool
== :: LocalCompletions -> LocalCompletions -> Bool
$c== :: LocalCompletions -> LocalCompletions -> Bool
Eq, Int -> LocalCompletions -> ShowS
[LocalCompletions] -> ShowS
LocalCompletions -> String
(Int -> LocalCompletions -> ShowS)
-> (LocalCompletions -> String)
-> ([LocalCompletions] -> ShowS)
-> Show LocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalCompletions] -> ShowS
$cshowList :: [LocalCompletions] -> ShowS
show :: LocalCompletions -> String
$cshow :: LocalCompletions -> String
showsPrec :: Int -> LocalCompletions -> ShowS
$cshowsPrec :: Int -> LocalCompletions -> ShowS
Show, Typeable, (forall x. LocalCompletions -> Rep LocalCompletions x)
-> (forall x. Rep LocalCompletions x -> LocalCompletions)
-> Generic LocalCompletions
forall x. Rep LocalCompletions x -> LocalCompletions
forall x. LocalCompletions -> Rep LocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalCompletions x -> LocalCompletions
$cfrom :: forall x. LocalCompletions -> Rep LocalCompletions x
Generic)
instance Hashable LocalCompletions
instance NFData   LocalCompletions
instance Binary   LocalCompletions

data NonLocalCompletions = NonLocalCompletions
    deriving (NonLocalCompletions -> NonLocalCompletions -> Bool
(NonLocalCompletions -> NonLocalCompletions -> Bool)
-> (NonLocalCompletions -> NonLocalCompletions -> Bool)
-> Eq NonLocalCompletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
== :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c== :: NonLocalCompletions -> NonLocalCompletions -> Bool
Eq, Int -> NonLocalCompletions -> ShowS
[NonLocalCompletions] -> ShowS
NonLocalCompletions -> String
(Int -> NonLocalCompletions -> ShowS)
-> (NonLocalCompletions -> String)
-> ([NonLocalCompletions] -> ShowS)
-> Show NonLocalCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonLocalCompletions] -> ShowS
$cshowList :: [NonLocalCompletions] -> ShowS
show :: NonLocalCompletions -> String
$cshow :: NonLocalCompletions -> String
showsPrec :: Int -> NonLocalCompletions -> ShowS
$cshowsPrec :: Int -> NonLocalCompletions -> ShowS
Show, Typeable, (forall x. NonLocalCompletions -> Rep NonLocalCompletions x)
-> (forall x. Rep NonLocalCompletions x -> NonLocalCompletions)
-> Generic NonLocalCompletions
forall x. Rep NonLocalCompletions x -> NonLocalCompletions
forall x. NonLocalCompletions -> Rep NonLocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonLocalCompletions x -> NonLocalCompletions
$cfrom :: forall x. NonLocalCompletions -> Rep NonLocalCompletions x
Generic)
instance Hashable NonLocalCompletions
instance NFData   NonLocalCompletions
instance Binary   NonLocalCompletions

-- | Generate code actions.
getCompletionsLSP
    :: IdeState
    -> PluginId
    -> CompletionParams
    -> LSP.LspM Config (Either ResponseError (ResponseResult TextDocumentCompletion))
getCompletionsLSP :: IdeState
-> PluginId
-> CompletionParams
-> LspM
     Config
     (Either ResponseError (ResponseResult 'TextDocumentCompletion))
getCompletionsLSP IdeState
ide PluginId
plId
  CompletionParams{$sel:_textDocument:CompletionParams :: CompletionParams -> TextDocumentIdentifier
_textDocument=TextDocumentIdentifier Uri
uri
                  ,$sel:_position:CompletionParams :: CompletionParams -> Position
_position=Position
position
                  ,$sel:_context:CompletionParams :: CompletionParams -> Maybe CompletionContext
_context=Maybe CompletionContext
completionContext} = do
    Maybe VirtualFile
contents <- NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile (NormalizedUri -> LspT Config IO (Maybe VirtualFile))
-> NormalizedUri -> LspT Config IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
    ((List CompletionItem |? CompletionList)
 -> Either ResponseError (List CompletionItem |? CompletionList))
-> LspT Config IO (List CompletionItem |? CompletionList)
-> LspT
     Config
     IO
     (Either ResponseError (List CompletionItem |? CompletionList))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (List CompletionItem |? CompletionList)
-> Either ResponseError (List CompletionItem |? CompletionList)
forall a b. b -> Either a b
Right (LspT Config IO (List CompletionItem |? CompletionList)
 -> LspT
      Config
      IO
      (Either ResponseError (List CompletionItem |? CompletionList)))
-> LspT Config IO (List CompletionItem |? CompletionList)
-> LspT
     Config
     IO
     (Either ResponseError (List CompletionItem |? CompletionList))
forall a b. (a -> b) -> a -> b
$ case (Maybe VirtualFile
contents, Uri -> Maybe String
uriToFilePath' Uri
uri) of
      (Just VirtualFile
cnts, Just String
path) -> do
        let npath :: NormalizedFilePath
npath = String -> NormalizedFilePath
toNormalizedFilePath' String
path
        (IdeOptions
ideOpts, Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
compls) <- IO
  (IdeOptions,
   Maybe
     (CachedCompletions, Maybe (ParsedModule, PositionMapping),
      (Bindings, PositionMapping)))
-> LspT
     Config
     IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IdeOptions,
    Maybe
      (CachedCompletions, Maybe (ParsedModule, PositionMapping),
       (Bindings, PositionMapping)))
 -> LspT
      Config
      IO
      (IdeOptions,
       Maybe
         (CachedCompletions, Maybe (ParsedModule, PositionMapping),
          (Bindings, PositionMapping))))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
-> LspT
     Config
     IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall a b. (a -> b) -> a -> b
$ String
-> ShakeExtras
-> IdeAction
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"Completion" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction
   (IdeOptions,
    Maybe
      (CachedCompletions, Maybe (ParsedModule, PositionMapping),
       (Bindings, PositionMapping)))
 -> IO
      (IdeOptions,
       Maybe
         (CachedCompletions, Maybe (ParsedModule, PositionMapping),
          (Bindings, PositionMapping))))
-> IdeAction
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
-> IO
     (IdeOptions,
      Maybe
        (CachedCompletions, Maybe (ParsedModule, PositionMapping),
         (Bindings, PositionMapping)))
forall a b. (a -> b) -> a -> b
$ do
            IdeOptions
opts <- IO IdeOptions -> IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> IdeAction IdeOptions)
-> IO IdeOptions -> IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
            Maybe (CachedCompletions, PositionMapping)
localCompls <- LocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast LocalCompletions
LocalCompletions NormalizedFilePath
npath
            Maybe (CachedCompletions, PositionMapping)
nonLocalCompls <- NonLocalCompletions
-> NormalizedFilePath
-> IdeAction (Maybe (CachedCompletions, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast NonLocalCompletions
NonLocalCompletions NormalizedFilePath
npath
            Maybe (ParsedModule, PositionMapping)
pm <- GetParsedModule
-> NormalizedFilePath
-> IdeAction (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetParsedModule
GetParsedModule NormalizedFilePath
npath
            (Bindings, PositionMapping)
binds <- (Bindings, PositionMapping)
-> Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping)
forall a. a -> Maybe a -> a
fromMaybe (Bindings
forall a. Monoid a => a
mempty, PositionMapping
zeroMapping) (Maybe (Bindings, PositionMapping) -> (Bindings, PositionMapping))
-> IdeAction (Maybe (Bindings, PositionMapping))
-> IdeAction (Bindings, PositionMapping)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetBindings
-> NormalizedFilePath
-> IdeAction (Maybe (Bindings, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GetBindings
GetBindings NormalizedFilePath
npath
            Maybe (IO ExportsMap)
exportsMapIO <- ((HscEnvEq, PositionMapping) -> IO ExportsMap)
-> Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(HscEnvEq -> IO ExportsMap
envPackageExports (HscEnvEq -> IO ExportsMap)
-> ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> (HscEnvEq, PositionMapping)
-> IO ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst) (Maybe (HscEnvEq, PositionMapping) -> Maybe (IO ExportsMap))
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
-> IdeAction (Maybe (IO ExportsMap))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSession
-> NormalizedFilePath
-> IdeAction (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast GhcSession
GhcSession NormalizedFilePath
npath
            Maybe ExportsMap
exportsMap <- (IO ExportsMap -> IdeAction ExportsMap)
-> Maybe (IO ExportsMap) -> IdeAction (Maybe ExportsMap)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IO ExportsMap -> IdeAction ExportsMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Maybe (IO ExportsMap)
exportsMapIO
            let exportsCompItems :: Maybe [Maybe Text -> CompItem]
exportsCompItems = (HashSet IdentInfo -> [Maybe Text -> CompItem])
-> [HashSet IdentInfo] -> [Maybe Text -> CompItem]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((IdentInfo -> Maybe Text -> CompItem)
-> [IdentInfo] -> [Maybe Text -> CompItem]
forall a b. (a -> b) -> [a] -> [b]
map (Uri -> IdentInfo -> Maybe Text -> CompItem
fromIdentInfo Uri
uri) ([IdentInfo] -> [Maybe Text -> CompItem])
-> (HashSet IdentInfo -> [IdentInfo])
-> HashSet IdentInfo
-> [Maybe Text -> CompItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet IdentInfo -> [IdentInfo]
forall a. HashSet a -> [a]
Set.toList) ([HashSet IdentInfo] -> [Maybe Text -> CompItem])
-> (ExportsMap -> [HashSet IdentInfo])
-> ExportsMap
-> [Maybe Text -> CompItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (HashSet IdentInfo) -> [HashSet IdentInfo]
forall k v. HashMap k v -> [v]
Map.elems (HashMap Text (HashSet IdentInfo) -> [HashSet IdentInfo])
-> (ExportsMap -> HashMap Text (HashSet IdentInfo))
-> ExportsMap
-> [HashSet IdentInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExportsMap -> HashMap Text (HashSet IdentInfo)
getExportsMap (ExportsMap -> [Maybe Text -> CompItem])
-> Maybe ExportsMap -> Maybe [Maybe Text -> CompItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ExportsMap
exportsMap
                exportsCompls :: CachedCompletions
exportsCompls = CachedCompletions
forall a. Monoid a => a
mempty{anyQualCompls :: [Maybe Text -> CompItem]
anyQualCompls = [Maybe Text -> CompItem]
-> Maybe [Maybe Text -> CompItem] -> [Maybe Text -> CompItem]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Maybe Text -> CompItem]
exportsCompItems}
            let compls :: Maybe CachedCompletions
compls = ((CachedCompletions, PositionMapping) -> CachedCompletions
forall a b. (a, b) -> a
fst ((CachedCompletions, PositionMapping) -> CachedCompletions)
-> Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
localCompls) Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> ((CachedCompletions, PositionMapping) -> CachedCompletions
forall a b. (a, b) -> a
fst ((CachedCompletions, PositionMapping) -> CachedCompletions)
-> Maybe (CachedCompletions, PositionMapping)
-> Maybe CachedCompletions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CachedCompletions, PositionMapping)
nonLocalCompls) Maybe CachedCompletions
-> Maybe CachedCompletions -> Maybe CachedCompletions
forall a. Semigroup a => a -> a -> a
<> CachedCompletions -> Maybe CachedCompletions
forall a. a -> Maybe a
Just CachedCompletions
exportsCompls
            pure (IdeOptions
opts, (CachedCompletions
 -> (CachedCompletions, Maybe (ParsedModule, PositionMapping),
     (Bindings, PositionMapping)))
-> Maybe CachedCompletions
-> Maybe
     (CachedCompletions, Maybe (ParsedModule, PositionMapping),
      (Bindings, PositionMapping))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Maybe (ParsedModule, PositionMapping)
pm,(Bindings, PositionMapping)
binds) Maybe CachedCompletions
compls)
        case Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
compls of
          Just (CachedCompletions
cci', Maybe (ParsedModule, PositionMapping)
parsedMod, (Bindings, PositionMapping)
bindMap) -> do
            Maybe PosPrefixInfo
pfix <- Position -> VirtualFile -> LspT Config IO (Maybe PosPrefixInfo)
forall (m :: * -> *).
Monad m =>
Position -> VirtualFile -> m (Maybe PosPrefixInfo)
VFS.getCompletionPrefix Position
position VirtualFile
cnts
            case (Maybe PosPrefixInfo
pfix, Maybe CompletionContext
completionContext) of
              (Just (VFS.PosPrefixInfo Text
_ Text
"" Text
_ Position
_), Just CompletionContext { $sel:_triggerCharacter:CompletionContext :: CompletionContext -> Maybe Text
_triggerCharacter = Just Text
"."})
                -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
              (Just PosPrefixInfo
pfix', Maybe CompletionContext
_) -> do
                let clientCaps :: ClientCapabilities
clientCaps = ShakeExtras -> ClientCapabilities
clientCapabilities (ShakeExtras -> ClientCapabilities)
-> ShakeExtras -> ClientCapabilities
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
                CompletionsConfig
config <- PluginId -> LspT Config IO CompletionsConfig
forall (m :: * -> *).
MonadLsp Config m =>
PluginId -> m CompletionsConfig
getCompletionsConfig PluginId
plId
                [CompletionItem]
allCompletions <- IO [CompletionItem] -> LspT Config IO [CompletionItem]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CompletionItem] -> LspT Config IO [CompletionItem])
-> IO [CompletionItem] -> LspT Config IO [CompletionItem]
forall a b. (a -> b) -> a -> b
$ PluginId
-> IdeOptions
-> CachedCompletions
-> Maybe (ParsedModule, PositionMapping)
-> (Bindings, PositionMapping)
-> PosPrefixInfo
-> ClientCapabilities
-> CompletionsConfig
-> IO [CompletionItem]
getCompletions PluginId
plId IdeOptions
ideOpts CachedCompletions
cci' Maybe (ParsedModule, PositionMapping)
parsedMod (Bindings, PositionMapping)
bindMap PosPrefixInfo
pfix' ClientCapabilities
clientCaps CompletionsConfig
config
                pure $ List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [CompletionItem]
allCompletions)
              (Maybe PosPrefixInfo, Maybe CompletionContext)
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
          Maybe
  (CachedCompletions, Maybe (ParsedModule, PositionMapping),
   (Bindings, PositionMapping))
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])
      (Maybe VirtualFile, Maybe String)
_ -> (List CompletionItem |? CompletionList)
-> LspT Config IO (List CompletionItem |? CompletionList)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CompletionItem -> List CompletionItem |? CompletionList
forall a b. a -> a |? b
InL (List CompletionItem -> List CompletionItem |? CompletionList)
-> List CompletionItem -> List CompletionItem |? CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List [])

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

extendImportCommand :: PluginCommand IdeState
extendImportCommand :: PluginCommand IdeState
extendImportCommand =
  CommandId
-> Text
-> CommandFunction IdeState ExtendImport
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
CommandId Text
extendImportCommandId) Text
"additional edits for a completion" CommandFunction IdeState ExtendImport
extendImportHandler

extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler :: CommandFunction IdeState ExtendImport
extendImportHandler IdeState
ideState edit :: ExtendImport
edit@ExtendImport {Maybe Text
Text
Uri
importQual :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
newThing :: ExtendImport -> Text
doc :: ExtendImport -> Uri
importQual :: Maybe Text
importName :: Text
thingParent :: Maybe Text
newThing :: Text
doc :: Uri
..} = do
  Maybe (NormalizedFilePath, WorkspaceEdit)
res <- IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (NormalizedFilePath, WorkspaceEdit))
 -> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
-> LspT Config IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (NormalizedFilePath, WorkspaceEdit)
 -> IO (Maybe (NormalizedFilePath, WorkspaceEdit)))
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
-> IO (Maybe (NormalizedFilePath, WorkspaceEdit))
forall a b. (a -> b) -> a -> b
$ IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport
edit
  Maybe (NormalizedFilePath, WorkspaceEdit)
-> ((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
-> LspT Config IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (NormalizedFilePath, WorkspaceEdit)
res (((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
 -> LspT Config IO ())
-> ((NormalizedFilePath, WorkspaceEdit) -> LspT Config IO ())
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
nfp, wedit :: WorkspaceEdit
wedit@WorkspaceEdit {Maybe WorkspaceEditMap
$sel:_changes:WorkspaceEdit :: WorkspaceEdit -> Maybe WorkspaceEditMap
_changes :: Maybe WorkspaceEditMap
_changes}) -> do
    let (Uri
_, List ([TextEdit] -> TextEdit
forall a. [a] -> a
head -> TextEdit {Range
$sel:_range:TextEdit :: TextEdit -> Range
_range :: Range
_range})) = Maybe (Uri, List TextEdit) -> (Uri, List TextEdit)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Uri, List TextEdit) -> (Uri, List TextEdit))
-> Maybe (Uri, List TextEdit) -> (Uri, List TextEdit)
forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceEditMap
_changes Maybe WorkspaceEditMap
-> (WorkspaceEditMap -> Maybe (Uri, List TextEdit))
-> Maybe (Uri, List TextEdit)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Uri, List TextEdit)] -> Maybe (Uri, List TextEdit)
forall a. [a] -> Maybe a
listToMaybe ([(Uri, List TextEdit)] -> Maybe (Uri, List TextEdit))
-> (WorkspaceEditMap -> [(Uri, List TextEdit)])
-> WorkspaceEditMap
-> Maybe (Uri, List TextEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceEditMap -> [(Uri, List TextEdit)]
forall l. IsList l => l -> [Item l]
toList
        srcSpan :: SrcSpan
srcSpan = NormalizedFilePath -> Range -> SrcSpan
rangeToSrcSpan NormalizedFilePath
nfp Range
_range
    SServerMethod 'WindowShowMessage
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'WindowShowMessage
SWindowShowMessage (MessageParams 'WindowShowMessage -> LspT Config IO ())
-> MessageParams 'WindowShowMessage -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
      MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MtInfo (Text -> ShowMessageParams) -> Text -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$
        Text
"Import "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newThing) (\Text
x -> Text
"‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newThing Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") Maybe Text
thingParent
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’ from "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
importName
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (at "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SrcSpan -> String
forall a. Outputable a => a -> String
prettyPrint SrcSpan
srcSpan)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ())
-> LspT Config IO (LspId 'WorkspaceApplyEdit) -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> (Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
    -> LspT Config IO ())
-> LspT Config IO (LspId 'WorkspaceApplyEdit)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  return $ Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null

extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' :: IdeState
-> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
extendImportHandler' IdeState
ideState ExtendImport {Maybe Text
Text
Uri
importQual :: Maybe Text
importName :: Text
thingParent :: Maybe Text
newThing :: Text
doc :: Uri
importQual :: ExtendImport -> Maybe Text
importName :: ExtendImport -> Text
thingParent :: ExtendImport -> Maybe Text
newThing :: ExtendImport -> Text
doc :: ExtendImport -> Uri
..}
  | Just String
fp <- Uri -> Maybe String
uriToFilePath Uri
doc,
    NormalizedFilePath
nfp <- String -> NormalizedFilePath
toNormalizedFilePath' String
fp =
    do
      (ModSummaryResult {[LImportDecl GhcPs]
Fingerprint
ModSummary
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
msrFingerprint :: ModSummaryResult -> Fingerprint
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrModSummary :: ModSummaryResult -> ModSummary
..}, Annotated ParsedSource
ps) <- IO (Maybe (ModSummaryResult, Annotated ParsedSource))
-> MaybeT IO (ModSummaryResult, Annotated ParsedSource)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (ModSummaryResult, Annotated ParsedSource))
 -> MaybeT IO (ModSummaryResult, Annotated ParsedSource))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
-> MaybeT IO (ModSummaryResult, Annotated ParsedSource)
forall a b. (a -> b) -> a -> b
$ IO (Maybe (ModSummaryResult, Annotated ParsedSource))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ModSummaryResult, Annotated ParsedSource))
 -> IO (Maybe (ModSummaryResult, Annotated ParsedSource)))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
forall a b. (a -> b) -> a -> b
$
        String
-> IdeState
-> Action (Maybe (ModSummaryResult, Annotated ParsedSource))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"extend import" IdeState
ideState (Action (Maybe (ModSummaryResult, Annotated ParsedSource))
 -> IO (Maybe (ModSummaryResult, Annotated ParsedSource)))
-> Action (Maybe (ModSummaryResult, Annotated ParsedSource))
-> IO (Maybe (ModSummaryResult, Annotated ParsedSource))
forall a b. (a -> b) -> a -> b
$
          MaybeT Action (ModSummaryResult, Annotated ParsedSource)
-> Action (Maybe (ModSummaryResult, Annotated ParsedSource))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action (ModSummaryResult, Annotated ParsedSource)
 -> Action (Maybe (ModSummaryResult, Annotated ParsedSource)))
-> MaybeT Action (ModSummaryResult, Annotated ParsedSource)
-> Action (Maybe (ModSummaryResult, Annotated ParsedSource))
forall a b. (a -> b) -> a -> b
$ do
            -- We want accurate edits, so do not use stale data here
            ModSummaryResult
msr <- Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult)
-> Action (Maybe ModSummaryResult)
-> MaybeT Action ModSummaryResult
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (Maybe ModSummaryResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
            Annotated ParsedSource
ps <- Action (Maybe (Annotated ParsedSource))
-> MaybeT Action (Annotated ParsedSource)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (Annotated ParsedSource))
 -> MaybeT Action (Annotated ParsedSource))
-> Action (Maybe (Annotated ParsedSource))
-> MaybeT Action (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
nfp
            return (ModSummaryResult
msr, Annotated ParsedSource
ps)
      let df :: DynFlags
df = ModSummary -> DynFlags
ms_hspp_opts ModSummary
msrModSummary
          wantedModule :: ModuleName
wantedModule = String -> ModuleName
mkModuleName (Text -> String
T.unpack Text
importName)
          wantedQual :: Maybe ModuleName
wantedQual = String -> ModuleName
mkModuleName (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ModuleName) -> Maybe Text -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
importQual
          existingImport :: Maybe (LImportDecl GhcPs)
existingImport = (LImportDecl GhcPs -> Bool)
-> [LImportDecl GhcPs] -> Maybe (LImportDecl GhcPs)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ModuleName -> Maybe ModuleName -> LImportDecl GhcPs -> Bool
forall l pass.
ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
wantedQual) [LImportDecl GhcPs]
msrImports
      case Maybe (LImportDecl GhcPs)
existingImport of
        Just LImportDecl GhcPs
imp -> do
            (WorkspaceEdit -> (NormalizedFilePath, WorkspaceEdit))
-> MaybeT IO WorkspaceEdit
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedFilePath
nfp,) (MaybeT IO WorkspaceEdit
 -> MaybeT IO (NormalizedFilePath, WorkspaceEdit))
-> MaybeT IO WorkspaceEdit
-> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit
forall (m :: * -> *) e a. Monad m => Either e a -> MaybeT m a
liftEither (Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit)
-> Either String WorkspaceEdit -> MaybeT IO WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
              DynFlags -> Uri -> Anns -> Rewrite -> Either String WorkspaceEdit
rewriteToWEdit DynFlags
df Uri
doc (Annotated ParsedSource -> Anns
forall ast. Annotated ast -> Anns
annsA Annotated ParsedSource
ps) (Rewrite -> Either String WorkspaceEdit)
-> Rewrite -> Either String WorkspaceEdit
forall a b. (a -> b) -> a -> b
$
                Maybe String -> String -> LImportDecl GhcPs -> Rewrite
extendImport (Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
thingParent) (Text -> String
T.unpack Text
newThing) LImportDecl GhcPs
imp
        Maybe (LImportDecl GhcPs)
Nothing -> do
            let n :: NewImport
n = Text -> Maybe Text -> Maybe Text -> Bool -> NewImport
newImport Text
importName Maybe Text
sym Maybe Text
importQual Bool
False
                sym :: Maybe Text
sym = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
importQual then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
it else Maybe Text
forall a. Maybe a
Nothing
                it :: Text
it = case Maybe Text
thingParent of
                  Maybe Text
Nothing -> Text
newThing
                  Just Text
p  -> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newThing Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            TextEdit
t <- Maybe TextEdit -> MaybeT IO TextEdit
forall (m :: * -> *) a. Monad m => Maybe a -> MaybeT m a
liftMaybe (Maybe TextEdit -> MaybeT IO TextEdit)
-> Maybe TextEdit -> MaybeT IO TextEdit
forall a b. (a -> b) -> a -> b
$ (Text, TextEdit) -> TextEdit
forall a b. (a, b) -> b
snd ((Text, TextEdit) -> TextEdit)
-> Maybe (Text, TextEdit) -> Maybe TextEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewImport -> ParsedSource -> Maybe (Text, TextEdit)
newImportToEdit NewImport
n (Annotated ParsedSource -> ParsedSource
forall ast. Annotated ast -> ast
astA Annotated ParsedSource
ps)
            return (NormalizedFilePath
nfp, WorkspaceEdit :: Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit {$sel:_changes:WorkspaceEdit :: Maybe WorkspaceEditMap
_changes=WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just ([Item WorkspaceEditMap] -> WorkspaceEditMap
forall l. IsList l => [Item l] -> l
fromList [(Uri
doc,[TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
t])]), $sel:_documentChanges:WorkspaceEdit :: Maybe (List DocumentChange)
_documentChanges=Maybe (List DocumentChange)
forall a. Maybe a
Nothing, $sel:_changeAnnotations:WorkspaceEdit :: Maybe ChangeAnnotationMap
_changeAnnotations=Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing})
  | Bool
otherwise =
    MaybeT IO (NormalizedFilePath, WorkspaceEdit)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

isWantedModule :: ModuleName -> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule :: ModuleName
-> Maybe ModuleName -> GenLocated l (ImportDecl pass) -> Bool
isWantedModule ModuleName
wantedModule Maybe ModuleName
Nothing (L l
_ it :: ImportDecl pass
it@ImportDecl{Located ModuleName
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName :: Located ModuleName
ideclName, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE pass]
_)}) =
    Bool -> Bool
not (ImportDecl pass -> Bool
forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl pass
it) Bool -> Bool -> Bool
&& Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule
isWantedModule ModuleName
wantedModule (Just ModuleName
qual) (L l
_ ImportDecl{Maybe (Located ModuleName)
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs :: Maybe (Located ModuleName)
ideclAs, Located ModuleName
ideclName :: Located ModuleName
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName, ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding = Just (Bool
False, Located [LIE pass]
_)}) =
    Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
ideclName ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
wantedModule Bool -> Bool -> Bool
&& (ModuleName
wantedModule ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
qual Bool -> Bool -> Bool
|| (Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Located ModuleName)
ideclAs) Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
qual)
isWantedModule ModuleName
_ Maybe ModuleName
_ GenLocated l (ImportDecl pass)
_ = Bool
False

liftMaybe :: Monad m => Maybe a -> MaybeT m a
liftMaybe :: Maybe a -> MaybeT m a
liftMaybe Maybe a
a = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
a

liftEither :: Monad m => Either e a -> MaybeT m a
liftEither :: Either e a -> MaybeT m a
liftEither (Left e
_)  = MaybeT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
liftEither (Right a
x) = a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x