diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index d84a0c2781..c5996d558b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -190,6 +190,7 @@ library Development.IDE.GHC.Warnings Development.IDE.LSP.Notifications Development.IDE.Plugin.CodeAction.PositionIndexed + Development.IDE.Plugin.CodeAction.Args Development.IDE.Plugin.Completions.Logic Development.IDE.Session.VersionCheck Development.IDE.Types.Action diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 3fe9b7bb71..4d1758d866 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -3,11 +3,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} #include "ghc-api-version.h" -- | Go to the definition of a variable. + module Development.IDE.Plugin.CodeAction ( descriptor @@ -20,7 +19,6 @@ import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) import Control.Concurrent.Extra (readVar) -import Control.Lens (alaf) import Control.Monad (guard, join) import Control.Monad.IO.Class import Data.Char @@ -34,7 +32,6 @@ import Data.List.NonEmpty (NonEmpty ((: import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Maybe -import Data.Monoid (Ap (..)) import qualified Data.Rope.UTF16 as Rope import qualified Data.Set as S import qualified Data.Text as T @@ -47,13 +44,12 @@ import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util (prettyPrint, printRdrName) +import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs), - GlobalBindingTypeSigsResult, suggestSignature) import Development.IDE.Spans.Common -import Development.IDE.Spans.LocalBindings (Bindings) import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Location @@ -116,8 +112,8 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod exportsMap = localExports <> pkgExports df = ms_hspp_opts . pm_mod_summary <$> parsedModule actions = - [ mkCA title [x] edit - | x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x + [ mkCA title kind isPreferred [x] edit + | x <- xs, (title, kind, isPreferred, tedit) <- suggestAction $ CodeActionArgs exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing ] actions' = caRemoveRedundantImports parsedModule text diag xs uri @@ -125,59 +121,35 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod <> caRemoveInvalidExports parsedModule text diag xs uri pure $ Right $ List actions' -mkCA :: T.Text -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) -mkCA title diags edit = - InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List diags) Nothing Nothing (Just edit) Nothing - -rewrite :: - Maybe DynFlags -> - Maybe (Annotated ParsedSource) -> - (DynFlags -> ParsedSource -> [(T.Text, [Rewrite])]) -> - [(T.Text, [TextEdit])] -rewrite (Just df) (Just ps) f - | Right edit <- (traverse . traverse) - (alaf Ap foldMap (rewriteToEdit df (annsA ps))) - (f df $ astA ps) = edit -rewrite _ _ _ = [] - -suggestAction - :: ExportsMap - -> IdeOptions - -> Maybe ParsedModule - -> Maybe T.Text - -> Maybe DynFlags - -> Maybe (Annotated ParsedSource) - -> Maybe TcModuleResult - -> Maybe HieAstResult - -> Maybe Bindings - -> Maybe GlobalBindingTypeSigsResult - -> Diagnostic - -> [(T.Text, [TextEdit])] -suggestAction packageExports ideOptions parsedModule text df annSource tcM har bindings gblSigs diag = - concat - -- Order these suggestions by priority - [ suggestSignature True gblSigs tcM bindings diag - , rewrite df annSource $ \_ ps -> suggestExtendImport packageExports ps diag - , rewrite df annSource $ \df ps -> - suggestImportDisambiguation df text ps diag - , rewrite df annSource $ \_ ps -> suggestNewOrExtendImportForClassMethod packageExports ps diag - , suggestFillTypeWildcard diag - , suggestFixConstructorImport text diag - , suggestModuleTypo diag - , suggestReplaceIdentifier text diag - , removeRedundantConstraints text diag - , suggestAddTypeAnnotationToSatisfyContraints text diag - , rewrite df annSource $ \df ps -> suggestConstraint df ps diag - , rewrite df annSource $ \_ ps -> suggestImplicitParameter ps diag - , rewrite df annSource $ \_ ps -> suggestHideShadow ps tcM har diag - ] ++ concat - [ suggestNewDefinition ideOptions pm text diag - ++ suggestNewImport packageExports pm diag - ++ suggestDeleteUnusedBinding pm text diag - ++ suggestExportUnusedTopBinding text pm diag - | Just pm <- [parsedModule] - ] ++ - suggestFillHole diag -- Lowest priority +mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) +mkCA title kind isPreferred diags edit = + InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing + +suggestAction :: CodeActionArgs -> GhcideCodeActions +suggestAction caa = + concat -- Order these suggestions by priority + [ wrap $ suggestSignature True + , wrap suggestExtendImport + , wrap suggestImportDisambiguation + , wrap suggestNewOrExtendImportForClassMethod + , wrap suggestFillTypeWildcard + , wrap suggestFixConstructorImport + , wrap suggestModuleTypo + , wrap suggestReplaceIdentifier + , wrap removeRedundantConstraints + , wrap suggestAddTypeAnnotationToSatisfyContraints + , wrap suggestConstraint + , wrap suggestImplicitParameter + , wrap suggestHideShadow + , wrap suggestNewDefinition + , wrap suggestNewImport + , wrap suggestDeleteUnusedBinding + , wrap suggestExportUnusedTopBinding + , wrap suggestFillHole -- Lowest priority + ] + where + wrap :: ToCodeAction a => a -> GhcideCodeActions + wrap = toCodeAction caa findSigOfDecl :: (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p) findSigOfDecl pred decls = @@ -304,7 +276,7 @@ caRemoveRedundantImports m contents digs ctxDigs uri = caRemoveCtx ++ [caRemoveAll] | otherwise = [] where - removeSingle title tedit diagnostic = mkCA title [diagnostic] WorkspaceEdit{..} where + removeSingle title tedit diagnostic = mkCA title (Just CodeActionQuickFix) Nothing [diagnostic] WorkspaceEdit{..} where _changes = Just $ Map.singleton uri $ List tedit _documentChanges = Nothing removeAll tedit = InR $ CodeAction{..} where @@ -504,7 +476,7 @@ data ExportsAs = ExportName | ExportPattern | ExportAll getLocatedRange :: Located a -> Maybe Range getLocatedRange = srcSpanToRange . getLoc -suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])] +suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)] suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..} -- Foo.hs:4:1: warning: [-Wunused-top-binds] Defined but not used: ‘f’ -- Foo.hs:5:1: warning: [-Wunused-top-binds] Defined but not used: type constructor or class ‘F’ @@ -522,7 +494,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul , Just needComma <- needsComma source <$> hsmodExports , let exportName = (if needComma then "," else "") <> printExport exportType name insertPos = pos {_character = pred $ _character pos} - = [("Export ‘" <> name <> "’", [TextEdit (Range insertPos insertPos) exportName])] + = [("Export ‘" <> name <> "’", TextEdit (Range insertPos insertPos) exportName)] | otherwise = [] where -- we get the last export and the closing bracket and check for comma in that range @@ -669,7 +641,7 @@ newDefinitionAction IdeOptions{..} parsedModule Range{_start} name typ ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}} = parsedModule -suggestFillTypeWildcard :: Diagnostic -> [(T.Text, [TextEdit])] +suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)] suggestFillTypeWildcard Diagnostic{_range=_range,..} -- Foo.hs:3:8: error: -- * Found type wildcard `_' standing for `p -> p1 -> p' @@ -677,10 +649,10 @@ suggestFillTypeWildcard Diagnostic{_range=_range,..} | "Found type wildcard" `T.isInfixOf` _message , " standing for " `T.isInfixOf` _message , typeSignature <- extractWildCardTypeSignature _message - = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])] + = [("Use type signature: ‘" <> typeSignature <> "’", TextEdit _range typeSignature)] | otherwise = [] -suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])] +suggestModuleTypo :: Diagnostic -> [(T.Text, TextEdit)] suggestModuleTypo Diagnostic{_range=_range,..} -- src/Development/IDE/Core/Compile.hs:58:1: error: -- Could not find module ‘Data.Cha’ @@ -688,11 +660,11 @@ suggestModuleTypo Diagnostic{_range=_range,..} | "Could not find module" `T.isInfixOf` _message , "Perhaps you meant" `T.isInfixOf` _message = let findSuggestedModules = map (head . T.words) . drop 2 . T.lines - proposeModule mod = ("replace with " <> mod, [TextEdit _range mod]) + proposeModule mod = ("replace with " <> mod, TextEdit _range mod) in map proposeModule $ nubOrd $ findSuggestedModules _message | otherwise = [] -suggestFillHole :: Diagnostic -> [(T.Text, [TextEdit])] +suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] suggestFillHole Diagnostic{_range=_range,..} | Just holeName <- extractHoleName _message , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) @@ -703,7 +675,7 @@ suggestFillHole Diagnostic{_range=_range,..} extractHoleName = fmap head . flip matchRegexUnifySpaces "Found hole: ([^ ]*)" proposeHoleFit holeName parenthise name = ( "replace " <> holeName <> " with " <> name - , [TextEdit _range $ if parenthise then parens name else name]) + , TextEdit _range $ if parenthise then parens name else name) parens x = "(" <> x <> ")" processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text]) @@ -766,7 +738,7 @@ getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of indentation :: T.Text -> Int indentation = T.length . T.takeWhile isSpace -suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])] +suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message @@ -785,7 +757,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_ Just decl <- findImportDeclByRange decls range, Just ident <- lookupExportMap binding mod = [ ( "Add " <> renderImportStyle importStyle <> " to the import list of " <> mod - , [uncurry extendImport (unImportStyle importStyle) decl] + , uncurry extendImport (unImportStyle importStyle) decl ) | importStyle <- NE.toList $ importStyles ident ] @@ -955,8 +927,8 @@ disambiguateSymbol pm Diagnostic {..} (T.unpack -> symbol) = \case findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs) findImportDeclByRange xs range = find (\(L l _)-> srcSpanToRange l == Just range) xs -suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] -suggestFixConstructorImport _ Diagnostic{_range=_range,..} +suggestFixConstructorImport :: Diagnostic -> [(T.Text, TextEdit)] +suggestFixConstructorImport Diagnostic{_range=_range,..} -- ‘Success’ is a data constructor of ‘Result’ -- To import it use -- import Data.Aeson.Types( Result( Success ) ) @@ -966,16 +938,16 @@ suggestFixConstructorImport _ Diagnostic{_range=_range,..} matchRegexUnifySpaces _message "‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use" = let fixedImport = typ <> "(" <> constructor <> ")" - in [("Fix import of " <> fixedImport, [TextEdit _range fixedImport])] + in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] -- | Suggests a constraint for a declaration for which a constraint is missing. -suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])] +suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] suggestConstraint df parsedModule diag@Diagnostic {..} | Just missingConstraint <- findMissingConstraint _message = let codeAction = if _message =~ ("the type signature for:" :: String) then suggestFunctionConstraint df parsedModule else suggestInstanceConstraint df parsedModule - in map (second (:[])) $ codeAction diag missingConstraint + in codeAction diag missingConstraint | otherwise = [] where findMissingConstraint :: T.Text -> Maybe T.Text @@ -1031,14 +1003,14 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing suggestImplicitParameter :: ParsedSource -> Diagnostic -> - [(T.Text, [Rewrite])] + [(T.Text, Rewrite)] suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _range} | Just [implicitT] <- matchRegexUnifySpaces _message "Unbound implicit parameter \\(([^:]+::.+)\\) arising", Just (L _ (ValD _ FunBind {fun_id = L _ funId})) <- findDeclContainingLoc (_start _range) hsmodDecls, Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}}) <- findSigOfDecl (== funId) hsmodDecls = [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId) - , [appendConstraint (T.unpack implicitT) hsib_body])] + , appendConstraint (T.unpack implicitT) hsib_body)] | otherwise = [] findTypeSignatureName :: T.Text -> Maybe T.Text @@ -1086,7 +1058,7 @@ suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing <> "` to the context of the type signature for `" <> typeSignatureName <> "`" -- | Suggests the removal of a redundant constraint for a type signature. -removeRedundantConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] +removeRedundantConstraints :: Maybe T.Text -> Diagnostic -> [(T.Text, TextEdit)] removeRedundantConstraints mContents Diagnostic{..} -- • Redundant constraint: Eq a -- • In the type signature for: @@ -1108,7 +1080,7 @@ removeRedundantConstraints mContents Diagnostic{..} endOfConstraint = Position typeSignatureLine $ typeSignatureFirstChar + T.length (constraints <> " => ") range = Range startOfConstraint endOfConstraint - in [(actionTitle redundantConstraintList typeSignatureName, [TextEdit range newConstraints])] + in [(actionTitle redundantConstraintList typeSignatureName, TextEdit range newConstraints)] | otherwise = [] where parseConstraints :: T.Text -> [T.Text] @@ -1197,7 +1169,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message ] <> maybeToList (("Import " <> moduleNameText,) <$> fmap pure (newImportAll (T.unpack moduleNameText) ps)) -suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])] +suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)] suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg @@ -1217,7 +1189,7 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule , insertPos <- Position insertLine 0 , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" - = [(imp, [TextEdit (Range insertPos insertPos) (imp <> "\n")]) + = [(imp, TextEdit (Range insertPos insertPos) (imp <> "\n")) | imp <- sort $ constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions ] suggestNewImport _ _ _ = [] diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs new file mode 100644 index 0000000000..0481f42386 --- /dev/null +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Development.IDE.Plugin.CodeAction.Args + ( module Development.IDE.Plugin.CodeAction.Args, + ) +where + +import Control.Lens (alaf) +import Data.Monoid (Ap (..)) +import qualified Data.Text as T +import Development.IDE (Diagnostic, + HieAstResult, + TcModuleResult) +import Development.IDE.GHC.Compat (DynFlags, + ParsedModule, + ParsedSource) +import Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite, + rewriteToEdit) +import Development.IDE.Plugin.TypeLenses (GlobalBindingTypeSigsResult) +import Development.IDE.Spans.LocalBindings (Bindings) +import Development.IDE.Types.Exports (ExportsMap) +import Development.IDE.Types.Options (IdeOptions) +import Language.LSP.Types (CodeActionKind (CodeActionQuickFix), + TextEdit) +import Retrie (Annotated (astA)) +import Retrie.ExactPrint (annsA) + +-- | A compact representation of 'Language.LSP.Types.CodeAction's +type GhcideCodeActions = [(T.Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])] + +class ToTextEdit a where + toTextEdit :: CodeActionArgs -> a -> [TextEdit] + +instance ToTextEdit TextEdit where + toTextEdit _ = pure + +instance ToTextEdit Rewrite where + toTextEdit CodeActionArgs {..} rw + | Just df <- caaDf, + Just ps <- caaAnnSource, + Right x <- rewriteToEdit df (annsA ps) rw = + x + | otherwise = [] + +instance ToTextEdit a => ToTextEdit [a] where + toTextEdit caa = foldMap (toTextEdit caa) + +instance ToTextEdit a => ToTextEdit (Maybe a) where + toTextEdit caa = maybe [] (toTextEdit caa) + +instance (ToTextEdit a, ToTextEdit b) => ToTextEdit (Either a b) where + toTextEdit caa = either (toTextEdit caa) (toTextEdit caa) + +data CodeActionArgs = CodeActionArgs + { caaExportsMap :: ExportsMap, + caaIdeOptions :: IdeOptions, + caaParsedModule :: Maybe ParsedModule, + caaContents :: Maybe T.Text, + caaDf :: Maybe DynFlags, + caaAnnSource :: Maybe (Annotated ParsedSource), + caaTmr :: Maybe TcModuleResult, + caaHar :: Maybe HieAstResult, + caaBindings :: Maybe Bindings, + caaGblSigs :: Maybe GlobalBindingTypeSigsResult, + caaDiagnostics :: Diagnostic + } + +rewrite :: + Maybe DynFlags -> + Maybe (Annotated ParsedSource) -> + [(T.Text, [Rewrite])] -> + [(T.Text, [TextEdit])] +rewrite (Just df) (Just ps) r + | Right edit <- + (traverse . traverse) + (alaf Ap foldMap (rewriteToEdit df (annsA ps))) + r = + edit +rewrite _ _ _ = [] + +------------------------------------------------------------------------------------------------- + +-- | Given 'CodeActionArgs', @a@ can be converted into the representation of code actions. +-- This class is designed to package functions that produce code actions in "Development.IDE.Plugin.CodeAction". +-- +-- For each field @fld@ of 'CodeActionArgs', we make +-- +-- @@ +-- instance ToCodeAction r => ToCodeAction (fld -> r) +-- @@ +-- +-- where we take the value of @fld@ from 'CodeActionArgs' and then feed it into @(fld -> r)@. +-- If @fld@ is @Maybe a@, we make +-- +-- @@ +-- instance ToCodeAction r => ToCodeAction (Maybe a -> r) +-- instance ToCodeAction r => ToCodeAction (a -> r) +-- @@ +class ToCodeAction a where + toCodeAction :: CodeActionArgs -> a -> GhcideCodeActions + +instance ToCodeAction a => ToCodeAction [a] where + toCodeAction caa = foldMap (toCodeAction caa) + +instance ToCodeAction a => ToCodeAction (Maybe a) where + toCodeAction caa = maybe [] (toCodeAction caa) + +instance ToTextEdit a => ToCodeAction (T.Text, a) where + toCodeAction caa (title, te) = [(title, Just CodeActionQuickFix, Nothing, toTextEdit caa te)] + +instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, a) where + toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)] + +instance ToTextEdit a => ToCodeAction (T.Text, Bool, a) where + toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)] + +instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, Bool, a) where + toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)] + +------------------------------------------------------------------------------------------------- + +-- | Complement: we can obtain 'ParsedSource' from 'caaAnnSource' +instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where + toCodeAction caa@CodeActionArgs {caaAnnSource = Just ps} f = toCodeAction caa $ f $ astA ps + toCodeAction _ _ = [] + +-- The following boilerplate code can be generated by 'mkInstances'. +-- Now it was commented out with generated code spliced out, +-- because fields of 'CodeActionArgs' don't change frequently. +-- +-- mkInstances :: Name -> DecsQ +-- mkInstances tyConName = +-- reify tyConName >>= \case +-- (TyConI (DataD _ _ _ _ [RecC dataConName tys] _)) -> concat <$> mapM (genForVar dataConName) tys +-- _ -> error "unsupported" +-- where +-- clsType = conT $ mkName "ToCodeAction" +-- methodName = mkName "toCodeAction" +-- tempType = varT $ mkName "r" +-- commonFun dataConName fieldName = +-- funD +-- methodName +-- [ clause +-- [ mkName "caa" +-- `asP` recP +-- dataConName +-- [fieldPat fieldName $ varP (mkName "x")] +-- , varP (mkName "f") +-- ] +-- (normalB [|$(varE methodName) caa $ f x|]) +-- [] +-- ] +-- genForVar dataConName (fieldName, _, ty@(AppT (ConT _maybe) ty')) +-- | _maybe == ''Maybe = +-- do +-- withMaybe <- +-- instanceD +-- (cxt [clsType `appT` tempType]) +-- (clsType `appT` ((arrowT `appT` pure ty) `appT` tempType)) +-- [commonFun dataConName fieldName] +-- withoutMaybe <- +-- instanceD +-- (cxt [clsType `appT` tempType]) +-- (clsType `appT` ((arrowT `appT` pure ty') `appT` tempType)) +-- [ funD +-- methodName +-- [ clause +-- [ mkName "caa" +-- `asP` recP +-- dataConName +-- [fieldPat fieldName $ conP 'Just [varP (mkName "x")]] +-- , varP (mkName "f") +-- ] +-- (normalB [|$(varE methodName) caa $ f x|]) +-- [] +-- , clause [wildP, wildP] (normalB [|[]|]) [] +-- ] +-- ] +-- pure [withMaybe, withoutMaybe] +-- genForVar dataConName (fieldName, _, ty) = +-- pure +-- <$> instanceD +-- (cxt [clsType `appT` tempType]) +-- (clsType `appT` ((arrowT `appT` pure ty) `appT` tempType)) +-- [commonFun dataConName fieldName] + +instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where + toCodeAction caa@CodeActionArgs {caaExportsMap = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (IdeOptions -> r) where + toCodeAction caa@CodeActionArgs {caaIdeOptions = x} f = + toCodeAction caa $ f x + +instance + ToCodeAction r => + ToCodeAction (Maybe ParsedModule -> r) + where + toCodeAction caa@CodeActionArgs {caaParsedModule = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (ParsedModule -> r) where + toCodeAction caa@CodeActionArgs {caaParsedModule = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance ToCodeAction r => ToCodeAction (Maybe T.Text -> r) where + toCodeAction caa@CodeActionArgs {caaContents = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (T.Text -> r) where + toCodeAction caa@CodeActionArgs {caaContents = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where + toCodeAction caa@CodeActionArgs {caaDf = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (DynFlags -> r) where + toCodeAction caa@CodeActionArgs {caaDf = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance + ToCodeAction r => + ToCodeAction (Maybe (Annotated ParsedSource) -> r) + where + toCodeAction caa@CodeActionArgs {caaAnnSource = x} f = + toCodeAction caa $ f x + +instance + ToCodeAction r => + ToCodeAction (Annotated ParsedSource -> r) + where + toCodeAction caa@CodeActionArgs {caaAnnSource = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance + ToCodeAction r => + ToCodeAction (Maybe TcModuleResult -> r) + where + toCodeAction caa@CodeActionArgs {caaTmr = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (TcModuleResult -> r) where + toCodeAction caa@CodeActionArgs {caaTmr = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance + ToCodeAction r => + ToCodeAction (Maybe HieAstResult -> r) + where + toCodeAction caa@CodeActionArgs {caaHar = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (HieAstResult -> r) where + toCodeAction caa@CodeActionArgs {caaHar = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance ToCodeAction r => ToCodeAction (Maybe Bindings -> r) where + toCodeAction caa@CodeActionArgs {caaBindings = x} f = + toCodeAction caa $ f x + +instance ToCodeAction r => ToCodeAction (Bindings -> r) where + toCodeAction caa@CodeActionArgs {caaBindings = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance + ToCodeAction r => + ToCodeAction (Maybe GlobalBindingTypeSigsResult -> r) + where + toCodeAction caa@CodeActionArgs {caaGblSigs = x} f = + toCodeAction caa $ f x + +instance + ToCodeAction r => + ToCodeAction (GlobalBindingTypeSigsResult -> r) + where + toCodeAction caa@CodeActionArgs {caaGblSigs = Just x} f = + toCodeAction caa $ f x + toCodeAction _ _ = [] + +instance ToCodeAction r => ToCodeAction (Diagnostic -> r) where + toCodeAction caa@CodeActionArgs {caaDiagnostics = x} f = + toCodeAction caa $ f x + +-------------------------------------------------------------------------------------------------