[refactor] minor fixes for performance

Author: Ishmum Jawad Khan

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

@@ -43,10 +43,10 @@ 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 -> Range -> Maybe WorkspaceEdit
+mkPragmaEdit :: Uri -> T.Text -> Range -> 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
+    res = J.WorkspaceEdit (Just . H.singleton uri $ textEdits) Nothing
 
 -- ---------------------------------------------------------------------
 -- | Offer to add a missing Language Pragma to the top of a file.
@@ -55,18 +55,24 @@ codeActionProvider :: CodeActionProvider IdeState
 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
-        text = fmap VFS.virtualFileText contents
-        rng = endOfModuleHeader pm text
+        somh = startOfModuleHeader pm
+    loc <- if somh > 0
+            then do
+              contents <- LSP.getVirtualFileFunc lsp . toNormalizedUri $ docId ^. J.uri
+              text <- pure $ fmap VFS.virtualFileText contents
+              line <- pure . fromMaybe 0 $ findIndex (not . T.null) . take somh . T.lines =<< text
+              return $ Position line 0
+            else return $ Position 0 0 
+    rng <- pure $ Range loc loc
     cmds <- mapM (mkCodeAction rng) pragmas 
     return $ Right $ List cmds
       where
         mkCodeAction rng pragmaName = do
           let
-            codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) edit Nothing
+            codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just edit) Nothing
             title = "Add \"" <> pragmaName <> "\""
             edit = mkPragmaEdit (docId ^. J.uri) pragmaName rng
           return codeAction
@@ -167,19 +173,14 @@ completion lspFuncs _ide complParams = do
 
 -- | Find the first non-blank line before the first of (module name / imports / declarations).
 -- Useful for inserting pragmas.
-endOfModuleHeader :: Maybe ParsedModule -> Maybe T.Text -> Range
-endOfModuleHeader mpm contents =
+startOfModuleHeader :: Maybe ParsedModule -> Int
+startOfModuleHeader mpm =
     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
+        in fromMaybe 0 $ Just . _line . _start =<< srcSpanToRange =<< 
+            modNameLoc <|> firstImportLoc <|> firstDeclLoc
+      _ -> 0