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

{-# OPTIONS -Wno-orphans #-}
#include "ghc-api-version.h"

module Ide.Plugin.Retrie (descriptor) where

import           Control.Concurrent.Extra       (readVar)
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 (..), runExceptT,
                                                 throwE)
import           Data.Aeson                     (genericParseJSON, FromJSON(..), ToJSON (..), Value (Null))
import           Data.Bifunctor                 (Bifunctor (first), second)
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 (fromString))
import qualified Data.Text                      as T
import qualified Data.Text.IO                   as T
import           Data.Typeable                  (Typeable)
import           Development.IDE
import           Development.IDE.Core.Shake     (toKnownFiles, ShakeExtras(knownTargetsVar))
import           Development.IDE.GHC.Compat     (GenLocated (L), GhcRn,
                                                 HsBindLR (FunBind),
                                                 HsGroup (..),
                                                 HsValBindsLR (..), HscEnv, IdP,
                                                 LRuleDecls,
                                                 ModSummary (ModSummary, ms_hspp_buf, ms_mod),
                                                 NHsValBindsLR (..),
                                                 ParsedModule (..),
                                                 RuleDecl (HsRule),
                                                 RuleDecls (HsRules),
                                                 SrcSpan (..),
                                                 TyClDecl (SynDecl),
                                                 TyClGroup (..), fun_id,
                                                 mi_fixities, moduleNameString,
                                                 parseModule, rds_rules,
                                                 srcSpanFile)
import           GHC.Generics                   (Generic)
import           GhcPlugins                     (Outputable,
                                                 SourceText (NoSourceText),
                                                 hm_iface, isQual, isQual_maybe,
                                                 nameModule_maybe, nameRdrName,
                                                 occNameFS, occNameString,
                                                 rdrNameOcc, unpackFS)
import           Ide.PluginUtils
import           Ide.Types
import           Language.Haskell.LSP.Core      (LspFuncs (..), ProgressCancellable (Cancellable))
import           Language.Haskell.LSP.Messages  (FromServerMessage (NotShowMessage))
import           Language.Haskell.LSP.Types     as J
import           Retrie.CPP                     (CPP (NoCPP), parseCPP)
import           Retrie.ExactPrint              (fix, relativiseApiAnns,
                                                 transformA, unsafeMkA)
import           Retrie.Fixity                  (mkFixityEnv)
import qualified Retrie.GHC                     as GHC
import           Retrie.Monad                   (addImports, apply,
                                                 getGroundTerms, runRetrie)
import           Retrie.Options                 (defaultOptions, getTargetFiles)
import qualified Retrie.Options                 as Retrie
import           Retrie.Replace                 (Change (..), Replacement (..))
import           Retrie.Rewrites
import           Retrie.SYB                     (listify)
import           Retrie.Util                    (Verbosity (Loud))
import           StringBuffer                   (stringToStringBuffer)
import           System.Directory               (makeAbsolute)
import Control.Monad.Trans.Maybe
import Development.IDE.Core.PositionMapping
import qualified Data.Aeson as Aeson

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId =
  (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { pluginCodeActionProvider :: Maybe (CodeActionProvider IdeState)
pluginCodeActionProvider = CodeActionProvider IdeState -> Maybe (CodeActionProvider IdeState)
forall a. a -> Maybe a
Just CodeActionProvider IdeState
provider,
      pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginCommand IdeState
retrieCommand]
    }

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

retrieCommand :: PluginCommand IdeState
retrieCommand :: PluginCommand IdeState
retrieCommand =
  CommandId
-> Text
-> CommandFunction IdeState RunRetrieParams
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
coerce Text
retrieCommandName) Text
"run the refactoring" CommandFunction IdeState RunRetrieParams
forall a.
LspFuncs a
-> IdeState
-> RunRetrieParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
runRetrieCmd

-- | Parameters for the runRetrie PluginCommand.
data RunRetrieParams = RunRetrieParams
  { RunRetrieParams -> Text
description               :: T.Text,
    RunRetrieParams -> [RewriteSpec]
rewrites                  :: [RewriteSpec],
    RunRetrieParams -> NormalizedUriJSON
originatingFile           :: NormalizedUriJSON,
    RunRetrieParams -> Bool
restrictToOriginatingFile :: Bool
  }
  deriving (RunRetrieParams -> RunRetrieParams -> Bool
(RunRetrieParams -> RunRetrieParams -> Bool)
-> (RunRetrieParams -> RunRetrieParams -> Bool)
-> Eq RunRetrieParams
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
(Int -> RunRetrieParams -> ShowS)
-> (RunRetrieParams -> String)
-> ([RunRetrieParams] -> ShowS)
-> Show RunRetrieParams
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. RunRetrieParams -> Rep RunRetrieParams x)
-> (forall x. Rep RunRetrieParams x -> RunRetrieParams)
-> Generic RunRetrieParams
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
(Value -> Parser RunRetrieParams)
-> (Value -> Parser [RunRetrieParams]) -> FromJSON 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
(RunRetrieParams -> Value)
-> (RunRetrieParams -> Encoding)
-> ([RunRetrieParams] -> Value)
-> ([RunRetrieParams] -> Encoding)
-> ToJSON RunRetrieParams
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)

newtype NormalizedUriJSON = NormalizedUriJSON NormalizedUri
  deriving (NormalizedUriJSON -> NormalizedUriJSON -> Bool
(NormalizedUriJSON -> NormalizedUriJSON -> Bool)
-> (NormalizedUriJSON -> NormalizedUriJSON -> Bool)
-> Eq NormalizedUriJSON
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizedUriJSON -> NormalizedUriJSON -> Bool
$c/= :: NormalizedUriJSON -> NormalizedUriJSON -> Bool
== :: NormalizedUriJSON -> NormalizedUriJSON -> Bool
$c== :: NormalizedUriJSON -> NormalizedUriJSON -> Bool
Eq, Int -> NormalizedUriJSON -> ShowS
[NormalizedUriJSON] -> ShowS
NormalizedUriJSON -> String
(Int -> NormalizedUriJSON -> ShowS)
-> (NormalizedUriJSON -> String)
-> ([NormalizedUriJSON] -> ShowS)
-> Show NormalizedUriJSON
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalizedUriJSON] -> ShowS
$cshowList :: [NormalizedUriJSON] -> ShowS
show :: NormalizedUriJSON -> String
$cshow :: NormalizedUriJSON -> String
showsPrec :: Int -> NormalizedUriJSON -> ShowS
$cshowsPrec :: Int -> NormalizedUriJSON -> ShowS
Show)

