Skip to content

Commit ced934e

Browse files
nini-farouxpepeiborra
nini-faroux
and
pepeiborra
authored
Add fix for placing suggested new pragma in the correct position, tests (#2043)
included Co-authored-by: Pepe Iborra <[email protected]>
1 parent e7c5e90 commit ced934e

18 files changed

+293
-10
lines changed

‎plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs‎

Lines changed: 27 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Control.Applicative ((<|>))
1414
import Control.Lens hiding (List)
1515
import Control.Monad (join)
1616
import Control.Monad.IO.Class (MonadIO (liftIO))
17+
import Data.Char (isSpace)
1718
import qualified Data.HashMap.Strict as H
1819
import Data.List
1920
import Data.List.Extra (nubOrdOn)
@@ -51,7 +52,7 @@ codeActionProvider state _plId (J.CodeActionParams _ _ docId _ (J.CodeActionCont
5152
pm <- liftIO $ fmap join $ runAction "Pragmas.GetParsedModule" state $ getParsedModule `traverse` mFile
5253
mbContents <- liftIO $ fmap (snd =<<) $ runAction "Pragmas.GetFileContents" state $ getFileContents `traverse` mFile
5354
let dflags = ms_hspp_opts . pm_mod_summary <$> pm
54-
insertRange = maybe (Range (Position 0 0) (Position 0 0)) endOfModuleHeader mbContents
55+
insertRange = maybe (Range (Position 0 0) (Position 0 0)) findNextPragmaPosition mbContents
5556
pedits = nubOrdOn snd . concat $ suggest dflags <$> diags
5657
return $ Right $ List $ pragmaEditToAction uri insertRange <$> pedits
5758

@@ -181,13 +182,29 @@ completion _ide _ complParams = do
181182
}
182183
_ -> return $ J.List []
183184

184-
-- ---------------------------------------------------------------------
185+
-----------------------------------------------------------------------
185186

186-
-- | Find first line after (last pragma / last shebang / beginning of file).
187-
-- Useful for inserting pragmas.
188-
endOfModuleHeader :: T.Text -> Range
189-
endOfModuleHeader contents = Range loc loc
190-
where
191-
loc = Position line 0
192-
line = maybe 0 succ (lastLineWithPrefix "{-#" <|> lastLineWithPrefix "#!")
193-
lastLineWithPrefix pre = listToMaybe $ reverse $ findIndices (T.isPrefixOf pre) $ T.lines contents
187+
-- | Find first line after the last LANGUAGE pragma
188+
-- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or other LANGUAGE pragma(s)
189+
-- Otherwise it will be one after the count of line numbers, with order: Shebangs -> OPTIONS_GHC -> LANGUAGE
190+
findNextPragmaPosition :: T.Text -> Range
191+
findNextPragmaPosition contents = Range loc loc
192+
where
193+
loc = Position line 0
194+
line = afterLangPragma . afterOptsGhc $ afterShebang 0
195+
afterLangPragma = afterPragma "LANGUAGE" contents
196+
afterOptsGhc = afterPragma "OPTIONS_GHC" contents
197+
afterShebang = afterPragma "" contents
198+
199+
afterPragma :: T.Text -> T.Text -> Int -> Int
200+
afterPragma name contents lineNum = maybe lineNum succ $ lastLineWithPrefix (checkPragma name) contents
201+
where
202+
lastLineWithPrefix p contents = listToMaybe . reverse $ findIndices p $ T.lines contents
203+
204+
checkPragma :: T.Text -> T.Text -> Bool
205+
checkPragma name = check
206+
where
207+
check l = (isPragma l || isShebang l) && getName l == name
208+
getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l
209+
isPragma = T.isPrefixOf "{-#"
210+
isShebang = T.isPrefixOf "#!"

‎plugins/hls-pragmas-plugin/test/Main.hs‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,54 @@ codeActionTests =
3232
liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action"
3333
executeCodeAction $ head cas
3434

35+
, goldenWithPragmas "adds LANGUAGE pragma after shebang and last language pragma" "AfterShebangAndPragma" $ \doc -> do
36+
_ <- waitForDiagnosticsFrom doc
37+
cas <- map fromAction <$> getAllCodeActions doc
38+
liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"
39+
executeCodeAction $ head cas
40+
41+
, goldenWithPragmas "adds above module keyword on first line" "ModuleOnFirstLine" $ \doc -> do
42+
_ <- waitForDiagnosticsFrom doc
43+
cas <- map fromAction <$> getAllCodeActions doc
44+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
45+
executeCodeAction $ head cas
46+
47+
, goldenWithPragmas "adds LANGUAGE pragma after GHC_OPTIONS" "AfterGhcOptions" $ \doc -> do
48+
_ <- waitForDiagnosticsFrom doc
49+
cas <- map fromAction <$> getAllCodeActions doc
50+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
51+
executeCodeAction $ head cas
52+
53+
, goldenWithPragmas "adds LANGUAGE pragma after shebang and GHC_OPTIONS" "AfterShebangAndOpts" $ \doc -> do
54+
_ <- waitForDiagnosticsFrom doc
55+
cas <- map fromAction <$> getAllCodeActions doc
56+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
57+
executeCodeAction $ head cas
58+
59+
, goldenWithPragmas "adds LANGUAGE pragma after shebang, GHC_OPTIONS and language pragma" "AfterShebangAndOptionsAndPragma" $ \doc -> do
60+
_ <- waitForDiagnosticsFrom doc
61+
cas <- map fromAction <$> getAllCodeActions doc
62+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
63+
executeCodeAction $ head cas
64+
65+
, goldenWithPragmas "adds LANGUAGE pragma after all others ignoring later INLINE pragma" "AfterShebangAndOptionsAndPragmasIgnoreInline" $ \doc -> do
66+
_ <- waitForDiagnosticsFrom doc
67+
cas <- map fromAction <$> getAllCodeActions doc
68+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
69+
executeCodeAction $ head cas
70+
71+
, goldenWithPragmas "adds LANGUAGE pragma after all others ignoring multiple later INLINE pragma" "AfterAllWithMultipleInlines" $ \doc -> do
72+
_ <- waitForDiagnosticsFrom doc
73+
cas <- map fromAction <$> getAllCodeActions doc
74+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
75+
executeCodeAction $ head cas
76+
77+
, goldenWithPragmas "adds LANGUAGE pragma correctly ignoring later INLINE pragma" "AddLanguagePragma" $ \doc -> do
78+
_ <- waitForDiagnosticsFrom doc
79+
cas <- map fromAction <$> getAllCodeActions doc
80+
liftIO $ "Add \"TupleSections\"" `elem` map (^. L.title) cas @? "Contains TupleSections code action"
81+
executeCodeAction $ head cas
82+
3583
, goldenWithPragmas "adds TypeApplications pragma" "TypeApplications" $ \doc -> do
3684
_ <- waitForDiagnosticsFrom doc
3785
cas <- map fromAction <$> getAllCodeActions doc

‎plugins/hls-pragmas-plugin/test/testdata/AddLanguagePragma.expected.hs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE TupleSections #-}
3+
4+
module NeedsLanguagePragma where
5+
6+
tupleSection = (1,) <$> Just 2
7+
8+
{-# INLINE addOne #-}
9+
addOne :: Int -> Int
10+
addOne x = x + 1

‎plugins/hls-pragmas-plugin/test/testdata/AddLanguagePragma.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module NeedsLanguagePragma where
4+
5+
tupleSection = (1,) <$> Just 2
6+
7+
{-# INLINE addOne #-}
8+
addOne :: Int -> Int
9+
addOne x = x + 1

‎plugins/hls-pragmas-plugin/test/testdata/AfterAllWithMultipleInlines.expected.hs‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
#! /usr/bin/env nix-shell
2+
#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"
3+
{-# OPTIONS_GHC -Wall #-}
4+
{-# OPTIONS_GHC -Wno-unused-imports #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE RecordWildCards #-}
7+
{-# LANGUAGE TupleSections #-}
8+
9+
data Something = Something {
10+
foo :: !String,
11+
bar :: !Int
12+
}
13+
14+
tupleSection = (1, ) <$> Just 2
15+
16+
{-# INLINE addOne #-}
17+
addOne :: Int -> Int
18+
addOne x = x + 1
19+
20+
{-# INLINE subOne #-}
21+
subOne :: Int -> Int
22+
subOne x = x - 1

‎plugins/hls-pragmas-plugin/test/testdata/AfterAllWithMultipleInlines.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
#! /usr/bin/env nix-shell
2+
#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"
3+
{-# OPTIONS_GHC -Wall #-}
4+
{-# OPTIONS_GHC -Wno-unused-imports #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE RecordWildCards #-}
7+
8+
data Something = Something {
9+
foo :: !String,
10+
bar :: !Int
11+
}
12+
13+
tupleSection = (1, ) <$> Just 2
14+
15+
{-# INLINE addOne #-}
16+
addOne :: Int -> Int
17+
addOne x = x + 1
18+
19+
{-# INLINE subOne #-}
20+
subOne :: Int -> Int
21+
subOne x = x - 1

‎plugins/hls-pragmas-plugin/test/testdata/AfterGhcOptions.expected.hs‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
{-# OPTIONS_GHC -Wno-unused-imports #-}
3+
{-# LANGUAGE TupleSections #-}
4+
5+
data Something = Something {
6+
foo :: !String,
7+
bar :: !Int
8+
}
9+
10+
tupleSection = (1, ) <$> Just 2
11+
12+
{-# INLINE addOne #-}
13+
addOne :: Int -> Int
14+
addOne x = x + 1
15+
16+
{-# INLINE subOne #-}
17+
subOne :: Int -> Int
18+
subOne x = x - 1

‎plugins/hls-pragmas-plugin/test/testdata/AfterGhcOptions.hs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
{-# OPTIONS_GHC -Wall #-}
2+
{-# OPTIONS_GHC -Wno-unused-imports #-}
3+
4+
data Something = Something {
5+
foo :: !String,
6+
bar :: !Int
7+
}
8+
9+
tupleSection = (1, ) <$> Just 2
10+
11+
{-# INLINE addOne #-}
12+
addOne :: Int -> Int
13+
addOne x = x + 1
14+
15+
{-# INLINE subOne #-}
16+
subOne :: Int -> Int
17+
subOne x = x - 1

‎plugins/hls-pragmas-plugin/test/testdata/AfterShebangAndOptionsAndPragma.expected.hs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
#! /usr/bin/env nix-shell
2+
#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"
3+
{-# OPTIONS_GHC -Wall #-}
4+
{-# OPTIONS_GHC -Wno-unused-imports #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE TupleSections #-}
7+
8+
data Something = Something {
9+
foo :: !String,
10+
bar :: !Int
11+
}
12+
13+
tupleSection = (1, ) <$> Just 2

‎plugins/hls-pragmas-plugin/test/testdata/AfterShebangAndOptionsAndPragma.hs‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
#! /usr/bin/env nix-shell
2+
#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"
3+
{-# OPTIONS_GHC -Wall #-}
4+
{-# OPTIONS_GHC -Wno-unused-imports #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
7+
data Something = Something {
8+
foo :: !String,
9+
bar :: !Int
10+
}
11+
12+
tupleSection = (1, ) <$> Just 2

0 commit comments

Comments
 (0)