Best-effort support of Qualified Imports in GHC 9.4

hls-plugin-api/src/Ide/PluginUtils.hs

@@ -1,11 +1,13 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies      #-}
+
 module Ide.PluginUtils
   ( -- * LSP Range manipulation functions
     normalize,
     extendNextLine,
     extendLineStart,
+    extendToFullLines,
     WithDeletions(..),
     getProcessID,
     makeDiffTextEdit,
@@ -19,7 +21,7 @@ module Ide.PluginUtils
     getPluginConfig,
     configForPlugin,
     pluginEnabled,
-    extractRange,
+    extractTextInRange,
     fullRange,
     mkLspCommand,
     mkLspCmdId,
@@ -36,12 +38,11 @@ module Ide.PluginUtils
     handleMaybeM,
     throwPluginError,
     unescape,
-    )
+  )
 where
 
-
 import           Control.Arrow                 ((&&&))
-import           Control.Lens                  (re, (^.))
+import           Control.Lens                  (_head, _last, re, (%~), (^.))
 import           Control.Monad.Extra           (maybeM)
 import           Control.Monad.Trans.Class     (lift)
 import           Control.Monad.Trans.Except    (ExceptT, runExceptT, throwE)
@@ -90,17 +91,33 @@ extendLineStart :: Range -> Range
 extendLineStart (Range (Position sl _) e) =
   Range (Position sl 0) e
 
+-- | Extend 'Range' to include the start of the first line and start of the next line of the last line.
+--
+-- Caveat: It always extend the last line to the beginning of next line, even when the last position is at column 0.
+-- This is to keep the compatibility with the implementation of old function @extractRange@.
+--
+-- >>> extendToFullLines (Range (Position 5 5) (Position 5 10))
+-- Range (Position 5 0) (Position 6 0)
+--
+-- >>> extendToFullLines (Range (Position 5 5) (Position 7 2))
+-- Range (Position 5 0) (Position 8 0)
+--
+-- >>> extendToFullLines (Range (Position 5 5) (Position 7 0))
+-- Range (Position 5 0) (Position 8 0)
+extendToFullLines :: Range -> Range
+extendToFullLines = extendLineStart . extendNextLine
+
+
 -- ---------------------------------------------------------------------
 
 data WithDeletions = IncludeDeletions | SkipDeletions
-  deriving Eq
+  deriving (Eq)
 
 -- | Generate a 'WorkspaceEdit' value from a pair of source Text
-diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
+diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
 diffText clientCaps old new withDeletions =
-  let
-    supports = clientSupportsDocumentChanges clientCaps
-  in diffText' supports old new withDeletions
+  let supports = clientSupportsDocumentChanges clientCaps
+   in diffText' supports old new withDeletions
 
 makeDiffTextEdit :: T.Text -> T.Text -> [TextEdit]
 makeDiffTextEdit f1 f2 = diffTextEdit f1 f2 IncludeDeletions
@@ -114,13 +131,14 @@ diffTextEdit fText f2Text withDeletions = r
     r = map diffOperationToTextEdit diffOps
     d = getGroupedDiff (lines $ T.unpack fText) (lines $ T.unpack f2Text)
 
-    diffOps = filter (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x))
-                     (diffToLineRanges d)
+    diffOps =
+      filter
+        (\x -> (withDeletions == IncludeDeletions) || not (isDeletion x))
+        (diffToLineRanges d)
 
     isDeletion (Deletion _ _) = True
     isDeletion _              = False
 
-
     diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit
     diffOperationToTextEdit (Change fm to) = TextEdit range nt
       where
@@ -136,17 +154,20 @@ diffTextEdit fText f2Text withDeletions = r
     -}
     diffOperationToTextEdit (Deletion (LineRange (sl, el) _) _) = TextEdit range ""
       where
-        range = Range (Position (fromIntegral $ sl - 1) 0)
-                        (Position (fromIntegral el) 0)
-
+        range =
+          Range
+            (Position (fromIntegral $ sl - 1) 0)
+            (Position (fromIntegral el) 0)
     diffOperationToTextEdit (Addition fm l) = TextEdit range nt
-    -- fm has a range wrt to the changed file, which starts in the current file at l + 1
-    -- So the range has to be shifted to start at l + 1
       where
-        range = Range (Position (fromIntegral l) 0)
-                        (Position (fromIntegral l) 0)
-        nt = T.pack $ unlines $ lrContents fm
+        -- fm has a range wrt to the changed file, which starts in the current file at l + 1
+        -- So the range has to be shifted to start at l + 1
 
+        range =
+          Range
+            (Position (fromIntegral l) 0)
+            (Position (fromIntegral l) 0)
+        nt = T.pack $ unlines $ lrContents fm
 
     calcRange fm = Range s e
       where