instance FromJSON NormalizedUriJSON where
    parseJSON :: Value -> Parser NormalizedUriJSON
parseJSON = (NormalizedUri -> NormalizedUriJSON)
-> Parser NormalizedUri -> Parser NormalizedUriJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NormalizedUri -> NormalizedUriJSON
NormalizedUriJSON (Parser NormalizedUri -> Parser NormalizedUriJSON)
-> (Value -> Parser NormalizedUri)
-> Value
-> Parser NormalizedUriJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser NormalizedUri
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
Aeson.defaultOptions

instance ToJSON NormalizedUriJSON where
    toJSON :: NormalizedUriJSON -> Value
toJSON (NormalizedUriJSON NormalizedUri
x) = Options -> NormalizedUri -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
Aeson.defaultOptions NormalizedUri
x

runRetrieCmd ::
  LspFuncs a ->
  IdeState ->
  RunRetrieParams ->
  IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
runRetrieCmd :: LspFuncs a
-> IdeState
-> RunRetrieParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
runRetrieCmd LspFuncs a
lsp IdeState
state RunRetrieParams{originatingFile :: RunRetrieParams -> NormalizedUriJSON
originatingFile = NormalizedUriJSON NormalizedUri
nuri, Bool
[RewriteSpec]
Text
restrictToOriginatingFile :: Bool
rewrites :: [RewriteSpec]
description :: Text
restrictToOriginatingFile :: RunRetrieParams -> Bool
rewrites :: RunRetrieParams -> [RewriteSpec]
description :: RunRetrieParams -> Text
..} =
  LspFuncs a
