From 73b2bfda4998c7bade5c8ff57e856970742b8bec Mon Sep 17 00:00:00 2001 From: nini-faroux Date: Thu, 25 Nov 2021 20:42:45 +0000 Subject: [PATCH] Add fix for import placement --- .../src/Development/IDE/Plugin/CodeAction.hs | 28 +++++++++++++++++-- .../AfterMultilineOptsPragma.expected.hs | 15 ++++++++++ .../AfterMultilineOptsPragma.hs | 14 ++++++++++ .../AfterMultilinePragma.expected.hs | 9 ++++++ .../import-placement/AfterMultilinePragma.hs | 8 ++++++ ghcide/test/exe/Main.hs | 4 ++- 6 files changed, 74 insertions(+), 4 deletions(-) create mode 100644 ghcide/test/data/import-placement/AfterMultilineOptsPragma.expected.hs create mode 100644 ghcide/test/data/import-placement/AfterMultilineOptsPragma.hs create mode 100644 ghcide/test/data/import-placement/AfterMultilinePragma.expected.hs create mode 100644 ghcide/test/data/import-placement/AfterMultilinePragma.hs diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 30c7b500f9..c6562ba1fa 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -21,10 +21,12 @@ module Development.IDE.Plugin.CodeAction import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) -import Control.Monad (guard, join) +import Control.Monad (foldM, + guard, join) import Control.Monad.IO.Class import Data.Char import qualified Data.DList as DL +import Data.Either.Extra (fromEither) import Data.Function import Data.Functor import qualified Data.HashMap.Strict as Map @@ -1323,12 +1325,32 @@ findNextPragmaPosition contents = Just ((lineNumber, 0), 0) contents' = T.lines contents afterPragma :: T.Text -> [T.Text] -> Int -> Int -afterPragma name contents lineNum = lastLineWithPrefix (checkPragma name) contents lineNum +afterPragma name = lastLineWithPrefixMulti (checkPragma name) lastLineWithPrefix :: (T.Text -> Bool) -> [T.Text] -> Int -> Int lastLineWithPrefix p contents lineNum = max lineNum next where - next = maybe lineNum succ $ listToMaybe . reverse $ findIndices p contents + next = maybe lineNum succ $ listToMaybe $ reverse $ findIndices p contents + +-- | Accounts for the case where the LANGUAGE or OPTIONS_GHC +-- pragma spans multiple lines or just a single line +lastLineWithPrefixMulti :: (T.Text -> Bool) -> [T.Text] -> Int -> Int +lastLineWithPrefixMulti p contents lineNum = max lineNum next + where + mIndex = listToMaybe . reverse $ findIndices p contents + next = case mIndex of + Nothing -> 0 + Just index -> getEndOfPragmaBlock index $ drop index contents + +getEndOfPragmaBlock :: Int -> [T.Text] -> Int +getEndOfPragmaBlock start contents = lineNumber + where + lineNumber = fromEither lineNum + lineNum = foldM go start contents + go pos txt + | endOfBlock txt = Left $ pos + 1 + | otherwise = Right $ pos + 1 + endOfBlock txt = T.dropWhile (/= '}') (T.dropWhile (/= '-') txt) == "}" checkPragma :: T.Text -> T.Text -> Bool checkPragma name = check diff --git a/ghcide/test/data/import-placement/AfterMultilineOptsPragma.expected.hs b/ghcide/test/data/import-placement/AfterMultilineOptsPragma.expected.hs new file mode 100644 index 0000000000..a93381119d --- /dev/null +++ b/ghcide/test/data/import-placement/AfterMultilineOptsPragma.expected.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards, + OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wall, + -Wno-unused-imports #-} +import Data.Monoid + + + +class Semigroup a => SomeData a + +-- | a comment +instance SomeData All diff --git a/ghcide/test/data/import-placement/AfterMultilineOptsPragma.hs b/ghcide/test/data/import-placement/AfterMultilineOptsPragma.hs new file mode 100644 index 0000000000..439f157375 --- /dev/null +++ b/ghcide/test/data/import-placement/AfterMultilineOptsPragma.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards, + OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wall, + -Wno-unused-imports #-} + + + +class Semigroup a => SomeData a + +-- | a comment +instance SomeData All diff --git a/ghcide/test/data/import-placement/AfterMultilinePragma.expected.hs b/ghcide/test/data/import-placement/AfterMultilinePragma.expected.hs new file mode 100644 index 0000000000..e4630017e3 --- /dev/null +++ b/ghcide/test/data/import-placement/AfterMultilinePragma.expected.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RecordWildCards, + OverloadedStrings #-} +import Data.Monoid + + +class Semigroup a => SomeData a + +-- | a comment +instance SomeData All diff --git a/ghcide/test/data/import-placement/AfterMultilinePragma.hs b/ghcide/test/data/import-placement/AfterMultilinePragma.hs new file mode 100644 index 0000000000..1f7d628ca5 --- /dev/null +++ b/ghcide/test/data/import-placement/AfterMultilinePragma.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordWildCards, + OverloadedStrings #-} + + +class Semigroup a => SomeData a + +-- | a comment +instance SomeData All diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 21f2939d5b..c2eebe5909 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -857,7 +857,9 @@ watchedFilesTests = testGroup "watched files" insertImportTests :: TestTree insertImportTests = testGroup "insert import" - [ checkImport "above comment at top of module" "CommentAtTop.hs" "CommentAtTop.expected.hs" "import Data.Monoid" + [ checkImport "after multiline pragmas and opts no module or imports" "AfterMultilineOptsPragma.hs" "AfterMultilineOptsPragma.expected.hs" "import Data.Monoid" + , checkImport "after multiline pragma no module or imports" "AfterMultilinePragma.hs" "AfterMultilinePragma.expected.hs" "import Data.Monoid" + , checkImport "above comment at top of module" "CommentAtTop.hs" "CommentAtTop.expected.hs" "import Data.Monoid" , checkImport "above multiple comments below" "CommentAtTopMultipleComments.hs" "CommentAtTopMultipleComments.expected.hs" "import Data.Monoid" , checkImport "above curly brace comment" "CommentCurlyBraceAtTop.hs" "CommentCurlyBraceAtTop.expected.hs" "import Data.Monoid" , checkImport "above multi-line comment" "MultiLineCommentAtTop.hs" "MultiLineCommentAtTop.expected.hs" "import Data.Monoid"