Add fix for import placement

Author: nini-faroux

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -21,7 +21,8 @@ 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
@@ -1323,12 +1324,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 = either id id 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

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

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

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

ghcide/test/data/import-placement/AfterMultilinePragma.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE RecordWildCards, 
+   OverloadedStrings #-}
+   
+
+class Semigroup a => SomeData a
+
+-- | a comment
+instance SomeData All

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"