@@ -155,20 +176,19 @@ diffTextEdit fText f2Text withDeletions = r
         s = Position (fromIntegral $ sl - 1) sc -- Note: zero-based lines
         el = snd $ lrNumbers fm
         ec = fromIntegral $ length $ last $ lrContents fm
-        e = Position (fromIntegral $ el - 1) ec  -- Note: zero-based lines
-
+        e = Position (fromIntegral $ el - 1) ec -- Note: zero-based lines
 
 -- | A pure version of 'diffText' for testing
-diffText' :: Bool -> (VersionedTextDocumentIdentifier,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
-diffText' supports (verTxtDocId,fText) f2Text withDeletions =
+diffText' :: Bool -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
+diffText' supports (verTxtDocId, fText) f2Text withDeletions =
   if supports
     then WorkspaceEdit Nothing (Just docChanges) Nothing
     else WorkspaceEdit (Just h) Nothing Nothing
   where
     diff = diffTextEdit fText f2Text withDeletions
     h = M.singleton (verTxtDocId ^. L.uri) diff
     docChanges = [InL docEdit]
-    docEdit = TextDocumentEdit (verTxtDocId ^.re _versionedTextDocumentIdentifier) $ fmap InL diff
+    docEdit = TextDocumentEdit (verTxtDocId ^. re _versionedTextDocumentIdentifier) $ fmap InL diff
 
 -- ---------------------------------------------------------------------
 
@@ -179,8 +199,7 @@ clientSupportsDocumentChanges caps =
         wCaps <- mwCaps
         WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps
         mDc
-  in
-    Just True == supports
+   in Just True == supports
 
 -- ---------------------------------------------------------------------
 
@@ -191,22 +210,22 @@ idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
 idePluginsToPluginDesc (IdePlugins pp) = pp
 
 -- ---------------------------------------------------------------------
+
 -- | Returns the current client configuration. It is not wise to permanently
 -- cache the returned value of this function, as clients can at runtime change
 -- their configuration.
---
-getClientConfig :: MonadLsp Config m => m Config
+getClientConfig :: (MonadLsp Config m) => m Config
 getClientConfig = getConfig
 
 -- ---------------------------------------------------------------------
 
 -- | Returns the current plugin configuration. It is not wise to permanently
 -- cache the returned value of this function, as clients can change their
 -- configuration at runtime.
-getPluginConfig :: MonadLsp Config m => PluginDescriptor c -> m PluginConfig
+getPluginConfig :: (MonadLsp Config m) => PluginDescriptor c -> m PluginConfig
 getPluginConfig plugin = do
-    config <- getClientConfig
-    return $ configForPlugin config plugin
+  config <- getClientConfig
+  return $ configForPlugin config plugin
 
 -- ---------------------------------------------------------------------
 
@@ -223,24 +242,33 @@ usePropertyLsp kn pId p = do
 
 -- ---------------------------------------------------------------------
 
-extractRange :: Range -> T.Text -> T.Text
-extractRange (Range (Position sl _) (Position el _)) s = newS
-  where focusLines = take (fromIntegral $ el-sl+1) $ drop (fromIntegral sl) $ T.lines s
-        newS = T.unlines focusLines
+-- | Extracts exact matching text in the range.
+extractTextInRange :: Range -> T.Text -> T.Text
+extractTextInRange (Range (Position sl sc) (Position el ec)) s = newS
+  where
+    focusLines = take (fromIntegral $ el - sl + 1) $ drop (fromIntegral sl) $ T.lines s
+    -- NOTE: We have to trim the last line first to handle the single-line case
+    newS =
+      focusLines
+        & _last %~ T.take (fromIntegral ec)
+        & _head %~ T.drop (fromIntegral sc)
+        -- NOTE: We cannot use unlines here, because we don't want to add trailing newline!
+        & T.intercalate "\n"
 
 -- | Gets the range that covers the entire text
 fullRange :: T.Text -> Range
 fullRange s = Range startPos endPos
-  where startPos = Position 0 0
-        endPos = Position lastLine 0
-        {-
-        In order to replace everything including newline characters,
-        the end range should extend below the last line. From the specification:
-        "If you want to specify a range that contains a line including
-        the line ending character(s) then use an end position denoting
-        the start of the next line"
-        -}
-        lastLine = fromIntegral $ length $ T.lines s
+  where
+    startPos = Position 0 0
+    endPos = Position lastLine 0
+    {-
+    In order to replace everything including newline characters,
+    the end range should extend below the last line. From the specification:
+    "If you want to specify a range that contains a line including
+    the line ending character(s) then use an end position denoting
+    the start of the next line"
+    -}
+    lastLine = fromIntegral $ length $ T.lines s
 
 subRange :: Range -> Range -> Bool
 subRange = isSubrangeOf
