diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 2def0e4121..dfce6d1841 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -32,6 +32,7 @@ module Development.IDE.GHC.Compat.Env ( -- * DynFlags Helper setBytecodeLinkerOptions, setInterpreterLinkerOptions, + Development.IDE.GHC.Compat.Env.safeImportsOn, -- * Ways Ways, Way, @@ -178,6 +179,13 @@ homeUnitId_ = thisPackage #endif +safeImportsOn :: DynFlags -> Bool +safeImportsOn = +#if MIN_VERSION_ghc(9,2,0) + Session.safeImportsOn +#else + DynFlags.safeImportsOn +#endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) type HomeUnit = Unit diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 450b0cf5ec..0a2375cd99 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -13,6 +13,9 @@ module Development.IDE.GHC.Compat.Parser ( Anno.ApiAnns(..), #else ApiAnns, +#endif +#if MIN_VERSION_ghc(9,0,0) + PsSpan(..), #endif mkHsParsedModule, mkParsedModule, @@ -24,6 +27,7 @@ module Development.IDE.GHC.Compat.Parser ( #if MIN_VERSION_ghc(9,0,0) import qualified GHC.Parser.Lexer as Lexer +import GHC.Types.SrcLoc (PsSpan (..)) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Config as Config import GHC.Parser.Lexer hiding (initParserState) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 18403161f2..0bc37618c5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -67,6 +67,8 @@ module Development.IDE.GHC.Compat.Util ( StringBuffer(..), hGetStringBuffer, stringToStringBuffer, + nextChar, + atEnd ) where #if MIN_VERSION_ghc(9,0,0) diff --git a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal index d1e70daaac..95e1c47932 100644 --- a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal +++ b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal @@ -24,6 +24,7 @@ library , base >=4.12 && <5 , extra , fuzzy + , ghc , ghcide >=1.2 && <1.6 , hls-plugin-api >=1.1 && <1.3 , lens @@ -31,6 +32,7 @@ library , text , transformers , unordered-containers + , containers default-language: Haskell2010 diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index af01fea2d6..7a6a62796c 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} @@ -10,24 +13,52 @@ module Ide.Plugin.Pragmas ( 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 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 @@ descriptor plId = (defaultPluginDescriptor plId) } -- --------------------------------------------------------------------- - -- | Title and pragma type PragmaEdit = (T.Text, Pragma) @@ -46,29 +76,56 @@ data Pragma = LangExt T.Text | OptGHC T.Text 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 = + if | Just sourceText <- fileContents + , let sourceStringBuffer = stringToStringBuffer (T.unpack sourceText) + , POk _ parserState <- parsePreDecl sessionDynFlags sourceStringBuffer + , let nextPragma = case parserState of + ParserStateNotDone { nextPragma } -> nextPragma + ParserStateDone { nextPragma } -> nextPragma + -> nextPragma + | otherwise + -> NextPragma 0 Nothing + 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 -> NextPragma -> PragmaEdit -> (J.Command J.|? J.CodeAction) +pragmaEditToAction uri NextPragma{ 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 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 (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 +206,6 @@ allPragmas = ] -- --------------------------------------------------------------------- - flags :: [T.Text] flags = map (T.pack . stripLeading '-') $ flagsForCompletion False @@ -217,7 +273,7 @@ validPragmas mSuffix = ] where suffix = case mSuffix of (Just s) -> s - Nothing -> "" + Nothing -> "" mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem @@ -226,35 +282,6 @@ mkPragmaCompl insertText label detail = 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 _ [] = [] @@ -268,3 +295,394 @@ mkExtCompl label = J.CompletionItem label (Just J.CiKeyword) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +-- Parser stuff ----------------------------------------------------- +-- | Each mode represents the "strongest" thing we've seen so far. +-- From strongest to weakest: +-- ModePragma, ModeHaddock, ModeComment, ModeInitial +data Mode = ModePragma | ModeHaddock | ModeComment | ModeInitial deriving Show + +data LineSplitTextEdits = LineSplitTextEdits { + lineSplitInsertTextEdit :: J.TextEdit, + lineSplitDeleteTextEdit :: J.TextEdit +} deriving Show + +data NextPragma = NextPragma { + nextPragmaLine :: Int, + lineSplitTextEdits :: Maybe LineSplitTextEdits +} deriving Show + +data ParserState + = ParserStateNotDone + { nextPragma :: !NextPragma + , mode :: !Mode + , lastBlockCommentLine :: !Int + , lastPragmaLine :: !Int + , isLastTokenHash :: !Bool + } + | ParserStateDone { nextPragma :: NextPragma } + deriving Show + +isPragma :: String -> Bool +isPragma = List.isPrefixOf "{-#" + +isDownwardBlockHaddock :: String -> Bool +isDownwardBlockHaddock = List.isPrefixOf "{-|" + +isDownwardLineHaddock :: String -> Bool +isDownwardLineHaddock = List.isPrefixOf "-- |" + +isLineComment :: String -> Bool +isLineComment = List.isPrefixOf "--" + +-- LSP spec describes the horizontal part of a Range as (paraphrasing) +-- "0-based positions between characters" +srcSpanToRange :: SrcSpan -> Maybe J.Range +srcSpanToRange srcSpan + | RealSrcLoc startRealSrcLoc _ <- srcSpanStart srcSpan + , RealSrcLoc endRealSrcLoc _ <- srcSpanEnd srcSpan + , let startLine = srcLocLine startRealSrcLoc + , let startCol = srcLocCol startRealSrcLoc + , let endLine = srcLocLine endRealSrcLoc + , let endCol = srcLocCol endRealSrcLoc + , let startPosition = J.Position (startLine - 1) (startCol - 1) + , let endPosition = J.Position (endLine - 1) endCol + , let range = J.Range startPosition endPosition + = Just range + | otherwise + = Nothing + +-- need to merge tokens that are deleted/inserted into one TextEdit each +-- to work around some weird TextEdits applied in reversed order issue +updateLineSplitTextEdits :: J.Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits +updateLineSplitTextEdits tokenRange tokenString prevLineSplitTextEdits + | Just prevLineSplitTextEdits <- prevLineSplitTextEdits + , let LineSplitTextEdits + { lineSplitInsertTextEdit = prevInsertTextEdit + , lineSplitDeleteTextEdit = prevDeleteTextEdit } = prevLineSplitTextEdits + , let J.TextEdit prevInsertRange prevInsertText = prevInsertTextEdit + , let J.TextEdit prevDeleteRange prevDeleteText = prevDeleteTextEdit + , let J.Range prevInsertStartPos prevInsertEndPos = prevInsertRange + , let J.Position prevInsertStartLine prevInsertStartCol = prevInsertStartPos + , let J.Position prevInsertEndLine prevInsertEndCol = prevInsertEndPos + , let J.Range prevDeleteStartPos prevDeleteEndPos = prevDeleteRange + , let J.Position prevDeleteStartLine prevDeleteStartCol = prevDeleteStartPos + , let J.Position prevDeleteEndLine prevDeleteEndCol = prevDeleteEndPos + , let currInsertRange = prevInsertRange + , let currInsertText = + T.init prevInsertText + <> T.replicate (startCol - prevDeleteEndCol) " " + <> T.pack (List.take newLineCol tokenString) + <> "\n" + , let currInsertTextEdit = J.TextEdit currInsertRange currInsertText + , let currDeleteStartPos = prevDeleteStartPos + , let currDeleteEndPos = J.Position endLine endCol + , let currDeleteRange = J.Range currDeleteStartPos currDeleteEndPos + , let currDeleteTextEdit = J.TextEdit currDeleteRange "" + = LineSplitTextEdits currInsertTextEdit currDeleteTextEdit + | otherwise + , let J.Range startPos _ = tokenRange + , let deleteTextEdit = J.TextEdit (J.Range startPos startPos{ J._character = startCol + newLineCol }) "" + , let insertPosition = J.Position (startLine + 1) 0 + , let insertRange = J.Range insertPosition insertPosition + , let insertText = T.pack (List.take newLineCol tokenString) <> "\n" + , let insertTextEdit = J.TextEdit insertRange insertText + = LineSplitTextEdits insertTextEdit deleteTextEdit + where + J.Range (J.Position startLine startCol) (J.Position endLine endCol) = tokenRange + + newLineCol = Maybe.fromMaybe (length tokenString) (List.elemIndex '\n' tokenString) + +-- ITvarsym "#" after a block comment is a parse error so we don't need to worry about it +updateParserState :: Token -> J.Range -> ParserState -> ParserState +updateParserState token range prevParserState + | ParserStateNotDone + { nextPragma = prevNextPragma@NextPragma{ lineSplitTextEdits = prevLineSplitTextEdits } + , mode = prevMode + , lastBlockCommentLine + , lastPragmaLine + } <- prevParserState + , let defaultParserState = prevParserState { isLastTokenHash = False } + , let J.Range (J.Position startLine _) (J.Position endLine _) = range + = case prevMode of + ModeInitial -> + case token of + ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } + ITlineComment s + | isDownwardLineHaddock s -> defaultParserState{ mode = ModeHaddock } + | otherwise -> + defaultParserState + { nextPragma = NextPragma (endLine + 1) Nothing + , mode = ModeComment } + ITblockComment s + | isPragma s -> + defaultParserState + { nextPragma = NextPragma (endLine + 1) Nothing + , mode = ModePragma + , lastPragmaLine = endLine } + | isDownwardBlockHaddock s -> defaultParserState{ mode = ModeHaddock } + | otherwise -> + defaultParserState + { nextPragma = NextPragma (endLine + 1) Nothing + , mode = ModeComment + , lastBlockCommentLine = endLine } + _ -> ParserStateDone prevNextPragma + ModeComment -> + case token of + ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } + ITlineComment s + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | isDownwardLineHaddock s + , lastBlockCommentLine == startLine + , let currLineSplitTextEdits = updateLineSplitTextEdits range s Nothing -> + defaultParserState + { nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } + , mode = ModeHaddock } + | otherwise -> + defaultParserState { nextPragma = NextPragma (endLine + 1) Nothing } + ITblockComment s + | isPragma s -> + defaultParserState + { nextPragma = NextPragma (endLine + 1) Nothing + , mode = ModePragma + , lastPragmaLine = endLine } + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | isDownwardBlockHaddock s + , lastBlockCommentLine == startLine + , let currLineSplitTextEdits = updateLineSplitTextEdits range s Nothing -> + defaultParserState{ + nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits }, + mode = ModeHaddock } + | otherwise -> + defaultParserState{ + nextPragma = NextPragma (endLine + 1) Nothing, + lastBlockCommentLine = endLine } + _ -> ParserStateDone prevNextPragma + ModeHaddock -> + case token of + ITvarsym "#" -> + defaultParserState{ isLastTokenHash = True } + ITlineComment s + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | otherwise -> + defaultParserState + ITblockComment s + | isPragma s -> + defaultParserState{ + nextPragma = NextPragma (endLine + 1) Nothing, + mode = ModePragma, + lastPragmaLine = endLine } + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | otherwise -> defaultParserState{ lastBlockCommentLine = endLine } + _ -> ParserStateDone prevNextPragma + ModePragma -> + case token of + ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } + ITlineComment s + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | isDownwardLineHaddock s + , lastPragmaLine == startLine + , let currLineSplitTextEdits = updateLineSplitTextEdits range s Nothing -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | otherwise -> + defaultParserState + ITblockComment s + | isPragma s -> + defaultParserState{ nextPragma = NextPragma (endLine + 1) Nothing, lastPragmaLine = endLine } + | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits + , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | isDownwardBlockHaddock s + , lastPragmaLine == startLine + , let currLineSplitTextEdits = updateLineSplitTextEdits range s Nothing -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | lastPragmaLine == startLine && startLine < endLine + , let currLineSplitTextEdits = updateLineSplitTextEdits range s Nothing -> + defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } + | otherwise -> + defaultParserState{ lastBlockCommentLine = endLine } + _ -> ParserStateDone prevNextPragma + | otherwise = prevParserState + where + hasDeleteStartedOnSameLine :: Int -> Maybe LineSplitTextEdits -> Bool + hasDeleteStartedOnSameLine line lineSplitTextEdits + | Just lineSplitTextEdits <- lineSplitTextEdits + , let LineSplitTextEdits{ lineSplitDeleteTextEdit } = lineSplitTextEdits + , let J.TextEdit deleteRange _ = lineSplitDeleteTextEdit + , let J.Range _ deleteEndPosition = deleteRange + , let J.Position deleteEndLine _ = deleteEndPosition + = deleteEndLine == line + | otherwise = False + +lexUntilNextLineIncl :: P (Located Token) +lexUntilNextLineIncl = do + PState{ last_loc } <- getPState +#if MIN_VERSION_ghc(9,0,0) + let PsSpan{ psRealSpan = lastRealSrcSpan } = last_loc +#else + let lastRealSrcSpan = last_loc +#endif + let prevEndLine = lastRealSrcSpan & realSrcSpanEnd & srcLocLine + locatedToken@(L srcSpan token) <- lexer False pure + if | RealSrcLoc currEndRealSrcLoc _ <- srcSpan & srcSpanEnd + , let currEndLine = currEndRealSrcLoc & srcLocLine + -> if prevEndLine < currEndLine then + pure locatedToken + else lexUntilNextLineIncl + | otherwise -> pure locatedToken + +dropWhileStringBuffer :: (Char -> Bool) -> StringBuffer -> StringBuffer +dropWhileStringBuffer predicate buffer + | atEnd buffer = buffer + | let (c, remainingBuffer) = nextChar buffer + = if predicate c then + dropWhileStringBuffer predicate remainingBuffer + else + buffer + +isHorizontalSpace :: Char -> Bool +isHorizontalSpace c = c == ' ' || c == '\t' + +data ShebangParserState = ShebangParserState { + nextPragmaLine :: !Int, + newlineCount :: !Int, + prevCharIsHash :: !Bool, + buffer :: !StringBuffer +} + +-- lexer seems to ignore shebangs completely hence this function +parseShebangs :: ShebangParserState -> ShebangParserState +parseShebangs prev@ShebangParserState{ nextPragmaLine, newlineCount = prevNewlineCount, prevCharIsHash, buffer = prevBuffer } + | atEnd prevBuffer + = prev + | let (c, currBuffer) = nextChar (dropWhileStringBuffer isHorizontalSpace prevBuffer) + = if c == '#' then + parseShebangs prev{ prevCharIsHash = True, buffer = currBuffer } + else if c == '!' && prevCharIsHash then + parseShebangs prev{ nextPragmaLine = prevNewlineCount + 1, buffer = dropWhileStringBuffer (/= '\n') currBuffer } + else if c == '\n' then + parseShebangs prev{ newlineCount = prevNewlineCount + 1, buffer = currBuffer } + else + prev + + +-- | Parses blank lines, comments, haddock comments ("-- |"), lines that start +-- with "#!", lines that start with "#", pragma lines using the GHC API lexer. +-- When it doesn't find one of these things then it's assumed that we've found +-- a declaration, end-of-file, or a ghc parse error, and the parser stops. +-- Shebangs are parsed separately than the rest becaues the lexer ignores them. +-- +-- The reason for custom parsing instead of using annotations, or turning on/off +-- extensions in the dynflags is because there are a number of extensions that +-- while removing parse errors, can also introduce them. Hence, there are +-- cases where the file cannot be parsed without error when we want to insert +-- extension (and other) pragmas. The compiler (8.10.7) doesn't include +-- annotations in its failure state. So if the compiler someday returns +-- annotation or equivalent information when it fails then we can replace this +-- with that. +-- +-- The reason for using the compiler lexer is to reduce duplicated +-- implementation, particularly nested comments, but in retrospect this comes +-- with the disadvantage of the logic feeling more complex, and not being able +-- to handle whitespace directly. +-- +-- The parser keeps track of state in order to place the next pragma line +-- according to some rules: +-- +-- - Ignore lines starting with '#' except for shebangs. +-- - If pragmas exist place after last pragma +-- - else if haddock comments exist: +-- - If comments exist place after last comment +-- - else if shebangs exist place after last shebang +-- - else place at first line +-- - else if comments exist place after last comment +-- - else if shebangs exist place after last shebang +-- - else place at first line +-- +-- Additionally the parser keeps track of information to be able to insert +-- pragmas inbetween lines. +-- +-- For example the parser keeps track of information so that +-- +-- > {- block comment -} -- | haddock +-- +-- can become +-- +-- > {- block comment -} +-- > {-# pragma #-} +-- > -- | haddock +-- +-- This information does not respect the type of whitespace, because the lexer +-- strips whitespace and gives locations. +-- +-- In this example the tabs are converted to spaces in the TextEdits: +-- +-- > {- block comment -}-- | haddock +-- +parsePreDecl :: DynFlags -> StringBuffer -> ParseResult ParserState +parsePreDecl dynFlags buffer = unP (go initialParserState) pState + where + initialShebangParserState = ShebangParserState{ + nextPragmaLine = 0, + newlineCount = 0, + prevCharIsHash = False, + buffer = buffer } + ShebangParserState{ nextPragmaLine } = parseShebangs initialShebangParserState + pState = mkLexerPState dynFlags buffer + initialParserState = ParserStateNotDone (NextPragma nextPragmaLine Nothing) ModeInitial (-1) (-1) False + + go :: ParserState -> P ParserState + go prevParserState = + case prevParserState of + ParserStateDone _ -> pure prevParserState + ParserStateNotDone{..} -> do + L srcSpan token <- + if isLastTokenHash then + lexUntilNextLineIncl + else + lexer False pure + case D.srcSpanToRange srcSpan of + Just range -> go (updateParserState token range prevParserState) + Nothing -> pure prevParserState + +mkLexerPState :: DynFlags -> StringBuffer -> PState +mkLexerPState dynFlags stringBuffer = + let + startRealSrcLoc = mkRealSrcLoc "asdf" 1 1 + updateDynFlags = flip gopt_unset Opt_Haddock . flip gopt_set Opt_KeepRawTokenStream + finalDynFlags = updateDynFlags dynFlags +#if !MIN_VERSION_ghc(8,8,1) + pState = mkPState finalDynFlags stringBuffer startRealSrcLoc + finalPState = pState{ use_pos_prags = False } +#elif !MIN_VERSION_ghc(8,10,1) + mkLexerParserFlags = + mkParserFlags' + <$> warningFlags + <*> extensionFlags + <*> homeUnitId_ + <*> safeImportsOn + <*> gopt Opt_Haddock + <*> gopt Opt_KeepRawTokenStream + <*> const False + finalPState = mkPStatePure (mkLexerParserFlags dynFlags) stringBuffer startRealSrcLoc +#else + pState = mkPState finalDynFlags stringBuffer startRealSrcLoc + PState{ options = pStateOptions } = pState + finalExtBitsMap = setBit (pExtsBitmap pStateOptions) (fromEnum UsePosPragsBit) + finalPStateOptions = pStateOptions{ pExtsBitmap = finalExtBitsMap } + finalPState = pState{ options = finalPStateOptions } +#endif + in + finalPState + + diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index ee62d80417..7229032a14 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -27,9 +27,24 @@ tests = 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 +82,8 @@ codeActionTest testComment fp actions = 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 diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.expected.hs new file mode 100644 index 0000000000..63bfdcc6f1 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.expected.hs @@ -0,0 +1,6 @@ +{- block comment -} -- line comment +{-# LANGUAGE TupleSections #-} + +module BlockCommentThenLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.hs new file mode 100644 index 0000000000..57f1a06c95 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineComment.hs @@ -0,0 +1,5 @@ +{- block comment -} -- line comment + +module BlockCommentThenLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.expected.hs new file mode 100644 index 0000000000..052321006e --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.expected.hs @@ -0,0 +1,7 @@ +{- block comment -} +{-# LANGUAGE TupleSections #-} +-- | line haddock + +module BlockCommentThenLineHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.hs new file mode 100644 index 0000000000..bcfa9069c6 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenLineHaddock.hs @@ -0,0 +1,5 @@ +{- block comment -} -- | line haddock + +module BlockCommentThenLineHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs new file mode 100644 index 0000000000..e1cebffbd7 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs @@ -0,0 +1,10 @@ +{- block comment -} {- multi +line +block +comment +-} +{-# LANGUAGE TupleSections #-} + +module BlockCommentThenMultiLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.hs new file mode 100644 index 0000000000..8eb3f0a92d --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockComment.hs @@ -0,0 +1,9 @@ +{- block comment -} {- multi +line +block +comment +-} + +module BlockCommentThenMultiLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs new file mode 100644 index 0000000000..ebb2c9c618 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs @@ -0,0 +1,13 @@ +{- block comment -} +{-# LANGUAGE TupleSections #-} +{-| multi +line +block +haddock +-} + +module BlockCommentThenMultiLineBlockHaddock where +import GHC.SourceGen (multiIf) +import Diagrams (block) + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs new file mode 100644 index 0000000000..506c33474c --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs @@ -0,0 +1,11 @@ +{- block comment -} {-| multi +line +block +haddock +-} + +module BlockCommentThenMultiLineBlockHaddock where +import GHC.SourceGen (multiIf) +import Diagrams (block) + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs new file mode 100644 index 0000000000..2e9e5c8781 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs @@ -0,0 +1,6 @@ +{- block comment -} {- single line block comment -} +{-# LANGUAGE TupleSections #-} + +module BlockCommentThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.hs new file mode 100644 index 0000000000..f8f6c0158d --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{- block comment -} {- single line block comment -} + +module BlockCommentThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs new file mode 100644 index 0000000000..04e664101c --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs @@ -0,0 +1,7 @@ +{- block comment -} +{-# LANGUAGE TupleSections #-} +{-| single line block haddock -} + +module BlockCommentThenSingleLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs new file mode 100644 index 0000000000..3bbb81ef04 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{- block comment -} {-| single line block haddock -} + +module BlockCommentThenSingleLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs new file mode 100644 index 0000000000..aa886340b9 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs @@ -0,0 +1,7 @@ +{- block comment -} +{-# LANGUAGE TupleSections #-} +{-| single line block haddock -} {- single line block comment -} + +module BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs new file mode 100644 index 0000000000..b28de4d0dc --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{- block comment -} {-| single line block haddock -} {- single line block comment -} + +module BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.expected.hs new file mode 100644 index 0000000000..21da00f779 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.expected.hs @@ -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 diff --git a/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.hs b/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.hs new file mode 100644 index 0000000000..c61dc893a3 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/OptionsGhcAfterDecl.hs @@ -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 diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs new file mode 100644 index 0000000000..558bc744be --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| haddock -} + +module PragmaFollowedByBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.expected.hs new file mode 100644 index 0000000000..7c78855a5c --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.expected.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} -- line comment +{-# LANGUAGE TupleSections #-} + +module PragmaThenLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.hs new file mode 100644 index 0000000000..9120cc3e31 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} -- line comment + +module PragmaThenLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.expected.hs new file mode 100644 index 0000000000..07fba12351 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +-- | line haddock + +module PragmaThenLineHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.hs new file mode 100644 index 0000000000..fa58dbd564 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} -- | line haddock + +module PragmaThenLineHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs new file mode 100644 index 0000000000..e9a671727f --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +-- | line haddock +-- line comment + +module PragmaThenLineHaddockNewlineLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs new file mode 100644 index 0000000000..ea4f3d0ee9 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} -- | line haddock +-- line comment + +module PragmaThenLineHaddockNewlineLineComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.expected.hs new file mode 100644 index 0000000000..0003b1834b --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +{- multi +line +block +comment +-} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.hs new file mode 100644 index 0000000000..dd3605dd46 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockComment.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} {- multi +line +block +comment +-} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs new file mode 100644 index 0000000000..cac02d6617 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +{-| multi +line +block +haddock +-} + +module PragmaThenMultiLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.hs new file mode 100644 index 0000000000..b51f8af6d3 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenMultiLineBlockHaddock.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} {-| multi +line +block +haddock +-} + +module PragmaThenMultiLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.expected.hs new file mode 100644 index 0000000000..d4dddb9134 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.expected.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} {- single line block comment -} +{-# LANGUAGE TupleSections #-} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.hs new file mode 100644 index 0000000000..0fe715bfb1 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {- single line block comment -} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs new file mode 100644 index 0000000000..9553c23ef8 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +{-| single line block haddock -} + +module PragmaThenSingleLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.hs new file mode 100644 index 0000000000..5cf8336bf4 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| single line block haddock -} + +module PragmaThenSingleLineBlockHaddock where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs new file mode 100644 index 0000000000..459f1a83d5 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +{-| single line block haddock -} {- single line block comment -} + +module PragmaThenSingleLineBlockHaddockSingleLineBlockComment where + +a = (1,) diff --git a/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs new file mode 100644 index 0000000000..5de9892518 --- /dev/null +++ b/plugins/hls-pragmas-plugin/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| single line block haddock -} {- single line block comment -} + +module PragmaThenSingleLineBlockHaddockSingleLineBlockComment where + +a = (1,)