hls-pragmas-plugin 1.0.1.1 → 1.0.2.0
raw patch · 37 files changed
+376/−96 lines, 37 filesdep +containersdep +ghcdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utils
Dependencies added: containers, ghc
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
Files
- hls-pragmas-plugin.cabal +6/−4
- src/Ide/Plugin/Pragmas.hs +106/−85
- test/Main.hs +24/−7
- test/testdata/BlockCommentThenLineComment.expected.hs +6/−0
- test/testdata/BlockCommentThenLineComment.hs +5/−0
- test/testdata/BlockCommentThenLineHaddock.expected.hs +7/−0
- test/testdata/BlockCommentThenLineHaddock.hs +5/−0
- test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs +10/−0
- test/testdata/BlockCommentThenMultiLineBlockComment.hs +9/−0
- test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs +13/−0
- test/testdata/BlockCommentThenMultiLineBlockHaddock.hs +11/−0
- test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs +6/−0
- test/testdata/BlockCommentThenSingleLineBlockComment.hs +5/−0
- test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs +7/−0
- test/testdata/BlockCommentThenSingleLineBlockHaddock.hs +5/−0
- test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs +7/−0
- test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs +5/−0
- test/testdata/OptionsGhcAfterDecl.expected.hs +11/−0
- test/testdata/OptionsGhcAfterDecl.hs +10/−0
- test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs +5/−0
- test/testdata/PragmaThenLineComment.expected.hs +6/−0
- test/testdata/PragmaThenLineComment.hs +5/−0
- test/testdata/PragmaThenLineHaddock.expected.hs +7/−0
- test/testdata/PragmaThenLineHaddock.hs +5/−0
- test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs +8/−0
- test/testdata/PragmaThenLineHaddockNewlineLineComment.hs +6/−0
- test/testdata/PragmaThenMultiLineBlockComment.expected.hs +11/−0
- test/testdata/PragmaThenMultiLineBlockComment.hs +9/−0
- test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs +11/−0
- test/testdata/PragmaThenMultiLineBlockHaddock.hs +9/−0
- test/testdata/PragmaThenSingleLineBlockComment.expected.hs +6/−0
- test/testdata/PragmaThenSingleLineBlockComment.hs +5/−0
- test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs +7/−0
- test/testdata/PragmaThenSingleLineBlockHaddock.hs +5/−0
- test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs +7/−0
- test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs +5/−0
- test/testdata/hie.yaml +1/−0
hls-pragmas-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-pragmas-plugin-version: 1.0.1.1+version: 1.0.2.0 synopsis: Pragmas plugin for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -24,13 +24,15 @@ , base >=4.12 && <5 , extra , fuzzy- , ghcide >=1.2 && <1.6- , hls-plugin-api >=1.1 && <1.3+ , ghc+ , ghcide ^>=1.6+ , hls-plugin-api ^>=1.3 , lens , lsp , text , transformers , unordered-containers+ , containers default-language: Haskell2010 @@ -44,7 +46,7 @@ , base , filepath , hls-pragmas-plugin- , hls-test-utils >=1.0 && <1.2+ , hls-test-utils ^>=1.2 , lens , lsp-types , text
src/Ide/Plugin/Pragmas.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}@@ -10,24 +12,53 @@ ( descriptor ) where -import Control.Applicative ((<|>))-import Control.Lens hiding (List)-import Control.Monad (join)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Char (isSpace)-import qualified Data.HashMap.Strict as H-import Data.List-import Data.List.Extra (nubOrdOn)-import Data.Maybe (catMaybes, listToMaybe)-import qualified Data.Text as T-import Development.IDE as D+import Control.Applicative ((<|>))+import Control.Lens hiding (List)+import Control.Monad (join)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Trans.State.Strict (State)+import Data.Bits (Bits (bit, complement, setBit, (.&.)))+import Data.Char (isSpace)+import qualified Data.Char as Char+import Data.Coerce (coerce)+import Data.Functor (void, ($>))+import qualified Data.HashMap.Strict as H+import qualified Data.List as List+import Data.List.Extra (nubOrdOn)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes, listToMaybe,+ mapMaybe)+import qualified Data.Maybe as Maybe+import Data.Ord (Down (Down))+import Data.Semigroup (Semigroup ((<>)))+import qualified Data.Text as T+import Data.Word (Word64)+import Development.IDE as D (Diagnostic (Diagnostic, _code, _message),+ GhcSession (GhcSession),+ HscEnvEq (hscEnv),+ IdeState, List (List),+ ParseResult (POk),+ Position (Position),+ Range (Range), Uri,+ getFileContents,+ getParsedModule,+ prettyPrint, runAction,+ srcSpanToRange,+ toNormalizedUri,+ uriToFilePath',+ useWithStale) import Development.IDE.GHC.Compat+import Development.IDE.GHC.Compat.Util (StringBuffer, atEnd,+ nextChar,+ stringToStringBuffer)+import qualified Development.IDE.Spans.Pragmas as Pragmas+import Development.IDE.Types.HscEnvEq (HscEnvEq, hscEnv) import Ide.Types-import qualified Language.LSP.Server as LSP-import qualified Language.LSP.Types as J-import qualified Language.LSP.Types.Lens as J-import qualified Language.LSP.VFS as VFS-import qualified Text.Fuzzy as Fuzzy+import qualified Language.LSP.Server as LSP+import qualified Language.LSP.Types as J+import qualified Language.LSP.Types.Lens as J+import qualified Language.LSP.VFS as VFS+import qualified Text.Fuzzy as Fuzzy -- --------------------------------------------------------------------- @@ -38,7 +69,6 @@ } -- ---------------------------------------------------------------------- -- | Title and pragma type PragmaEdit = (T.Text, Pragma) @@ -46,29 +76,47 @@ deriving (Show, Eq, Ord) codeActionProvider :: PluginMethodHandler IdeState 'J.TextDocumentCodeAction-codeActionProvider state _plId (J.CodeActionParams _ _ docId _ (J.CodeActionContext (J.List diags) _monly)) = do- let mFile = docId ^. J.uri & J.uriToFilePath <&> toNormalizedFilePath'- uri = docId ^. J.uri- pm <- liftIO $ fmap join $ runAction "Pragmas.GetParsedModule" state $ getParsedModule `traverse` mFile- mbContents <- liftIO $ fmap (snd =<<) $ runAction "Pragmas.GetFileContents" state $ getFileContents `traverse` mFile- let dflags = ms_hspp_opts . pm_mod_summary <$> pm- insertRange = maybe (Range (Position 0 0) (Position 0 0)) findNextPragmaPosition mbContents- pedits = nubOrdOn snd . concat $ suggest dflags <$> diags- return $ Right $ List $ pragmaEditToAction uri insertRange <$> pedits+codeActionProvider state _plId (J.CodeActionParams _ _ docId _ (J.CodeActionContext (J.List diags) _monly))+ | let J.TextDocumentIdentifier{ _uri = uri } = docId+ , Just normalizedFilePath <- J.uriToNormalizedFilePath $ toNormalizedUri uri = do+ -- ghc session to get some dynflags even if module isn't parsed+ ghcSession <- liftIO $ runAction "Pragmas.GhcSession" state $ useWithStale GhcSession normalizedFilePath+ (_, fileContents) <- liftIO $ runAction "Pragmas.GetFileContents" state $ getFileContents normalizedFilePath+ parsedModule <- liftIO $ runAction "Pragmas.GetParsedModule" state $ getParsedModule normalizedFilePath+ let parsedModuleDynFlags = ms_hspp_opts . pm_mod_summary <$> parsedModule + case ghcSession of+ Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) ->+ let nextPragmaInfo = Pragmas.getNextPragmaInfo sessionDynFlags fileContents+ pedits = nubOrdOn snd . concat $ suggest parsedModuleDynFlags <$> diags+ in+ pure $ Right $ List $ pragmaEditToAction uri nextPragmaInfo <$> pedits+ Nothing -> pure $ Right $ List []+ | otherwise = pure $ Right $ List []++ -- | Add a Pragma to the given URI at the top of the file. -- It is assumed that the pragma name is a valid pragma, -- thus, not validated.-pragmaEditToAction :: Uri -> Range -> PragmaEdit -> (J.Command J.|? J.CodeAction)-pragmaEditToAction uri range (title, p) =+pragmaEditToAction :: Uri -> Pragmas.NextPragmaInfo -> PragmaEdit -> (J.Command J.|? J.CodeAction)+pragmaEditToAction uri Pragmas.NextPragmaInfo{ nextPragmaLine, lineSplitTextEdits } (title, p) = J.InR $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing Nothing (Just edit) Nothing Nothing where render (OptGHC x) = "{-# OPTIONS_GHC -Wno-" <> x <> " #-}\n" render (LangExt x) = "{-# LANGUAGE " <> x <> " #-}\n"- textEdits = J.List [J.TextEdit range $ render p]+ pragmaInsertPosition = Position (fromIntegral nextPragmaLine) 0+ pragmaInsertRange = Range pragmaInsertPosition pragmaInsertPosition+ -- workaround the fact that for some reason lsp-test applies text+ -- edits in reverse order than lsp (tried in both coc.nvim and vscode)+ textEdits =+ if | Just (Pragmas.LineSplitTextEdits insertTextEdit deleteTextEdit) <- lineSplitTextEdits+ , let J.TextEdit{ _range, _newText } = insertTextEdit ->+ [J.TextEdit _range (render p <> _newText), deleteTextEdit]+ | otherwise -> [J.TextEdit pragmaInsertRange (render p)]+ edit = J.WorkspaceEdit- (Just $ H.singleton uri textEdits)+ (Just $ H.singleton uri (J.List textEdits)) Nothing Nothing @@ -149,7 +197,6 @@ ] -- ---------------------------------------------------------------------- flags :: [T.Text] flags = map (T.pack . stripLeading '-') $ flagsForCompletion False @@ -163,22 +210,24 @@ result <$> VFS.getCompletionPrefix position cnts where result (Just pfix)- | "{-# language" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)+ | "{-# language" `T.isPrefixOf` line = J.List $ map buildCompletion (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)- | "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)+ | "{-# options_ghc" `T.isPrefixOf` line = J.List $ map mkExtCompl (Fuzzy.simpleFilter (VFS.prefixText pfix) flags)- -- if there already is a closing bracket - complete without one- | isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix- = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing)- -- if there is no closing bracket - complete with one- | isPragmaPrefix (VFS.fullLine pfix)- = J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}"))+ | "{-#" `T.isPrefixOf` line+ = J.List $ map (\(a, b, c) -> mkPragmaCompl (a <> suffix) b c) validPragmas | otherwise = J.List []+ where+ line = T.toLower $ VFS.fullLine pfix+ suffix+ | "#-}" `T.isSuffixOf` line = " "+ | "-}" `T.isSuffixOf` line = " #"+ | "}" `T.isSuffixOf` line = " #-"+ | otherwise = " #-}" result Nothing = J.List []- isPragmaPrefix line = "{-#" `T.isPrefixOf` line buildCompletion p = J.CompletionItem { _label = p,@@ -200,24 +249,22 @@ _xdata = Nothing } _ -> return $ J.List []+ ------------------------------------------------------------------------validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)]-validPragmas mSuffix =- [ ("LANGUAGE ${1:extension} #-" <> suffix , "LANGUAGE", "{-# LANGUAGE #-}")- , ("OPTIONS_GHC -${1:option} #-" <> suffix , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")- , ("INLINE ${1:function} #-" <> suffix , "INLINE", "{-# INLINE #-}")- , ("NOINLINE ${1:function} #-" <> suffix , "NOINLINE", "{-# NOINLINE #-}")- , ("INLINABLE ${1:function} #-"<> suffix , "INLINABLE", "{-# INLINABLE #-}")- , ("WARNING ${1:message} #-" <> suffix , "WARNING", "{-# WARNING #-}")- , ("DEPRECATED ${1:message} #-" <> suffix , "DEPRECATED", "{-# DEPRECATED #-}")- , ("ANN ${1:annotation} #-" <> suffix , "ANN", "{-# ANN #-}")- , ("RULES #-" <> suffix , "RULES", "{-# RULES #-}")- , ("SPECIALIZE ${1:function} #-" <> suffix , "SPECIALIZE", "{-# SPECIALIZE #-}")- , ("SPECIALIZE INLINE ${1:function} #-"<> suffix , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}")+validPragmas :: [(T.Text, T.Text, T.Text)]+validPragmas =+ [ ("LANGUAGE ${1:extension}" , "LANGUAGE", "{-# LANGUAGE #-}")+ , ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")+ , ("INLINE ${1:function}" , "INLINE", "{-# INLINE #-}")+ , ("NOINLINE ${1:function}" , "NOINLINE", "{-# NOINLINE #-}")+ , ("INLINABLE ${1:function}" , "INLINABLE", "{-# INLINABLE #-}")+ , ("WARNING ${1:message}" , "WARNING", "{-# WARNING #-}")+ , ("DEPRECATED ${1:message}" , "DEPRECATED", "{-# DEPRECATED #-}")+ , ("ANN ${1:annotation}" , "ANN", "{-# ANN #-}")+ , ("RULES" , "RULES", "{-# RULES #-}")+ , ("SPECIALIZE ${1:function}" , "SPECIALIZE", "{-# SPECIALIZE #-}")+ , ("SPECIALIZE INLINE ${1:function}" , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}") ]- where suffix = case mSuffix of- (Just s) -> s- Nothing -> "" mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem@@ -226,36 +273,7 @@ Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) Nothing Nothing Nothing Nothing Nothing Nothing --- | Find first line after the last file header pragma--- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or LANGUAGE pragma(s)--- Otherwise it will be one after the count of line numbers, checking in order: Shebangs -> OPTIONS_GHC -> LANGUAGE--- Taking the max of these to account for the possibility of interchanging order of these three Pragma types-findNextPragmaPosition :: T.Text -> Range-findNextPragmaPosition contents = Range loc loc- where- loc = Position line 0- line = afterLangPragma . afterOptsGhc $ afterShebang- afterLangPragma = afterPragma "LANGUAGE" contents'- afterOptsGhc = afterPragma "OPTIONS_GHC" contents'- afterShebang = lastLineWithPrefix (T.isPrefixOf "#!") contents' 0- contents' = T.lines contents -afterPragma :: T.Text -> [T.Text] -> Int -> Int-afterPragma name contents lineNum = lastLineWithPrefix (checkPragma name) contents lineNum--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--checkPragma :: T.Text -> T.Text -> Bool-checkPragma name = check- where- check l = isPragma l && getName l == name- getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l- isPragma = T.isPrefixOf "{-#"-- stripLeading :: Char -> String -> String stripLeading _ [] = [] stripLeading c (s:ss)@@ -268,3 +286,6 @@ J.CompletionItem label (Just J.CiKeyword) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+++
test/Main.hs view
@@ -27,9 +27,23 @@ codeActionTests :: TestTree codeActionTests = testGroup "code actions"- [ codeActionTest "adds LANGUAGE with no other pragmas at start ignoring later INLINE pragma" "AddPragmaIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")]- , codeActionTest "adds LANGUAGE after shebang preceded by other LANGUAGE and GHC_OPTIONS" "AddPragmaAfterShebangPrecededByLangAndOptsGhc" [("Add \"TupleSections\"", "Contains TupleSections code action")]- , codeActionTest "adds LANGUAGE after shebang with other Language preceding shebang" "AddPragmaAfterShebangPrecededByLangAndOptsGhc" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ [ codeActionTest "Block comment then line comment doesn't split line" "BlockCommentThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then single-line block comment doesn't split line" "BlockCommentThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then multi-line block comment doesn't split line" "BlockCommentThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then line haddock splits line" "BlockCommentThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then single-line block haddock splits line" "BlockCommentThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then multi-line block haddock splits line" "BlockCommentThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then line comment doesn't split line" "PragmaThenLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then single-line block comment doesn't split line" "PragmaThenSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then multi-line block comment splits line" "PragmaThenMultiLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then line haddock splits line" "PragmaThenLineHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then single-line block haddock splits line" "PragmaThenSingleLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then multi-line block haddock splits line" "PragmaThenMultiLineBlockHaddock" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then single-line block haddock single-line block comment splits line" "PragmaThenSingleLineBlockHaddockSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Block comment then single-line block haddock single-line block comment splits line" "BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "Pragma then line haddock then newline line comment splits line" "PragmaThenLineHaddockNewlineLineComment" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "does not add pragma after OPTIONS_GHC pragma located after a declaration" "OptionsGhcAfterDecl" [("Add \"TupleSections\"", "Contains TupleSections code action")]+ , codeActionTest "adds LANGUAGE with no other pragmas at start ignoring later INLINE pragma" "AddPragmaIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")] , codeActionTest "adds LANGUAGE before Doc comments after interchanging pragmas" "BeforeDocInterchanging" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] , codeActionTest "Add language after altering OPTIONS_GHC and Language" "AddLanguagePragmaAfterInterchaningOptsGhcAndLangs" [("Add \"TupleSections\"", "Contains TupleSections code action")] , codeActionTest "Add language after pragmas with non standard space between prefix and name" "AddPragmaWithNonStandardSpacingInPrecedingPragmas" [("Add \"TupleSections\"", "Contains TupleSections code action")]@@ -67,7 +81,8 @@ codeActionTests' :: TestTree codeActionTests' = testGroup "additional code actions"- [ goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do+ [+ goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas@@ -83,8 +98,10 @@ completionTests :: TestTree completionTests =- testGroup "completions" [- completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]+ testGroup "completions"+ [ completionTest "completes pragmas" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-}") (Just "{-# LANGUAGE #-}") [0, 4, 0, 34, 0, 4]+ , completionTest "completes pragmas with existing closing pragma bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} ") (Just "{-# LANGUAGE #-}") [0, 4, 0, 31, 0, 4]+ , completionTest "completes pragmas with existing closing comment bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #") (Just "{-# LANGUAGE #-}") [0, 4, 0, 32, 0, 4] , completionTest "completes pragmas with existing closing bracket" "Completion.hs" "" "LANGUAGE" (Just Snippet) (Just "LANGUAGE ${1:extension} #-") (Just "{-# LANGUAGE #-}") [0, 4, 0, 33, 0, 4] , completionTest "completes options pragma" "Completion.hs" "OPTIONS" "OPTIONS_GHC" (Just Snippet) (Just "OPTIONS_GHC -${1:option} #-}") (Just "{-# OPTIONS_GHC #-}") [0, 4, 0, 34, 0, 4] , completionTest "completes ghc options pragma values" "Completion.hs" "{-# OPTIONS_GHC -Wno-red #-}\n" "Wno-redundant-constraints" Nothing Nothing Nothing [0, 0, 0, 0, 0, 24]@@ -94,7 +111,7 @@ , completionTest "completes No- language extensions" "Completion.hs" "NoOverload" "NoOverloadedStrings" Nothing Nothing Nothing [0, 13, 0, 31, 0, 23] ] -completionTest :: String -> String -> T.Text -> T.Text -> Maybe InsertTextFormat -> Maybe T.Text -> Maybe T.Text -> [Int] -> TestTree+completionTest :: String -> String -> T.Text -> T.Text -> Maybe InsertTextFormat -> Maybe T.Text -> Maybe T.Text -> [UInt] -> TestTree completionTest testComment fileName te' label textFormat insertText detail [a, b, c, d, x, y] = testCase testComment $ runSessionWithServer pragmasPlugin testDataDir $ do doc <- openDoc fileName "haskell"
+ test/testdata/BlockCommentThenLineComment.expected.hs view
@@ -0,0 +1,6 @@+{- block comment -} -- line comment+{-# LANGUAGE TupleSections #-}++module BlockCommentThenLineComment where++a = (1,)
+ test/testdata/BlockCommentThenLineComment.hs view
@@ -0,0 +1,5 @@+{- block comment -} -- line comment++module BlockCommentThenLineComment where++a = (1,)
+ test/testdata/BlockCommentThenLineHaddock.expected.hs view
@@ -0,0 +1,7 @@+{- block comment -} +{-# LANGUAGE TupleSections #-}+-- | line haddock++module BlockCommentThenLineHaddock where++a = (1,)
+ test/testdata/BlockCommentThenLineHaddock.hs view
@@ -0,0 +1,5 @@+{- block comment -} -- | line haddock++module BlockCommentThenLineHaddock where++a = (1,)
+ test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs view
@@ -0,0 +1,10 @@+{- block comment -} {- multi+line+block+comment+-}+{-# LANGUAGE TupleSections #-}++module BlockCommentThenMultiLineBlockComment where++a = (1,)
+ test/testdata/BlockCommentThenMultiLineBlockComment.hs view
@@ -0,0 +1,9 @@+{- block comment -} {- multi+line+block+comment+-}++module BlockCommentThenMultiLineBlockComment where++a = (1,)
+ test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs view
@@ -0,0 +1,13 @@+{- block comment -} +{-# LANGUAGE TupleSections #-}+{-| multi+line+block+haddock+-}++module BlockCommentThenMultiLineBlockHaddock where+import Data.List (intercalate)+import System.IO (hFlush)++a = (1,)
+ test/testdata/BlockCommentThenMultiLineBlockHaddock.hs view
@@ -0,0 +1,11 @@+{- block comment -} {-| multi+line+block+haddock+-}++module BlockCommentThenMultiLineBlockHaddock where+import Data.List (intercalate)+import System.IO (hFlush)++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs view
@@ -0,0 +1,6 @@+{- block comment -} {- single line block comment -}+{-# LANGUAGE TupleSections #-}++module BlockCommentThenSingleLineBlockComment where++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockComment.hs view
@@ -0,0 +1,5 @@+{- block comment -} {- single line block comment -}++module BlockCommentThenSingleLineBlockComment where++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs view
@@ -0,0 +1,7 @@+{- block comment -} +{-# LANGUAGE TupleSections #-}+{-| single line block haddock -}++module BlockCommentThenSingleLineBlockHaddock where++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockHaddock.hs view
@@ -0,0 +1,5 @@+{- block comment -} {-| single line block haddock -}++module BlockCommentThenSingleLineBlockHaddock where++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs view
@@ -0,0 +1,7 @@+{- block comment -} +{-# LANGUAGE TupleSections #-}+{-| single line block haddock -} {- single line block comment -}++module BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment where++a = (1,)
+ test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs view
@@ -0,0 +1,5 @@+{- block comment -} {-| single line block haddock -} {- single line block comment -}++module BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment where++a = (1,)
+ test/testdata/OptionsGhcAfterDecl.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TupleSections #-}+data Something = Something {+ foo :: !String,+ bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# OPTIONS_GHC addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/OptionsGhcAfterDecl.hs view
@@ -0,0 +1,10 @@+data Something = Something {+ foo :: !String,+ bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# OPTIONS_GHC addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} {-| haddock -}++module PragmaFollowedByBlockHaddock where++a = (1,)
+ test/testdata/PragmaThenLineComment.expected.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeApplications #-} -- line comment+{-# LANGUAGE TupleSections #-}++module PragmaThenLineComment where++a = (1,)
+ test/testdata/PragmaThenLineComment.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} -- line comment++module PragmaThenLineComment where++a = (1,)
+ test/testdata/PragmaThenLineHaddock.expected.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+-- | line haddock++module PragmaThenLineHaddock where++a = (1,)
+ test/testdata/PragmaThenLineHaddock.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} -- | line haddock++module PragmaThenLineHaddock where++a = (1,)
+ test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+-- | line haddock+-- line comment++module PragmaThenLineHaddockNewlineLineComment where++a = (1,)
+ test/testdata/PragmaThenLineHaddockNewlineLineComment.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeApplications #-} -- | line haddock+-- line comment++module PragmaThenLineHaddockNewlineLineComment where++a = (1,)
+ test/testdata/PragmaThenMultiLineBlockComment.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+{- multi+line+block+comment+-}++module PragmaThenSingleLineBlockComment where++a = (1,)
+ test/testdata/PragmaThenMultiLineBlockComment.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeApplications #-} {- multi+line+block+comment+-}++module PragmaThenSingleLineBlockComment where++a = (1,)
+ test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+{-| multi+line+block+haddock+-}++module PragmaThenMultiLineBlockHaddock where++a = (1,)
+ test/testdata/PragmaThenMultiLineBlockHaddock.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TypeApplications #-} {-| multi+line+block+haddock+-}++module PragmaThenMultiLineBlockHaddock where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockComment.expected.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TypeApplications #-} {- single line block comment -}+{-# LANGUAGE TupleSections #-}++module PragmaThenSingleLineBlockComment where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockComment.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} {- single line block comment -}++module PragmaThenSingleLineBlockComment where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+{-| single line block haddock -}++module PragmaThenSingleLineBlockHaddock where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockHaddock.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} {-| single line block haddock -}++module PragmaThenSingleLineBlockHaddock where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-}+{-| single line block haddock -} {- single line block comment -}++module PragmaThenSingleLineBlockHaddockSingleLineBlockComment where++a = (1,)
+ test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE TypeApplications #-} {-| single line block haddock -} {- single line block comment -}++module PragmaThenSingleLineBlockHaddockSingleLineBlockComment where++a = (1,)
test/testdata/hie.yaml view
@@ -1,6 +1,7 @@ cradle: direct: arguments:+ - "-XHaskell2010" - "NeedsPragmas" - "TypeApplications" - "NamedFieldPuns"