Tease apart the custom SYB from ExactPrint

ghcide/ghcide.cabal

@@ -140,6 +140,7 @@ library
         include
     exposed-modules:
         Control.Concurrent.Strict
+        Generics.SYB.GHC
         Development.IDE
         Development.IDE.Main
         Development.IDE.Core.Actions

ghcide/src/Development/IDE/GHC/ExactPrint.hs

@@ -28,9 +28,7 @@ module Development.IDE.GHC.ExactPrint
       TransformT,
       Anns,
       Annotate,
-      mkBindListT,
       setPrecedingLinesT,
-      everywhereM',
     )
 where
 
@@ -56,6 +54,7 @@ import Development.Shake (RuleResult, Rules)
 import Development.Shake.Classes
 import qualified GHC.Generics as GHC
 import Generics.SYB
+import Generics.SYB.GHC
 import Ide.PluginUtils
 import Language.Haskell.GHC.ExactPrint
 import Language.Haskell.GHC.ExactPrint.Parsers
@@ -67,8 +66,7 @@ import Parser (parseIdentifier)
 import Data.Traversable (for)
 import Data.Foldable (Foldable(fold))
 import Data.Bool (bool)
-import Data.Monoid (All(All), Any(Any), getAll)
-import Data.Functor.Compose (Compose(Compose))
+import Data.Monoid (All(All), getAll)
 import Control.Arrow
 
 
@@ -328,21 +326,6 @@ graftWithM dst trans = Graft $ \dflags a -> do
         )
         a
 
--- | A generic query intended to be used for calling 'smallestM' and
--- 'largestM'. If the current node is a 'Located', returns whether or not the
--- given 'SrcSpan' is a subspan. For all other nodes, returns 'Nothing', which
--- indicates uncertainty. The search strategy in 'smallestM' et al. will
--- continue searching uncertain nodes.
-genericIsSubspan ::
-    forall ast.
-    Typeable ast =>
-    -- | The type of nodes we'd like to consider.
-    Proxy (Located ast) ->
-    SrcSpan ->
-    GenericQ (Maybe Bool)
-genericIsSubspan _ dst = mkQ Nothing $ \case
-  (L span _ :: Located ast) -> Just $ dst `isSubspanOf` span
-
 -- | Run the given transformation only on the smallest node in the tree that
 -- contains the 'SrcSpan'.
 genericGraftWithSmallestM ::
@@ -370,15 +353,6 @@ genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->
     largestM (genericIsSubspan proxy dst) (trans dflags)
 
 
