confusing

Author: Santiago Weight

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

@@ -102,6 +102,7 @@ import           GHC                                     (EpAnn (..),
 import           GHC.Parser.Annotation                   (AnnContext (..),
                                                           DeltaPos (SameLine),
                                                           EpaLocation (EpaDelta))
+import Debug.Trace (traceShowM)
 #endif
 
 ------------------------------------------------------------------------------
@@ -188,8 +189,10 @@ transform ::
     Either String WorkspaceEdit
 transform dflags ccs uri f a = do
     let src = printA a
+    traceShowM src
     a' <- transformA a $ runGraft f dflags
     let res = printA a'
+    traceShowM res
     pure $ diffText ccs (uri, T.pack src) (T.pack res) IncludeDeletions
 
 ------------------------------------------------------------------------------

plugins/hls-refine-destruct-plugin/src/Wingman/Debug.hs

@@ -61,5 +61,5 @@ traceShowId = Debug.Trace.traceShowId
 #else
 traceM _ = pure ()
 trace _ = id
-traceShowId = id
+traceShowId = Debug.Trace.traceShowId
 #endif

plugins/hls-refine-destruct-plugin/src/Wingman/EmptyCase.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeFamilies      #-}
 
 {-# LANGUAGE NoMonoLocalBinds  #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Wingman.EmptyCase where
 
@@ -33,9 +34,12 @@ import           Wingman.CodeGen (destructionFor)
 import           Wingman.GHC
 import           Wingman.Judgements
 import           Wingman.LanguageServer
-import           Wingman.Types
-import GHC (LocatedA, SrcSpanAnnA, SrcSpanAnn' (..))
+import           Wingman.Types hiding (traceShowId)
+import GHC (LocatedA, SrcSpanAnnA, SrcSpanAnn' (..), EpAnn (..))
 import GHC.Hs (LocatedL)
+import Debug.Trace
+import GHC.Plugins (generatedSrcSpan)
+import Language.Haskell.GHC.ExactPrint
 
 
 data EmptyCaseT = EmptyCaseT
@@ -70,10 +74,12 @@ emptyCaseInteraction = Interaction $
             destructionFor
               (foldMap (hySingleton . occName . fst) bindings)
               ty
+        traceShowM matches
         edits <- liftMaybe $ hush $
               mkWorkspaceEdits le_dflags ccs fc_uri (unTrack pm) $
                 graftMatchGroup (RealSrcSpan (unTrack ss) Nothing) $
                   noLocA matches
+        traceShowM edits
         pure
           ( range
           , Metadata
@@ -85,6 +91,8 @@ emptyCaseInteraction = Interaction $
     )
     (\ _ _ _ we -> pure $ pure $ RawEdit we)
 
+instance Show (GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))) where
+  show = unsafeRender
 
 scrutinzedType :: EmptyCaseSort Type -> Maybe Type
 scrutinzedType (EmptyCase ty) = pure  ty
@@ -107,6 +115,12 @@ hush (Left _) = Nothing
 hush (Right a) = Just a
 
 
+instance Show (EpAnn AnnListItem) where
+  show = unsafeRender
+
+instance Show (EpAnn EpAnnHsCase) where
+  show = unsafeRender . fmap showAst
+
 ------------------------------------------------------------------------------
 -- | Graft a 'RunTacticResults' into the correct place in an AST. Correctly
 -- deals with top-level holes, in which we might need to fiddle with the
@@ -118,7 +132,7 @@ graftMatchGroup
 graftMatchGroup ss l =
   hoistGraft (runExcept . runExceptString) $ graftExprWithM ss $ \case
     L span (HsCase ext scrut mg) -> do
-      pure $ Just $ L span $ HsCase ext scrut $ mg { mg_alts = l }
+      pure $ Just $ traceShowId $ L span $ HsCase ext scrut $ mg { mg_alts = l }
     L span (HsLamCase ext mg) -> do
       pure $ Just $ L span $ HsLamCase ext $ mg { mg_alts = l }
     (_ :: LHsExpr GhcPs) -> pure Nothing

plugins/hls-refine-destruct-plugin/src/Wingman/LanguageServer.hs

@@ -571,7 +571,7 @@ mkWorkspaceEdits
     -> Graft (Either String) ParsedSource
     -> Either UserFacingMessage WorkspaceEdit
 mkWorkspaceEdits dflags ccs uri pm g = do
-  let response = transform dflags ccs uri g pm
+  let (traceShowId -> response) = transform dflags ccs uri g pm
    in first (InfrastructureError . T.pack) response
 
 

plugins/hls-refine-destruct-plugin/src/Wingman/StaticPlugin.hs

@@ -24,6 +24,13 @@ staticPlugin = mempty
              , staticPlugins = staticPlugins df
 #endif
              }
+#if MIN_VERSION_ghc(9,2,0)
+
+
+  , staticPlugins = []
+#else
+  , staticPlugins = []
+#endif
   }