-> Text
-> ProgressCancellable
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall c.
LspFuncs c -> forall a. Text -> ProgressCancellable -> IO a -> IO a
withIndefiniteProgress LspFuncs a
lsp Text
description ProgressCancellable
Cancellable (IO
   (Either ResponseError Value,
    Maybe (ServerMethod, ApplyWorkspaceEditParams))
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b. (a -> b) -> a -> b
$ do
    Maybe (ServerMethod, ApplyWorkspaceEditParams)
res <- MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
-> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
 -> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
-> IO (Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b. (a -> b) -> a -> b
$ do
        NormalizedFilePath
nfp <- IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath)
-> IO (Maybe NormalizedFilePath) -> MaybeT IO NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> IO (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
nuri
        (HscEnvEq
session, PositionMapping
_) <- IO (Maybe (HscEnvEq, PositionMapping))
-> MaybeT IO (HscEnvEq, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (HscEnvEq, PositionMapping))
 -> MaybeT IO (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
-> MaybeT IO (HscEnvEq, PositionMapping)
forall a b. (a -> b) -> a -> b
$
            String
-> IdeState
-> Action (Maybe (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.GhcSessionDeps" IdeState
state (Action (Maybe (HscEnvEq, PositionMapping))
 -> IO (Maybe (HscEnvEq, PositionMapping)))
-> Action (Maybe (HscEnvEq, PositionMapping))
-> IO (Maybe (HscEnvEq, PositionMapping))
forall a b. (a -> b) -> a -> b
$
                GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GhcSessionDeps
GhcSessionDeps (NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping)))
-> NormalizedFilePath -> Action (Maybe (HscEnvEq, PositionMapping))
forall a b. (a -> b) -> a -> b
$
                NormalizedFilePath
nfp
        (ModSummary
ms, [HsBindLR GhcRn GhcRn]
binds, PositionMapping
_, [LRuleDecls GhcRn]
_, [TyClGroup GhcRn]
_) <- IO
  (Maybe
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> MaybeT
     IO
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO
   (Maybe
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
 -> MaybeT
      IO
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> MaybeT
     IO
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.getBinds" IdeState
state (Action
   (Maybe
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
 -> IO
      (Maybe
         (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
          [LRuleDecls GhcRn], [TyClGroup GhcRn])))
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
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 = (RewriteSpec -> [ImportSpec]) -> [RewriteSpec] -> [ImportSpec]
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) <- IO ([CallRetrieError], WorkspaceEdit)
-> MaybeT IO ([CallRetrieError], WorkspaceEdit)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ([CallRetrieError], WorkspaceEdit)
 -> MaybeT IO ([CallRetrieError], WorkspaceEdit))
-> IO ([CallRetrieError], WorkspaceEdit)
-> MaybeT IO ([CallRetrieError], WorkspaceEdit)
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)
                ((RewriteSpec -> Either ImportSpec RewriteSpec)
-> [RewriteSpec] -> [Either ImportSpec RewriteSpec]
forall a b. (a -> b) -> [a] -> [b]
map RewriteSpec -> Either ImportSpec RewriteSpec
forall a b. b -> Either a b
Right [RewriteSpec]
rewrites [Either ImportSpec RewriteSpec]
-> [Either ImportSpec RewriteSpec]
-> [Either ImportSpec RewriteSpec]
forall a. Semigroup a => a -> a -> a
<> (ImportSpec -> Either ImportSpec RewriteSpec)
-> [ImportSpec] -> [Either ImportSpec RewriteSpec]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> Either ImportSpec RewriteSpec
forall a b. a -> Either a b
Left [ImportSpec]
importRewrites)
                NormalizedFilePath
nfp
                Bool
restrictToOriginatingFile
        Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([CallRetrieError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CallRetrieError]
errors) (MaybeT IO () -> MaybeT IO ()) -> MaybeT IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$
            IO () -> MaybeT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ LspFuncs a -> SendFunc
forall c. LspFuncs c -> SendFunc
sendFunc LspFuncs a
lsp SendFunc -> SendFunc
forall a b. (a -> b) -> a -> b
$
                ShowMessageNotification -> FromServerMessage
NotShowMessage (ShowMessageNotification -> FromServerMessage)
-> ShowMessageNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$
                Text
-> ServerMethod -> ShowMessageParams -> ShowMessageNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ServerMethod
WindowShowMessage (ShowMessageParams -> ShowMessageNotification)
-> ShowMessageParams -> ShowMessageNotification
forall a b. (a -> b) -> a -> b
$
                    MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MtWarning (Text -> ShowMessageParams) -> Text -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$
                    [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                        Text
"## Found errors during rewrite:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                        [Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CallRetrieError -> String
forall a. Show a => a -> String
show CallRetrieError
e) | CallRetrieError
e <- [CallRetrieError]
errors]
        (ServerMethod, ApplyWorkspaceEditParams)
-> MaybeT IO (ServerMethod, ApplyWorkspaceEditParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerMethod
WorkspaceApplyEdit, WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
edits)
    (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return
      (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
res)

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

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

provider :: CodeActionProvider IdeState
provider :: CodeActionProvider IdeState
provider LspFuncs Config
_a IdeState
state PluginId
plId (TextDocumentIdentifier Uri
uri) Range
range CodeActionContext
ca = ExceptT String IO (List CAResult)
-> IO (Either ResponseError (List CAResult))
forall a. ExceptT String IO a -> IO (Either ResponseError a)
response (ExceptT String IO (List CAResult)
 -> IO (Either ResponseError (List CAResult)))
-> ExceptT String IO (List CAResult)
-> IO (Either ResponseError (List CAResult))
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
      nuriJson :: NormalizedUriJSON
nuriJson = NormalizedUri -> NormalizedUriJSON
NormalizedUriJSON NormalizedUri
nuri
  NormalizedFilePath
nfp <- String
-> Maybe NormalizedFilePath -> ExceptT String IO NormalizedFilePath
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"uri" (Maybe NormalizedFilePath -> ExceptT String IO NormalizedFilePath)
-> Maybe NormalizedFilePath -> ExceptT String IO NormalizedFilePath
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, [LRuleDecls GhcRn]
hs_ruleds, [TyClGroup GhcRn]
hs_tyclds)
    <- String
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> ExceptT
     String
     IO
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM String
"typecheck" (IO
   (Maybe
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
 -> ExceptT
      String
      IO
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> ExceptT
     String
     IO
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
forall a b. (a -> b) -> a -> b
$ String
-> IdeState
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
forall a. String -> IdeState -> Action a -> IO a
runAction String
"retrie" IdeState
state (Action
   (Maybe
      (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
       [LRuleDecls GhcRn], [TyClGroup GhcRn]))
 -> IO
      (Maybe
         (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
          [LRuleDecls GhcRn], [TyClGroup GhcRn])))
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
-> IO
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
getBinds NormalizedFilePath
nfp

  Position
pos <- String -> Maybe Position -> ExceptT String IO Position
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"pos" (Maybe Position -> ExceptT String IO Position)
-> Maybe Position -> ExceptT String IO Position
forall a b. (a -> b) -> a -> b
$ Range -> Position
_start (Range -> Position) -> Maybe Range -> Maybe Position
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 =
        (HsBindLR GhcRn GhcRn -> [(Text, CodeActionKind, RunRetrieParams)])
-> [HsBindLR GhcRn GhcRn]
-> [(Text, CodeActionKind, RunRetrieParams)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NormalizedUriJSON
-> Position
-> Module
-> HsBindLR GhcRn GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites NormalizedUriJSON
nuriJson Position
pos Module
ms_mod) [HsBindLR GhcRn GhcRn]
topLevelBinds
          [(Text, CodeActionKind, RunRetrieParams)]
-> [(Text, CodeActionKind, RunRetrieParams)]
-> [(Text, CodeActionKind, RunRetrieParams)]
forall a. [a] -> [a] -> [a]
++ (LRuleDecls GhcRn -> [(Text, CodeActionKind, RunRetrieParams)])
-> [LRuleDecls GhcRn] -> [(Text, CodeActionKind, RunRetrieParams)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NormalizedUriJSON
-> Position
-> Module
-> LRuleDecls GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
forall pass.
NormalizedUriJSON
-> Position
-> Module
-> LRuleDecls pass
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites NormalizedUriJSON
nuriJson Position
pos Module
ms_mod) [LRuleDecls GhcRn]
hs_ruleds
          [(Text, CodeActionKind, RunRetrieParams)]
-> [(Text, CodeActionKind, RunRetrieParams)]
-> [(Text, CodeActionKind, RunRetrieParams)]
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 SrcSpan
l TyClDecl GhcRn
g <- [LTyClDecl GhcRn]
group_tyclds,
                 (Text, CodeActionKind, RunRetrieParams)
r <- NormalizedUriJSON
-> Module
-> TyClDecl GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
forall pass.
Outputable (IdP pass) =>
NormalizedUriJSON
-> Module
-> TyClDecl pass
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites NormalizedUriJSON
nuriJson Module
ms_mod TyClDecl GhcRn
g,
                 Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l

             ]

  [CodeAction]
commands <- IO [CodeAction] -> ExceptT String IO [CodeAction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [CodeAction] -> ExceptT String IO [CodeAction])
-> IO [CodeAction] -> ExceptT String IO [CodeAction]
forall a b. (a -> b) -> a -> b
$
    [(Text, CodeActionKind, RunRetrieParams)]
-> ((Text, CodeActionKind, RunRetrieParams) -> IO CodeAction)
-> IO [CodeAction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, CodeActionKind, RunRetrieParams)]
rewrites (((Text, CodeActionKind, RunRetrieParams) -> IO CodeAction)
 -> IO [CodeAction])
-> ((Text, CodeActionKind, RunRetrieParams) -> IO CodeAction)
-> IO [CodeAction]
forall a b. (a -> b) -> a -> b
$ \(Text
title, CodeActionKind
kind, RunRetrieParams
params) -> do
      Command
c <- PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
mkLspCommand PluginId
plId (Text -> CommandId
coerce Text
retrieCommandName) Text
title ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [RunRetrieParams -> Value
forall a. ToJSON a => a -> Value
toJSON RunRetrieParams
params])
      CodeAction -> IO CodeAction
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeAction -> IO CodeAction) -> CodeAction -> IO CodeAction
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe CodeActionKind
-> Maybe (List Diagnostic)
-> Maybe WorkspaceEdit
-> Maybe Command
-> CodeAction
CodeAction Text
title (CodeActionKind -> Maybe CodeActionKind
forall a. a -> Maybe a
Just CodeActionKind
kind) Maybe (List Diagnostic)
forall a. Maybe a
Nothing Maybe WorkspaceEdit
forall a. Maybe a
Nothing (Command -> Maybe Command
forall a. a -> Maybe a
Just Command
c)

  List CAResult -> ExceptT String IO (List CAResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (List CAResult -> ExceptT String IO (List CAResult))
-> List CAResult -> ExceptT String IO (List CAResult)
forall a b. (a -> b) -> a -> b
$ [CAResult] -> List CAResult
forall a. [a] -> List a
J.List [CodeAction -> CAResult
CACodeAction 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 = MaybeT
  Action
  (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
   [LRuleDecls GhcRn], [TyClGroup GhcRn])
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   Action
   (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
    [LRuleDecls GhcRn], [TyClGroup GhcRn])
 -> Action
      (Maybe
         (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
          [LRuleDecls GhcRn], [TyClGroup GhcRn])))
-> MaybeT
     Action
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
-> Action
     (Maybe
        (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
         [LRuleDecls GhcRn], [TyClGroup GhcRn]))
forall a b. (a -> b) -> a -> b
$ do
  (TcModuleResult
tm, PositionMapping
posMapping) <- Action (Maybe (TcModuleResult, PositionMapping))
-> MaybeT Action (TcModuleResult, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (TcModuleResult, PositionMapping))
 -> MaybeT Action (TcModuleResult, PositionMapping))