--- | Lift a function that replaces a value with several values into a generic
--- function. The result doesn't perform any searching, so should be driven via
--- 'everywhereM' or friends.
---
--- The 'Int' argument is the index in the list being bound.
-mkBindListT :: forall b m. (Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m
-mkBindListT f = mkM $ fmap join . traverse (uncurry f) . zip [0..]
-
-
 graftDecls ::
     forall a.
     (HasDecls a) =>
@@ -432,12 +406,6 @@ graftDeclsWithM dst toDecls = Graft $ \dflags a -> do
     modifyDeclsT (fmap DL.toList . go) a
 
 
-everywhereM' :: forall m. Monad m => GenericM m -> GenericM m
-everywhereM' f = go
-    where
-        go :: GenericM m
-        go = gmapM go <=< f
-
 class (Data ast, Outputable ast) => ASTElement ast where
     parseAST :: Parser (Located ast)
     maybeParensAST :: Located ast -> Located ast
@@ -547,76 +515,3 @@ render dflags = showSDoc dflags . ppr
 parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs
 parenthesize = parenthesizeHsExpr appPrec
 
-
-------------------------------------------------------------------------------
--- Custom SYB machinery
-------------------------------------------------------------------------------
-
--- | Generic monadic transformations that return side-channel data.
-type GenericMQ r m = forall a. Data a => a -> m (r, a)
-
-------------------------------------------------------------------------------
--- | Apply the given 'GenericM' at all every node whose children fail the
--- 'GenericQ', but which passes the query itself.
---
--- The query must be a monotonic function when it returns 'Just'. That is, if
--- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
--- is the True-to-false edge of the query that triggers the transformation.
---
--- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
--- with data nodes, so for any given node we can only definitely return an
--- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
--- used.
-smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
-smallestM q f = fmap snd . go
-  where
-    go :: GenericMQ Any m
-    go x = do
-      case q x of
-        Nothing -> gmapMQ go x
-        Just True -> do
-          it@(r, x') <- gmapMQ go x
-          case r of
-            Any True -> pure it
-            Any False -> fmap (Any True,) $ f x'
-        Just False -> pure (mempty, x)
-
-------------------------------------------------------------------------------
--- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
--- don't descend into children if the query matches. Because this traversal is
--- root-first, this policy will find the largest subtrees for which the query
--- holds true.
---
--- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
--- with data nodes, so for any given node we can only definitely return an
--- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
--- used.
-largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
-largestM q f = go
-  where
-    go :: GenericM m
-    go x = do
-      case q x of
-        Just True -> f x
-        Just False -> pure x
-        Nothing -> gmapM go x
-
-newtype MonadicQuery r m a = MonadicQuery
-  { runMonadicQuery :: m (r, a)
-  }
-  deriving stock (Functor)
-  deriving Applicative via Compose m ((,) r)
-
-
-------------------------------------------------------------------------------
--- | Like 'gmapM', but also returns side-channel data.
-gmapMQ ::
-    forall f r a. (Monoid r, Data a, Applicative f) =>
-    (forall d. Data d => d -> f (r, d)) ->
-    a ->
-    f (r, a)
-gmapMQ f = runMonadicQuery . gfoldl k pure
-  where
-    k :: Data d => MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
-    k c x = c <*> MonadicQuery (f x)
-

ghcide/src/Generics/SYB/GHC.hs

@@ -0,0 +1,125 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE RankNTypes  #-}
+
+-- | Custom SYB traversals explicitly designed for operating over the GHC AST.
+module Generics.SYB.GHC
+    ( genericIsSubspan,
+      mkBindListT,
+      everywhereM',
+      smallestM,
+      largestM
+    ) where
+
+import Control.Monad
+import Data.Functor.Compose (Compose(Compose))
+import Data.Monoid (Any(Any))
+import Development.IDE.GHC.Compat
+import Development.Shake.Classes
+import Generics.SYB
+
+
+-- | A generic query intended to be used for calling 'smallestM' and
+-- 'largestM'. If the current node is a 'Located', returns whether or not the
+-- given 'SrcSpan' is a subspan. For all other nodes, returns 'Nothing', which
+-- indicates uncertainty. The search strategy in 'smallestM' et al. will
+-- continue searching uncertain nodes.
+genericIsSubspan ::
+    forall ast.
+    Typeable ast =>
+    -- | The type of nodes we'd like to consider.
+    Proxy (Located ast) ->
+    SrcSpan ->
+    GenericQ (Maybe Bool)
+genericIsSubspan _ dst = mkQ Nothing $ \case
+  (L span _ :: Located ast) -> Just $ dst `isSubspanOf` span
+
+
+-- | Lift a function that replaces a value with several values into a generic
+-- function. The result doesn't perform any searching, so should be driven via
+-- 'everywhereM' or friends.
+--
+-- The 'Int' argument is the index in the list being bound.
+mkBindListT :: forall b m. (Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m
+mkBindListT f = mkM $ fmap join . traverse (uncurry f) . zip [0..]
+
+
+-- | Apply a monadic transformation everywhere in a top-down manner.
+everywhereM' :: forall m. Monad m => GenericM m -> GenericM m
+everywhereM' f = go
+    where
+        go :: GenericM m
+        go = gmapM go <=< f
+
+
+------------------------------------------------------------------------------
+-- Custom SYB machinery
+------------------------------------------------------------------------------
+
+-- | Generic monadic transformations that return side-channel data.
+type GenericMQ r m = forall a. Data a => a -> m (r, a)
+
+------------------------------------------------------------------------------
+-- | Apply the given 'GenericM' at all every node whose children fail the
+-- 'GenericQ', but which passes the query itself.
+--
+-- The query must be a monotonic function when it returns 'Just'. That is, if
+-- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
+-- is the True-to-false edge of the query that triggers the transformation.
+--
+-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
+-- with data nodes, so for any given node we can only definitely return an
+-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
+-- used.
+smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
+smallestM q f = fmap snd . go
+  where
+    go :: GenericMQ Any m
+    go x = do
+      case q x of
+        Nothing -> gmapMQ go x
+        Just True -> do
+          it@(r, x') <- gmapMQ go x
+          case r of
+            Any True -> pure it
+            Any False -> fmap (Any True,) $ f x'
+        Just False -> pure (mempty, x)
+
+------------------------------------------------------------------------------
+-- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
+-- don't descend into children if the query matches. Because this traversal is
+-- root-first, this policy will find the largest subtrees for which the query
+-- holds true.
+--
+-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
+-- with data nodes, so for any given node we can only definitely return an
+-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
+-- used.
+largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
+largestM q f = go
+  where
+    go :: GenericM m
+    go x = do
+      case q x of
+        Just True -> f x
+        Just False -> pure x
+        Nothing -> gmapM go x
+
+newtype MonadicQuery r m a = MonadicQuery
+  { runMonadicQuery :: m (r, a)
+  }
+  deriving stock (Functor)
+  deriving Applicative via Compose m ((,) r)
+
+
+------------------------------------------------------------------------------
+-- | Like 'gmapM', but also returns side-channel data.
+gmapMQ ::
+    forall f r a. (Monoid r, Data a, Applicative f) =>
+    (forall d. Data d => d -> f (r, d)) ->
+    a ->
+    f (r, a)
+gmapMQ f = runMonadicQuery . gfoldl k pure
+  where
+    k :: Data d => MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
+    k c x = c <*> MonadicQuery (f x)
+

plugins/hls-tactics-plugin/src/Wingman/Plugin.hs

@@ -20,6 +20,7 @@ import           Development.IDE.Core.Shake (IdeState (..))
 import           Development.IDE.Core.UseStale (Tracked, TrackedStale(..), unTrack, mapAgeFrom, unsafeMkCurrent)
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.ExactPrint
+import           Generics.SYB.GHC
 import           Ide.Types
 import           Language.LSP.Server
 import           Language.LSP.Types