Wingman: Fix TODO(sandy) when performing subsequent actions

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

@@ -93,7 +93,8 @@ runContinuation plId cont state (fc, b) = do
               , _xdata =  Nothing
               } ) $ do
       env@LspEnv{..} <- buildEnv state plId fc
-      let stale a = runStaleIde "runContinuation" state (fc_nfp le_fileContext) a
+      nfp <- getNfp $ fc_uri le_fileContext
+      let stale a = runStaleIde "runContinuation" state nfp a
       args <- fetchTargetArgs @a env
       res <- c_runCommand cont env args fc b
 
@@ -151,7 +152,8 @@ buildEnv
     -> MaybeT (LspM Plugin.Config) LspEnv
 buildEnv state plId fc = do
   cfg <- lift $ getTacticConfig plId
-  dflags <- mapMaybeT liftIO $ getIdeDynflags state $ fc_nfp fc
+  nfp <- getNfp $ fc_uri fc
+  dflags <- mapMaybeT liftIO $ getIdeDynflags state nfp
   pure $ LspEnv
     { le_ideState = state
     , le_pluginId = plId
@@ -173,22 +175,19 @@ codeActionProvider
        )
     -> PluginMethodHandler IdeState TextDocumentCodeAction
 codeActionProvider sort k state plId
-                   (CodeActionParams _ _ (TextDocumentIdentifier uri) range _)
-  | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do
-      fromMaybeT (Right $ List []) $ do
-        let fc = FileContext
-                   { fc_uri   = uri
-                   , fc_nfp   = nfp
-                   , fc_range = Just $ unsafeMkCurrent range
-                   }
-        env <- buildEnv state plId fc
-        args <- fetchTargetArgs @target env
-        actions <- k env args
-        pure
-          $ Right
-          $ List
-          $ fmap (InR . uncurry (makeCodeAction plId fc sort)) actions
-codeActionProvider _ _ _ _ _ = pure $ Right $ List []
+                   (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = do
+  fromMaybeT (Right $ List []) $ do
+    let fc = FileContext
+                { fc_uri   = uri
+                , fc_range = Just $ unsafeMkCurrent range
+                }
+    env <- buildEnv state plId fc
+    args <- fetchTargetArgs @target env
+    actions <- k env args
+    pure
+      $ Right
+      $ List
+      $ fmap (InR . uncurry (makeCodeAction plId fc sort)) actions
 
 
 ------------------------------------------------------------------------------
@@ -203,12 +202,10 @@ codeLensProvider
       )
     -> PluginMethodHandler IdeState TextDocumentCodeLens
 codeLensProvider sort k state plId
-                 (CodeLensParams _ _ (TextDocumentIdentifier uri))
-  | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do
+                 (CodeLensParams _ _ (TextDocumentIdentifier uri)) = do
       fromMaybeT (Right $ List []) $ do
         let fc = FileContext
                    { fc_uri   = uri
-                   , fc_nfp   = nfp
                    , fc_range = Nothing
                    }
         env <- buildEnv state plId fc
@@ -218,7 +215,6 @@ codeLensProvider sort k state plId
           $ Right
           $ List
           $ fmap (uncurry3 $ makeCodeLens plId sort fc) actions
-codeLensProvider _ _ _ _ _ = pure $ Right $ List []
 
 
 ------------------------------------------------------------------------------

plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/TacticActions.hs

@@ -45,9 +45,10 @@ makeTacticInteraction cmd =
               }
     )
     $ \LspEnv{..} HoleJudgment{..} FileContext{..} var_name -> do
-        let stale a = runStaleIde "tacticCmd" le_ideState fc_nfp a
+        nfp <- getNfp fc_uri
+        let stale a = runStaleIde "tacticCmd" le_ideState nfp a
 
-        let span = fmap (rangeToRealSrcSpan (fromNormalizedFilePath fc_nfp)) hj_range
+        let span = fmap (rangeToRealSrcSpan (fromNormalizedFilePath nfp)) hj_range
         TrackedStale _ pmmap <- mapMaybeT liftIO $ stale GetAnnotatedParsedSource
         pm_span <- liftMaybe $ mapAgeFrom pmmap span
         IdeOptions{optTesting = IdeTesting isTesting} <-

plugins/hls-tactics-plugin/src/Wingman/AbstractLSP/Types.hs

@@ -121,19 +121,13 @@ data Continuation sort target payload = Continuation
 -- | What file are we looking at, and what bit of it?
 data FileContext = FileContext
   { fc_uri      :: Uri
-  , fc_nfp      :: NormalizedFilePath
   , fc_range    :: Maybe (Tracked 'Current Range)
     -- ^ For code actions, this is 'Just'. For code lenses, you'll get
     -- a 'Nothing' in the request, and a 'Just' in the response.
   }
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (A.ToJSON, A.FromJSON)
 
-deriving anyclass instance A.ToJSON NormalizedFilePath
-deriving anyclass instance A.ToJSON NormalizedUri
-deriving anyclass instance A.FromJSON NormalizedFilePath
-deriving anyclass instance A.FromJSON NormalizedUri
-
 
 ------------------------------------------------------------------------------
 -- | Everything we need to resolve continuations.
@@ -162,10 +156,14 @@ class IsTarget t where
 data HoleTarget = HoleTarget
   deriving stock (Eq, Ord, Show, Enum, Bounded)
 
+getNfp :: Applicative m => Uri -> MaybeT m NormalizedFilePath
+getNfp = MaybeT . pure . uriToNormalizedFilePath . toNormalizedUri
+
 instance IsTarget HoleTarget where
   type TargetArgs HoleTarget = HoleJudgment
   fetchTargetArgs LspEnv{..} = do
     let FileContext{..} = le_fileContext
     range <- MaybeT $ pure fc_range
-    mapMaybeT liftIO $ judgementForHole le_ideState fc_nfp range le_config
+    nfp <- getNfp fc_uri
+    mapMaybeT liftIO $ judgementForHole le_ideState nfp range le_config
 

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

@@ -50,13 +50,14 @@ emptyCaseInteraction = Interaction $
   Continuation @EmptyCaseT @EmptyCaseT @WorkspaceEdit EmptyCaseT
     (SynthesizeCodeLens $ \LspEnv{..} _ -> do
       let FileContext{..} = le_fileContext
+      nfp <- getNfp fc_uri
 
-      let stale a = runStaleIde "codeLensProvider" le_ideState fc_nfp a
+      let stale a = runStaleIde "codeLensProvider" le_ideState nfp a
 
       ccs <- lift getClientCapabilities
       TrackedStale pm _ <- mapMaybeT liftIO $ stale GetAnnotatedParsedSource
       TrackedStale binds bind_map <- mapMaybeT liftIO $ stale GetBindings
-      holes <- mapMaybeT liftIO $ emptyCaseScrutinees le_ideState fc_nfp
+      holes <- mapMaybeT liftIO $ emptyCaseScrutinees le_ideState nfp
 
       for holes $ \(ss, ty) -> do
         binds_ss <- liftMaybe $ mapAgeFrom bind_map ss