-> Action (Maybe (TcModuleResult, PositionMapping))
-> MaybeT Action (TcModuleResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ TypeCheck
-> NormalizedFilePath
-> Action (Maybe (TcModuleResult, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale TypeCheck
TypeCheck NormalizedFilePath
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
                (NValBinds binds _sigs :: NHsValBindsLR GHC.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
_, LHsBinds GhcRn
bagBinds) <- [(RecFlag, LHsBinds GhcRn)]
binds,
            L SrcSpan
_ HsBindLR GhcRn GhcRn
decl <- LHsBinds GhcRn -> [GenLocated SrcSpan (HsBindLR GhcRn GhcRn)]
forall a. Bag a -> [a]
GHC.bagToList LHsBinds GhcRn
bagBinds
        ]
  (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
 [LRuleDecls GhcRn], [TyClGroup GhcRn])
-> MaybeT
     Action
     (ModSummary, [HsBindLR GhcRn GhcRn], PositionMapping,
      [LRuleDecls GhcRn], [TyClGroup GhcRn])
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 ::
  NormalizedUriJSON ->
  Position ->
  GHC.Module ->
  HsBindLR GhcRn GhcRn ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites :: NormalizedUriJSON
-> Position
-> Module
-> HsBindLR GhcRn GhcRn
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestBindRewrites NormalizedUriJSON
originatingFile Position
pos Module
ms_mod (FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = L SrcSpan
l' IdP GhcRn
rdrName})
  | Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l' =
    let pprName :: String
pprName = Name -> String
forall a. Outputable a => a -> String
prettyPrint IdP GhcRn
Name
rdrName
        pprNameText :: Text
pprNameText = String -> Text
T.pack String
pprName
        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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pprNameText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
            in (Text
description, CodeActionKind
CodeActionRefactorInline, RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pprNameText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorExtract, RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
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]
  where
suggestBindRewrites NormalizedUriJSON
_ Position
_ Module
_ HsBindLR GhcRn GhcRn
_ = []

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

suggestTypeRewrites ::
  (Outputable (IdP pass)) =>
  NormalizedUriJSON ->
  GHC.Module ->
  TyClDecl pass ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites :: NormalizedUriJSON
-> Module
-> TyClDecl pass
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestTypeRewrites NormalizedUriJSON
originatingFile Module
ms_mod (SynDecl {tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP pass
rdrName}) =
    let pprName :: String
pprName = IdP pass -> String
forall a. Outputable a => a -> String
prettyPrint IdP pass
rdrName
        pprNameText :: Text
pprNameText = String -> Text
T.pack String
pprName
        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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pprNameText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorInline, RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pprNameText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in (Text
description, CodeActionKind
CodeActionRefactorExtract, RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
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 NormalizedUriJSON
_ Module
_ TyClDecl pass
_ = []

suggestRuleRewrites ::
  NormalizedUriJSON ->
  Position ->
  GHC.Module ->
  LRuleDecls pass ->
  [(T.Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites :: NormalizedUriJSON
-> Position
-> Module
-> LRuleDecls pass
-> [(Text, CodeActionKind, RunRetrieParams)]
suggestRuleRewrites NormalizedUriJSON
originatingFile Position
pos Module
ms_mod (L SrcSpan
_ (HsRules {[LRuleDecl pass]
rds_rules :: [LRuleDecl pass]
rds_rules :: forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_rules})) =
    [[(Text, CodeActionKind, RunRetrieParams)]]
-> [(Text, CodeActionKind, RunRetrieParams)]
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 SrcSpan
l RuleDecl pass
r  <- [LRuleDecl pass]
rds_rules,
          Position
pos Position -> SrcSpan -> Bool
`isInsideSrcSpan` SrcSpan
l,
#if MIN_GHC_API_VERSION(8,8,0)
          let HsRule {rd_name :: forall pass. RuleDecl pass -> Located (SourceText, RuleName)
rd_name = L SrcSpan
_ (SourceText
_, RuleName
rn)} = RuleDecl pass
r,
#else
          let HsRule _ (L _ (_,rn)) _ _ _ _ = r,
#endif
          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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ruleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" forward" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                            Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile

        in ( Text
description,
            CodeActionKind
CodeActionRefactor,
            RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ruleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" backwards" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                              Bool -> Text
forall p. IsString p => Bool -> p
describeRestriction Bool
restrictToOriginatingFile
           in ( Text
description,
                CodeActionKind
CodeActionRefactor,
                RunRetrieParams :: Text
-> [RewriteSpec] -> NormalizedUriJSON -> Bool -> RunRetrieParams
RunRetrieParams {Bool
[RewriteSpec]
Text
NormalizedUriJSON
description :: Text
rewrites :: [RewriteSpec]
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
restrictToOriginatingFile :: Bool
originatingFile :: NormalizedUriJSON
rewrites :: [RewriteSpec]
description :: Text
..}
              )

suggestRuleRewrites NormalizedUriJSON
_ Position
_ Module
_ LRuleDecls pass
_ = []

qualify :: GHC.Module -> String -> String
qualify :: Module -> ShowS
qualify Module
ms_mod String
x = Module -> String
forall a. Outputable a => a -> String
prettyPrint Module
ms_mod String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
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
(CallRetrieError -> CallRetrieError -> Bool)
-> (CallRetrieError -> CallRetrieError -> Bool)
-> Eq CallRetrieError
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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f
  show (NoParse NormalizedFilePath
f) = String
"Cannot parse: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f
  show (GHCParseError NormalizedFilePath
f String
m) = String
"Cannot parse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m
  show (NoTypeCheck NormalizedFilePath
f) = String
"File does not typecheck: " String -> ShowS
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 (KnownTargets -> HashSet NormalizedFilePath)
-> (Hashed KnownTargets -> KnownTargets)
-> Hashed KnownTargets
-> HashSet NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hashed KnownTargets -> KnownTargets
forall a. Hashed a -> a
unhashed (Hashed KnownTargets -> HashSet NormalizedFilePath)
-> IO (Hashed KnownTargets) -> IO (HashSet NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var (Hashed KnownTargets) -> IO (Hashed KnownTargets)
forall a. Var a -> IO a
readVar (ShakeExtras -> Var (Hashed KnownTargets)
knownTargetsVar (ShakeExtras -> Var (Hashed KnownTargets))
-> ShakeExtras -> Var (Hashed KnownTargets)
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state)
  HashSet NormalizedFilePath -> IO ()
forall a. Show a => a -> IO ()
print HashSet NormalizedFilePath
knownFiles
  let reuseParsedModule :: NormalizedFilePath -> IO (FixityEnv, Annotated ParsedSource)
reuseParsedModule NormalizedFilePath
f = do
        ParsedModule
pm <-
          String
-> (NormalizedFilePath -> CallRetrieError)
-> GetParsedModule
-> NormalizedFilePath
-> IO (RuleResult GetParsedModule)
forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"GetParsedModule" NormalizedFilePath -> CallRetrieError
NoParse GetParsedModule
GetParsedModule NormalizedFilePath
f
        (FixityEnv
fixities, Annotated ParsedSource
pm) <- NormalizedFilePath
-> Annotated ParsedSource -> IO (FixityEnv, Annotated ParsedSource)
forall ast2.
Data ast2 =>
NormalizedFilePath
-> Annotated ast2 -> IO (FixityEnv, Annotated ast2)
fixFixities NormalizedFilePath
f (ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule
pm)
        (FixityEnv, Annotated ParsedSource)
-> IO (FixityEnv, Annotated ParsedSource)
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' (String -> NormalizedFilePath)
-> IO String -> IO NormalizedFilePath
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, [LImportDecl GhcPs]
_) <-
                String
-> (NormalizedFilePath -> CallRetrieError)
-> GetModSummary
-> NormalizedFilePath
-> IO (RuleResult GetModSummary)
forall r v.
IdeRule r v =>
String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
"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 =
                          StringBuffer -> Maybe StringBuffer
forall a. a -> Maybe a
Just (String -> StringBuffer
stringToStringBuffer String
contents)
                      }
              Logger -> Priority -> Text -> IO ()
logPriority (IdeState -> Logger
ideLogger IdeState
state) Priority
Info (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Parsing module: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
              ParsedModule
parsed <-
                HscEnv -> Ghc ParsedModule -> IO ParsedModule
forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
session (ModSummary -> Ghc ParsedModule
forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
parseModule ModSummary
ms')
                  IO ParsedModule
-> (SomeException -> IO ParsedModule) -> IO ParsedModule
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> CallRetrieError -> IO ParsedModule
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (NormalizedFilePath -> String -> CallRetrieError
GHCParseError NormalizedFilePath
nt (SomeException -> String
forall a. Show a => a -> String
show @SomeException SomeException
e))
              (FixityEnv
fixities, Annotated ParsedSource
parsed) <- NormalizedFilePath
-> Annotated ParsedSource -> IO (FixityEnv, Annotated ParsedSource)
forall ast2.
Data ast2 =>
NormalizedFilePath
-> Annotated ast2 -> IO (FixityEnv, Annotated ast2)
fixFixities NormalizedFilePath
f (ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule
parsed)
              (FixityEnv, Annotated ParsedSource)
-> IO (FixityEnv, Annotated ParsedSource)
forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ParsedSource
parsed)

        Text
contents <- do
          (UTCTime
_, Maybe Text
mbContentsVFS) <-
            String
-> IdeState
-> Action (UTCTime, Maybe Text)
-> IO (UTCTime, Maybe Text)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"Retrie.GetFileContents" IdeState
state (Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text))
-> Action (UTCTime, Maybe Text) -> IO (UTCTime, Maybe Text)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
nt
          case Maybe Text
mbContentsVFS of
            Just Text
contents -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
contents
            Maybe Text
Nothing       -> String -> IO Text
T.readFile (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nt)
        if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
T.isPrefixOf Text
"#if" (Text -> Bool) -> (Text -> Text) -> Text -> Bool
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 <- FixityEnv -> IO (IORef FixityEnv)
forall a. a -> IO (IORef a)
newIORef FixityEnv
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
                  IORef FixityEnv -> (FixityEnv -> FixityEnv) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef FixityEnv
fixitiesRef (FixityEnv
fix FixityEnv -> FixityEnv -> FixityEnv
forall a. Semigroup a => a -> a -> a
<>)
                  Annotated ParsedSource -> IO (Annotated ParsedSource)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotated ParsedSource
res
            CPP (Annotated ParsedSource)
res <- (String -> IO (Annotated ParsedSource))
-> Text -> IO (CPP (Annotated ParsedSource))
forall (m :: * -> *).
Monad m =>
(String -> m (Annotated ParsedSource))
-> Text -> m (CPP (Annotated ParsedSource))
parseCPP String -> IO (Annotated ParsedSource)
parseModule Text
contents
            FixityEnv
fixities <- IORef FixityEnv -> IO FixityEnv
forall a. IORef a -> IO a
readIORef IORef FixityEnv
fixitiesRef
            (FixityEnv, CPP (Annotated ParsedSource))
-> IO (FixityEnv, CPP (Annotated ParsedSource))
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
            (FixityEnv, CPP (Annotated ParsedSource))
-> IO (FixityEnv, CPP (Annotated ParsedSource))
forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ParsedSource -> CPP (Annotated ParsedSource)
forall a. a -> CPP a
NoCPP Annotated ParsedSource
pm)

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

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

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

      annotatedImports :: Annotated [LImportDecl GhcPs]
annotatedImports =
        [LImportDecl GhcPs] -> Anns -> Int -> Annotated [LImportDecl GhcPs]
forall ast. ast -> Anns -> Int -> Annotated ast
unsafeMkA ((ImportSpec -> LImportDecl GhcPs)
-> [ImportSpec] -> [LImportDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (ImportDecl GhcPs -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc (ImportDecl GhcPs -> LImportDecl GhcPs)
-> (ImportSpec -> ImportDecl GhcPs)
-> ImportSpec
-> LImportDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportSpec -> ImportDecl GhcPs
toImportDecl) [ImportSpec]
theImports) Anns
forall a. Monoid a => a
mempty Int
0

  (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 Retrie () -> Retrie () -> Retrie ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Annotated [LImportDecl GhcPs] -> Retrie ()
addImports Annotated [LImportDecl GhcPs]
annotatedImports)
      ([Rewrite Universe] -> Retrie ())
-> IO [Rewrite Universe] -> IO (Retrie ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (CPP (Annotated ParsedSource)))
-> FixityEnv -> [RewriteSpec] -> IO [Rewrite Universe]
parseRewriteSpecs
        (\String
_f -> CPP (Annotated ParsedSource) -> IO (CPP (Annotated ParsedSource))
forall (m :: * -> *) a. Monad m => a -> m a
return (CPP (Annotated ParsedSource) -> IO (CPP (Annotated ParsedSource)))
-> CPP (Annotated ParsedSource)
-> IO (CPP (Annotated ParsedSource))
forall a b. (a -> b) -> a -> b
$ Annotated ParsedSource -> CPP (Annotated ParsedSource)
forall a. a -> CPP a
NoCPP Annotated ParsedSource
originParsedModule)
        FixityEnv
originFixities
        [RewriteSpec]
theRewrites

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

  [Either CallRetrieError [(Uri, TextEdit)]]
results <- [String]
-> (String -> IO (Either CallRetrieError [(Uri, TextEdit)]))
-> IO [Either CallRetrieError [(Uri, TextEdit)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
targets ((String -> IO (Either CallRetrieError [(Uri, TextEdit)]))
 -> IO [Either CallRetrieError [(Uri, TextEdit)]])
-> (String -> IO (Either CallRetrieError [(Uri, TextEdit)]))
-> IO [Either CallRetrieError [(Uri, TextEdit)]]
forall a b. (a -> b) -> a -> b
$ \String
t -> ExceptT CallRetrieError IO [(Uri, TextEdit)]
-> IO (Either CallRetrieError [(Uri, TextEdit)])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CallRetrieError IO [(Uri, TextEdit)]
 -> IO (Either CallRetrieError [(Uri, TextEdit)]))
-> ExceptT CallRetrieError IO [(Uri, TextEdit)]
-> IO (Either CallRetrieError [(Uri, TextEdit)])
forall a b. (a -> b) -> a -> b
$ do
    (FixityEnv
fixityEnv, CPP (Annotated ParsedSource)
cpp) <- IO
  (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource)))
-> ExceptT
     CallRetrieError IO (FixityEnv, CPP (Annotated ParsedSource))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource)))
 -> ExceptT
      CallRetrieError IO (FixityEnv, CPP (Annotated ParsedSource)))