@@ -249,34 +277,34 @@ subRange = isSubrangeOf
 
 allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
 allLspCmdIds' pid (IdePlugins ls) =
-    allLspCmdIds pid $ map (pluginId &&& pluginCommands) ls
+  allLspCmdIds pid $ map (pluginId &&& pluginCommands) ls
 
 allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
 allLspCmdIds pid commands = concatMap go commands
   where
     go (plid, cmds) = map (mkLspCmdId pid plid . commandId) cmds
 
-
 -- ---------------------------------------------------------------------
 
-getNormalizedFilePath :: Monad m => Uri -> ExceptT String m NormalizedFilePath
-getNormalizedFilePath uri = handleMaybe errMsg
-        $ uriToNormalizedFilePath
-        $ toNormalizedUri uri
-    where
-        errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath"
+getNormalizedFilePath :: (Monad m) => Uri -> ExceptT String m NormalizedFilePath
+getNormalizedFilePath uri =
+  handleMaybe errMsg $
+    uriToNormalizedFilePath $
+      toNormalizedUri uri
+  where
+    errMsg = T.unpack $ "Failed converting " <> getUri uri <> " to NormalizedFilePath"
 
 -- ---------------------------------------------------------------------
-throwPluginError :: Monad m => String -> ExceptT String m b
+throwPluginError :: (Monad m) => String -> ExceptT String m b
 throwPluginError = throwE
 
-handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
+handleMaybe :: (Monad m) => e -> Maybe b -> ExceptT e m b
 handleMaybe msg = maybe (throwE msg) return
 
-handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
+handleMaybeM :: (Monad m) => e -> m (Maybe b) -> ExceptT e m b
 handleMaybeM msg act = maybeM (throwE msg) return $ lift act
 
-pluginResponse :: Monad m => ExceptT String m a -> m (Either ResponseError a)
+pluginResponse :: (Monad m) => ExceptT String m a -> m (Either ResponseError a)
 pluginResponse =
   fmap (first (\msg -> ResponseError (InR ErrorCodes_InternalError) (fromString msg) Nothing))
     . runExceptT
@@ -290,9 +318,9 @@ type TextParser = P.Parsec Void T.Text
 -- display as is.
 unescape :: T.Text -> T.Text
 unescape input =
-    case P.runParser escapedTextParser "inline" input of
-        Left _     -> input
-        Right strs -> T.pack strs
+  case P.runParser escapedTextParser "inline" input of
+    Left _     -> input
+    Right strs -> T.pack strs
 
 -- | Parser for a string that contains double quotes. Returns unescaped string.
 escapedTextParser :: TextParser String
@@ -303,11 +331,11 @@ escapedTextParser = concat <$> P.many (outsideStringLiteral P.<|> stringLiteral)
 
     stringLiteral :: TextParser String
     stringLiteral = do
-        inside <- P.char '"' >> P.manyTill P.charLiteral (P.char '"')
-        let f '"' = "\\\"" -- double quote should still be escaped
-            -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable
-            -- characters. So we need to call 'isPrint' from 'Data.Char' manually.
-            f ch  = if isPrint ch then [ch] else showLitChar ch ""
-            inside' = concatMap f inside
-
-        pure $ "\"" <> inside' <> "\""
+      inside <- P.char '"' >> P.manyTill P.charLiteral (P.char '"')
+      let f '"' = "\\\"" -- double quote should still be escaped
+      -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable
+      -- characters. So we need to call 'isPrint' from 'Data.Char' manually.
+          f ch  = if isPrint ch then [ch] else showLitChar ch ""
+          inside' = concatMap f inside
+
+      pure $ "\"" <> inside' <> "\""

plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs

@@ -33,7 +33,7 @@ provider _ideState typ contents fp _ = liftIO $ do
     config <- findConfigOrDefault file
     let (range, selectedContents) = case typ of
           FormatText    -> (fullRange contents, contents)
-          FormatRange r -> (normalize r, extractRange r contents)
+          FormatRange r -> (normalize r, extractTextInRange (extendToFullLines r) contents)
         result = reformat config (Just file) . TL.encodeUtf8 $ TL.fromStrict selectedContents
     case result of
       Left  err -> pure $ Left $ responseError $ T.pack $ "floskellCmd: " ++ err

plugins/hls-refactor-plugin/hls-refactor-plugin.cabal

@@ -86,6 +86,9 @@ library
     , lens
     , data-default
     , time
+    -- FIXME: Only needed to workaround for qualified imports in GHC 9.4
+    , regex-applicative
+    , parser-combinators
   ghc-options: -Wall -Wno-name-shadowing
   default-language: Haskell2010