[bug-fix] file contents provided correctly

Author: Ishmum Jawad Khan

plugins/default/src/Ide/Plugin/Pragmas.hs

@@ -43,36 +43,32 @@ descriptor plId = (defaultPluginDescriptor plId)
 -- Pragma is added to the first line of the Uri.
 -- It is assumed that the pragma name is a valid pragma,
 -- thus, not validated.
-mkPragmaEdit :: Uri -> T.Text -> Maybe ParsedModule -> Maybe WorkspaceEdit
-mkPragmaEdit uri pragmaName mpm = res mpm where
-    pos = J.Position 0 0
-    textEdits pm = J.List
-      [J.TextEdit (endOfModuleHeader pm Nothing)
-                  ("{-# LANGUAGE " <> pragmaName <> " #-}\n")
-      ]
-    res (Just pm) = Just $ J.WorkspaceEdit
-      (Just . H.singleton uri $ textEdits pm)
-      Nothing
-    res Nothing = Nothing
+mkPragmaEdit :: Uri -> T.Text -> Range -> Maybe WorkspaceEdit
+mkPragmaEdit uri pragmaName rng = res where
+    textEdits = J.List [J.TextEdit rng ("{-# LANGUAGE " <> pragmaName <> " #-}\n")]
+    res = Just $ J.WorkspaceEdit (Just . H.singleton uri $ textEdits) Nothing
 
 -- ---------------------------------------------------------------------
 -- | Offer to add a missing Language Pragma to the top of a file.
 -- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.
 codeActionProvider :: CodeActionProvider IdeState
-codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
+codeActionProvider lsp state _plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
     let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath'
     pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile
+    contents <- LSP.getVirtualFileFunc lsp . toNormalizedUri $ docId ^. J.uri
     let dflags = ms_hspp_opts . pm_mod_summary <$> pm
         -- Get all potential Pragmas for all diagnostics.
         pragmas = nubOrd $ concatMap (\d -> genPragma dflags (d ^. J.message)) diags
-    cmds <- mapM (mkCodeAction pm) pragmas
+        text = fmap VFS.virtualFileText contents
+        rng = endOfModuleHeader pm text
+    cmds <- mapM (mkCodeAction rng) pragmas 
     return $ Right $ List cmds
       where
-        mkCodeAction pm pragmaName = do
+        mkCodeAction rng pragmaName = do
           let
-            codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just =<< edit) Nothing
+            codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) edit Nothing
             title = "Add \"" <> pragmaName <> "\""
-            edit = mkPragmaEdit (docId ^. J.uri) pragmaName pm
+            edit = mkPragmaEdit (docId ^. J.uri) pragmaName rng
           return codeAction
 
         genPragma mDynflags target =
@@ -171,14 +167,19 @@ completion lspFuncs _ide complParams = do
 
 -- | Find the first non-blank line before the first of (module name / imports / declarations).
 -- Useful for inserting pragmas.
-endOfModuleHeader :: ParsedModule -> Maybe T.Text -> Range
-endOfModuleHeader pm contents =
-    let mod = unLoc $ pm_parsed_source pm
-        modNameLoc = getLoc <$> hsmodName mod
-        firstImportLoc = getLoc <$> listToMaybe (hsmodImports mod)
-        firstDeclLoc = getLoc <$> listToMaybe (hsmodDecls mod)
-        line = fromMaybe 0 $ firstNonBlankBefore . _line . _start =<< srcSpanToRange =<<
-            modNameLoc <|> firstImportLoc <|> firstDeclLoc
-        firstNonBlankBefore n = (n -) . fromMaybe 0 . findIndex (not . T.null) . reverse . take n . T.lines <$> contents
-        loc = Position line 0
-     in Range loc loc
+endOfModuleHeader :: Maybe ParsedModule -> Maybe T.Text -> Range
+endOfModuleHeader mpm contents =
+    case mpm of 
+      Just pm -> 
+        let mod = unLoc $ pm_parsed_source pm
+            modNameLoc = getLoc <$> hsmodName mod
+            firstImportLoc = getLoc <$> listToMaybe (hsmodImports mod)
+            firstDeclLoc = getLoc <$> listToMaybe (hsmodDecls mod)
+            line = fromMaybe 0 $ firstNonBlankBefore . _line . _start =<< srcSpanToRange =<<
+                modNameLoc <|> firstImportLoc <|> firstDeclLoc
+            firstNonBlankBefore n = findIndex (not . T.null) . take n . T.lines =<< contents
+            loc = Position line 0
+        in Range loc loc
+      _ -> 
+        let loc = Position 0 0
+        in Range loc loc

test/functional/FunctionalCodeAction.hs

@@ -564,8 +564,8 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [
             let expected =
                     [ "#! /usr/bin/env nix-shell"
                     , "#! nix-shell --pure -i runghc -p \"haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])\""
-                    , "{-# LANGUAGE TypeApplications #-}"
                     , "{-# LANGUAGE ScopedTypeVariables #-}"
+                    , "{-# LANGUAGE TypeApplications #-}"
                     , "module TypeApplications where"
                     , ""
                     , "foo :: forall a. a -> a"