-> IO
     (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource)))
-> ExceptT
     CallRetrieError IO (FixityEnv, CPP (Annotated ParsedSource))
forall a b. (a -> b) -> a -> b
$ IO (FixityEnv, CPP (Annotated ParsedSource))
-> IO
     (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource)))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (FixityEnv, CPP (Annotated ParsedSource))
 -> IO
      (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource))))
-> IO (FixityEnv, CPP (Annotated ParsedSource))
-> IO
     (Either CallRetrieError (FixityEnv, CPP (Annotated ParsedSource)))
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 [Annotated [LImportDecl GhcPs]]
_imports)) <-
      IO ((), CPP (Annotated ParsedSource), Change)
-> ExceptT
     CallRetrieError IO ((), CPP (Annotated ParsedSource), Change)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ((), CPP (Annotated ParsedSource), Change)
 -> ExceptT
      CallRetrieError IO ((), CPP (Annotated ParsedSource), Change))
-> IO ((), CPP (Annotated ParsedSource), Change)
-> ExceptT
     CallRetrieError IO ((), CPP (Annotated ParsedSource), Change)
forall a b. (a -> b) -> a -> b
$ FixityEnv
-> Retrie ()
-> CPP (Annotated ParsedSource)
-> IO ((), CPP (Annotated ParsedSource), Change)
forall a.
FixityEnv
-> Retrie a
-> CPP (Annotated ParsedSource)
-> IO (a, CPP (Annotated ParsedSource), Change)
runRetrie FixityEnv
fixityEnv Retrie ()
retrie CPP (Annotated ParsedSource)
cpp
    case CPP (Annotated ParsedSource)
