Expand and remove TH, Remove the existential type

ghcide/ghcide.cabal

@@ -101,8 +101,7 @@ library
         cryptohash-sha1 >=0.11.100 && <0.12,
         hie-bios >= 0.7.1 && < 0.8.0,
         implicit-hie-cradle >= 0.3.0.2 && < 0.4,
-        base16-bytestring >=0.1.1 && <0.2,
-        template-haskell
+        base16-bytestring >=0.1.1 && <0.2
     if os(windows)
       build-depends:
         Win32
@@ -192,7 +191,6 @@ library
         Development.IDE.LSP.Notifications
         Development.IDE.Plugin.CodeAction.PositionIndexed
         Development.IDE.Plugin.CodeAction.Args
-        Development.IDE.Plugin.CodeAction.Args.TH
         Development.IDE.Plugin.Completions.Logic
         Development.IDE.Session.VersionCheck
         Development.IDE.Types.Action

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -127,8 +127,7 @@ mkCA title diags edit =
 
 suggestAction :: CodeActionArgs -> [(T.Text, [TextEdit])]
 suggestAction caa =
-    concat $ unwrap caa <$>
-   -- Order these suggestions by priority
+  concat   -- Order these suggestions by priority
     [ wrap $ suggestSignature True
     , wrap suggestExtendImport
     , wrap suggestImportDisambiguation
@@ -148,6 +147,9 @@ suggestAction caa =
     , wrap suggestExportUnusedTopBinding
     , wrap suggestFillHole -- Lowest priority
     ]
+    where
+      wrap :: ToCodeAction a => a -> [(T.Text, [TextEdit])]
+      wrap = toCodeAction caa
 
 findSigOfDecl :: (IdP p -> Bool) -> [LHsDecl p] -> Maybe (Sig p)
 findSigOfDecl pred decls =

ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs

@@ -1,25 +1,27 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE TemplateHaskell           #-}
+{-# LANGUAGE FlexibleInstances #-}
 
-module Development.IDE.Plugin.CodeAction.Args (
-  module Development.IDE.Plugin.CodeAction.Args,
-) where
+module Development.IDE.Plugin.CodeAction.Args
+  ( module Development.IDE.Plugin.CodeAction.Args,
+  )
+where
 
 import           Control.Lens                                 (alaf)
 import           Data.Bifunctor                               (second)
 import           Data.Monoid                                  (Ap (..))
 import qualified Data.Text                                    as T
-import           Development.IDE
-import           Development.IDE.GHC.Compat
-import           Development.IDE.Plugin.CodeAction.Args.TH
-import           Development.IDE.Plugin.CodeAction.ExactPrint
+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                           (TextEdit,
-                                                               type (|?) (..))
+import           Language.LSP.Types                           (TextEdit)
 import           Retrie                                       (Annotated (astA))
 import           Retrie.ExactPrint                            (annsA)
 
@@ -50,55 +52,216 @@ rewrite (Just df) (Just ps) r
     edit
 rewrite _ _ _ = []
 
--- we need this intermediate existential type to encapsulate functions producing code actions into a list
-data SomeAction = forall a. ToCodeAction a => SomeAction a
-
-wrap :: ToCodeAction a => a -> SomeAction
-wrap = SomeAction
-
-unwrap :: CodeActionArgs -> SomeAction -> [(T.Text, [TextEdit])]
-unwrap caa (SomeAction x) = toCodeAction caa x
+-------------------------------------------------------------------------------------------------
 
+-- | 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 -> [(T.Text, [TextEdit])]
 
+-------------------------------------------------------------------------------------------------
+-- Acceptable return types:
 instance ToCodeAction [(T.Text, [TextEdit])] where
   toCodeAction _ = id
 
 instance ToCodeAction [(T.Text, [Rewrite])] where
-  toCodeAction CodeActionArgs{..} = rewrite caaDf caaAnnSource
+  toCodeAction CodeActionArgs {..} = rewrite caaDf caaAnnSource
+
+instance ToCodeAction [(T.Text, [Either TextEdit Rewrite])] where
+  toCodeAction CodeActionArgs {..} r = second (concatMap go) <$> r
+    where
+      go (Left te) = [te]
+      go (Right rw)
+        | Just df <- caaDf,
+          Just ps <- caaAnnSource,
+          Right x <- rewriteToEdit df (annsA ps) rw =
+          x
+        | otherwise = []
+
+-------------------------------------------------------------------------------------------------
 
+-- | 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 caa@CodeActionArgs {caaAnnSource = Just ps} f = toCodeAction caa $ f $ astA ps
   toCodeAction _ _ = []
 
-instance ToCodeAction [(T.Text, [TextEdit |? Rewrite])] where
-  toCodeAction CodeActionArgs{..} r = second (concatMap go) <$> r
-   where
-    go (InL te) = [te]
-    go (InR rw)
-      | Just df <- caaDf
-        , Just ps <- caaAnnSource
-        , Right x <- rewriteToEdit df (annsA ps) rw =
-        x
-      | otherwise = []
-
--- generates instances of 'ToCodeAction',
--- where the pattern is @instance ToCodeAction r => ToCodeAction (field -> r)@, for each field of 'CodeActionArgs'.
--- therefore functions to produce code actions in CodeAction.hs can be wrapped into 'SomeAction' without modification.
--- for types applied to 'Maybe', it generates to instances: for example,
---
--- @
--- instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where
---   toCodeAction caa@CodeActionArgs {caaDf = x} f = toCodeAction caa $ f x
--- @
---
--- and
+-- 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.
 --
--- @
--- instance ToCodeAction r => ToCodeAction (DynFlags -> r) where
---   toCodeAction caa@CodeActionArgs {caaDf = Just x} f = toCodeAction caa $ f x
---   toCodeAction _ _  = []
--- @
--- will be derived from 'caaDf'.
-mkInstances ''CodeActionArgs
+-- 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
+
+-------------------------------------------------------------------------------------------------