ast of
      CPP (Annotated ParsedSource)
_ ->
        [(Uri, TextEdit)] -> ExceptT CallRetrieError IO [(Uri, TextEdit)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Uri, TextEdit)] -> ExceptT CallRetrieError IO [(Uri, TextEdit)])
-> [(Uri, TextEdit)]
-> ExceptT CallRetrieError IO [(Uri, TextEdit)]
forall a b. (a -> b) -> a -> b
$ Change -> [(Uri, TextEdit)]
asTextEdits Change
change

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

  ([CallRetrieError], WorkspaceEdit)
-> IO ([CallRetrieError], WorkspaceEdit)
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 :: String
-> (NormalizedFilePath -> CallRetrieError)
-> r
-> NormalizedFilePath
-> IO (RuleResult r)
useOrFail String
lbl NormalizedFilePath -> CallRetrieError
mkException r
rule NormalizedFilePath
f =
      String
-> IdeState -> r -> NormalizedFilePath -> IO (Maybe (RuleResult r))
forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
useRule String
lbl IdeState
state r
rule NormalizedFilePath
f IO (Maybe v) -> (Maybe v -> IO v) -> IO v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO v -> (v -> IO v) -> Maybe v -> IO v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO v -> IO v
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO v -> IO v) -> IO v -> IO v
forall a b. (a -> b) -> a -> b
$ CallRetrieError -> IO v
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (CallRetrieError -> IO v) -> CallRetrieError -> IO v
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> CallRetrieError
mkException NormalizedFilePath
f) v -> IO v
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) <- ModIface_ phase -> [(OccName, 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 {HomeModInfo
hirHomeMod :: HiFileResult -> HomeModInfo
hirHomeMod :: HomeModInfo
hirHomeMod} <-
        String
-> (NormalizedFilePath -> CallRetrieError)
-> GetModIface
-> NormalizedFilePath
-> IO (RuleResult GetModIface)
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 = ModIface_ 'ModIfaceFinal -> FixityEnv
forall (phase :: ModIfacePhase). ModIface_ phase -> FixityEnv
fixityEnvFromModIface (ModIface_ 'ModIfaceFinal -> FixityEnv)
-> ModIface_ 'ModIfaceFinal -> FixityEnv
forall a b. (a -> b) -> a -> b
$ HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hirHomeMod
      Annotated ast2
res <- Annotated ast2
-> (ast2 -> TransformT IO ast2) -> IO (Annotated ast2)
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA Annotated ast2
pm (FixityEnv -> ast2 -> TransformT IO ast2
forall ast (m :: * -> *).
(Data ast, Monad m) =>
FixityEnv -> ast -> TransformT m ast
fix FixityEnv
fixities)
      (FixityEnv, Annotated ast2) -> IO (FixityEnv, Annotated ast2)
forall (m :: * -> *) a. Monad m => a -> m a
return (FixityEnv
fixities, Annotated ast2
res)
    fixAnns :: ParsedModule -> Annotated ParsedSource
fixAnns ParsedModule {[String]
ApiAnns
ModSummary
ParsedSource
pm_mod_summary :: ParsedModule -> ModSummary
pm_parsed_source :: ParsedModule -> ParsedSource
pm_extra_src_files :: ParsedModule -> [String]
pm_annotations :: ParsedModule -> ApiAnns
pm_annotations :: ApiAnns
pm_extra_src_files :: [String]
pm_parsed_source :: ParsedSource
pm_mod_summary :: ModSummary
..} =
      let ranns :: Anns
ranns = ParsedSource -> ApiAnns -> Anns
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> ApiAnns -> Anns
relativiseApiAnns ParsedSource
pm_parsed_source ApiAnns
pm_annotations
       in ParsedSource -> Anns -> Int -> Annotated ParsedSource
forall ast. ast -> Anns -> Int -> Annotated ast
unsafeMkA ParsedSource
pm_parsed_source Anns
ranns Int
0

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

asTextEdits :: Change -> [(Uri, TextEdit)]
asTextEdits :: Change -> [(Uri, TextEdit)]
asTextEdits Change
NoChange = []
asTextEdits (Change [Replacement]
reps [Annotated [LImportDecl GhcPs]]
_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
..} <- (Replacement -> SrcSpan) -> [Replacement] -> [Replacement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn Replacement -> SrcSpan
replLocation [Replacement]
reps,
      (RealSrcSpan RealSrcSpan
rspan) <- [SrcSpan
replLocation],
      let spanLoc :: String
spanLoc = RuleName -> String
unpackFS (RuleName -> String) -> RuleName -> String
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 :: String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleBlocking String
label IdeState
state k
rule NormalizedFilePath
f = String -> IdeState -> Action (Maybe v) -> IO (Maybe v)
forall a. String -> IdeState -> Action a -> IO a
runAction String
label IdeState
state (k -> NormalizedFilePath -> Action (Maybe v)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use k
rule NormalizedFilePath
f)
_useRuleStale :: String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleStale String
label IdeState
state k
rule NormalizedFilePath
f =
  ((v, PositionMapping) -> v)
-> Maybe (v, PositionMapping) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v, PositionMapping) -> v
forall a b. (a, b) -> a
fst
    (Maybe (v, PositionMapping) -> Maybe v)
-> IO (Maybe (v, PositionMapping)) -> IO (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ShakeExtras
-> IdeAction (Maybe (v, PositionMapping))
-> IO (Maybe (v, PositionMapping))
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
label (IdeState -> ShakeExtras
shakeExtras IdeState
state) (k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
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 :: String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
useRule String
label = String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
forall k v.
IdeRule k v =>
String
-> IdeState -> k -> NormalizedFilePath -> IO (Maybe (RuleResult k))
_useRuleStale (String
"Retrie." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
label)

-------------------------------------------------------------------------------
-- Error handling combinators

handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe :: e -> Maybe b -> ExceptT e m b
handleMaybe e
msg = ExceptT e m b -> (b -> ExceptT e m b) -> Maybe b -> ExceptT e m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return

handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
handleMaybeM :: e -> m (Maybe b) -> ExceptT e m b
handleMaybeM e
msg m (Maybe b)
act = ExceptT e m b -> (b -> ExceptT e m b) -> Maybe b -> ExceptT e m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> ExceptT e m b)
-> ExceptT e m (Maybe b) -> ExceptT e m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe b) -> ExceptT e m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe b)
act

response :: ExceptT String IO a -> IO (Either ResponseError a)
response :: ExceptT String IO a -> IO (Either ResponseError a)
response =
  (Either String a -> Either ResponseError a)
-> IO (Either String a) -> IO (Either ResponseError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> ResponseError)
-> Either String a -> Either ResponseError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
msg -> ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (String -> Text
forall a. IsString a => String -> a
fromString String
msg) Maybe Value
forall a. Maybe a
Nothing))
    (IO (Either String a) -> IO (Either ResponseError a))
-> (ExceptT String IO a -> IO (Either String a))
-> ExceptT String IO a
-> IO (Either ResponseError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String IO a -> IO (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-------------------------------------------------------------------------------
-- 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
(QualName -> QualName -> Bool)
-> (QualName -> QualName -> Bool) -> Eq QualName
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
(Int -> QualName -> ShowS)
-> (QualName -> String) -> ([QualName] -> ShowS) -> Show QualName
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. QualName -> Rep QualName x)
-> (forall x. Rep QualName x -> QualName) -> Generic QualName
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
(Value -> Parser QualName)
-> (Value -> Parser [QualName]) -> FromJSON 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
(QualName -> Value)
-> (QualName -> Encoding)
-> ([QualName] -> Value)
-> ([QualName] -> Encoding)
-> ToJSON QualName
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)

data IE name
  = IEVar name
  deriving (IE name -> IE name -> Bool
(IE name -> IE name -> Bool)
-> (IE name -> IE name -> Bool) -> Eq (IE name)
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
[IE name] -> ShowS
IE name -> String
(Int -> IE name -> ShowS)
-> (IE name -> String) -> ([IE name] -> ShowS) -> Show (IE name)
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 x. IE name -> Rep (IE name) x)
-> (forall x. Rep (IE name) x -> IE name) -> Generic (IE name)
forall x. Rep (IE name) x -> IE name
forall x. IE name -> Rep (IE name) x
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, Value -> Parser [IE name]
Value -> Parser (IE name)
(Value -> Parser (IE name))
-> (Value -> Parser [IE name]) -> FromJSON (IE name)
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, [IE name] -> Encoding
[IE name] -> Value
IE name -> Encoding
IE name -> Value
(IE name -> Value)
-> (IE name -> Encoding)
-> ([IE name] -> Value)
-> ([IE name] -> Encoding)
-> ToJSON (IE name)
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
(ImportSpec -> ImportSpec -> Bool)
-> (ImportSpec -> ImportSpec -> Bool) -> Eq ImportSpec
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
(Int -> ImportSpec -> ShowS)
-> (ImportSpec -> String)
-> ([ImportSpec] -> ShowS)
-> Show ImportSpec
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. ImportSpec -> Rep ImportSpec x)
-> (forall x. Rep ImportSpec x -> ImportSpec) -> Generic ImportSpec
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
(Value -> Parser ImportSpec)
-> (Value -> Parser [ImportSpec]) -> FromJSON 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
(ImportSpec -> Value)
-> (ImportSpec -> Encoding)
-> ([ImportSpec] -> Value)
-> ([ImportSpec] -> Encoding)
-> ToJSON ImportSpec
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
..} = ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
GHC.ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
NoExtField
XCImportDecl GhcPs
SourceText
Located ModuleName
forall a. Maybe a
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: Located ModuleName
ideclPkgQual :: Maybe StringLiteral
ideclSource :: Bool
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (Located ModuleName)
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (Located ModuleName)
ideclExt :: NoExtField
ideclSourceSrc :: SourceText
ideclHiding :: forall a. Maybe a
ideclImplicit :: Bool
ideclSafe :: Bool
ideclPkgQual :: forall a. Maybe a
ideclName :: Located ModuleName
ideclSource :: Bool
..}
  where
    toMod :: String -> Located ModuleName
toMod = ModuleName -> Located ModuleName
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc (ModuleName -> Located ModuleName)
-> (String -> ModuleName) -> String -> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleName
GHC.mkModuleName
    ideclName :: Located ModuleName
ideclName = String -> Located ModuleName
toMod String
ideclNameString
    ideclPkgQual :: Maybe a
ideclPkgQual = Maybe a
forall a. Maybe a
Nothing
    ideclSafe :: Bool
ideclSafe = Bool
False
    ideclImplicit :: Bool
ideclImplicit = Bool
False
    ideclHiding :: Maybe a
ideclHiding = Maybe a
forall a. Maybe a
Nothing
    ideclSourceSrc :: SourceText
ideclSourceSrc = SourceText
NoSourceText
    ideclExt :: NoExtField
ideclExt = NoExtField
GHC.noExtField
    ideclAs :: Maybe (Located ModuleName)
ideclAs = String -> Located ModuleName
toMod (String -> Located ModuleName)
-> Maybe String -> Maybe (Located ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
ideclAsString
#if MIN_GHC_API_VERSION(8,10,0)
    ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = if Bool
ideclQualifiedBool then ImportDeclQualifiedStyle
GHC.QualifiedPre else ImportDeclQualifiedStyle
GHC.NotQualified
#else
    ideclQualified = ideclQualifiedBool
#endif