diff --git a/hls-pragmas-plugin.cabal b/hls-pragmas-plugin.cabal --- a/hls-pragmas-plugin.cabal +++ b/hls-pragmas-plugin.cabal @@ -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 @@ -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 diff --git a/src/Ide/Plugin/Pragmas.hs b/src/Ide/Plugin/Pragmas.hs --- a/src/Ide/Plugin/Pragmas.hs +++ b/src/Ide/Plugin/Pragmas.hs @@ -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 + + + diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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" diff --git a/test/testdata/BlockCommentThenLineComment.expected.hs b/test/testdata/BlockCommentThenLineComment.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenLineComment.expected.hs @@ -0,0 +1,6 @@ +{- block comment -} -- line comment +{-# LANGUAGE TupleSections #-} + +module BlockCommentThenLineComment where + +a = (1,) diff --git a/test/testdata/BlockCommentThenLineComment.hs b/test/testdata/BlockCommentThenLineComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenLineComment.hs @@ -0,0 +1,5 @@ +{- block comment -} -- line comment + +module BlockCommentThenLineComment where + +a = (1,) diff --git a/test/testdata/BlockCommentThenLineHaddock.expected.hs b/test/testdata/BlockCommentThenLineHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenLineHaddock.expected.hs @@ -0,0 +1,7 @@ +{- block comment -} +{-# LANGUAGE TupleSections #-} +-- | line haddock + +module BlockCommentThenLineHaddock where + +a = (1,) diff --git a/test/testdata/BlockCommentThenLineHaddock.hs b/test/testdata/BlockCommentThenLineHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenLineHaddock.hs @@ -0,0 +1,5 @@ +{- block comment -} -- | line haddock + +module BlockCommentThenLineHaddock where + +a = (1,) diff --git a/test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs b/test/testdata/BlockCommentThenMultiLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/BlockCommentThenMultiLineBlockComment.hs b/test/testdata/BlockCommentThenMultiLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenMultiLineBlockComment.hs @@ -0,0 +1,9 @@ +{- block comment -} {- multi +line +block +comment +-} + +module BlockCommentThenMultiLineBlockComment where + +a = (1,) diff --git a/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs b/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenMultiLineBlockHaddock.expected.hs @@ -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,) diff --git a/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs b/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenMultiLineBlockHaddock.hs @@ -0,0 +1,11 @@ +{- block comment -} {-| multi +line +block +haddock +-} + +module BlockCommentThenMultiLineBlockHaddock where +import Data.List (intercalate) +import System.IO (hFlush) + +a = (1,) diff --git a/test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs b/test/testdata/BlockCommentThenSingleLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/BlockCommentThenSingleLineBlockComment.hs b/test/testdata/BlockCommentThenSingleLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{- block comment -} {- single line block comment -} + +module BlockCommentThenSingleLineBlockComment where + +a = (1,) diff --git a/test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs b/test/testdata/BlockCommentThenSingleLineBlockHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs b/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/BlockCommentThenSingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{- block comment -} {-| single line block haddock -} + +module BlockCommentThenSingleLineBlockHaddock where + +a = (1,) diff --git a/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs b/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs b/test/testdata/BlockCommentThenSingleLineBlockHaddockSingleLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/OptionsGhcAfterDecl.expected.hs b/test/testdata/OptionsGhcAfterDecl.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/OptionsGhcAfterDecl.hs b/test/testdata/OptionsGhcAfterDecl.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs b/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaFollowedBySingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| haddock -} + +module PragmaFollowedByBlockHaddock where + +a = (1,) diff --git a/test/testdata/PragmaThenLineComment.expected.hs b/test/testdata/PragmaThenLineComment.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenLineComment.expected.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} -- line comment +{-# LANGUAGE TupleSections #-} + +module PragmaThenLineComment where + +a = (1,) diff --git a/test/testdata/PragmaThenLineComment.hs b/test/testdata/PragmaThenLineComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenLineComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} -- line comment + +module PragmaThenLineComment where + +a = (1,) diff --git a/test/testdata/PragmaThenLineHaddock.expected.hs b/test/testdata/PragmaThenLineHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenLineHaddock.expected.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} +-- | line haddock + +module PragmaThenLineHaddock where + +a = (1,) diff --git a/test/testdata/PragmaThenLineHaddock.hs b/test/testdata/PragmaThenLineHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenLineHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} -- | line haddock + +module PragmaThenLineHaddock where + +a = (1,) diff --git a/test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs b/test/testdata/PragmaThenLineHaddockNewlineLineComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs b/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenLineHaddockNewlineLineComment.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} -- | line haddock +-- line comment + +module PragmaThenLineHaddockNewlineLineComment where + +a = (1,) diff --git a/test/testdata/PragmaThenMultiLineBlockComment.expected.hs b/test/testdata/PragmaThenMultiLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenMultiLineBlockComment.hs b/test/testdata/PragmaThenMultiLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenMultiLineBlockComment.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} {- multi +line +block +comment +-} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs b/test/testdata/PragmaThenMultiLineBlockHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenMultiLineBlockHaddock.hs b/test/testdata/PragmaThenMultiLineBlockHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenMultiLineBlockHaddock.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} {-| multi +line +block +haddock +-} + +module PragmaThenMultiLineBlockHaddock where + +a = (1,) diff --git a/test/testdata/PragmaThenSingleLineBlockComment.expected.hs b/test/testdata/PragmaThenSingleLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenSingleLineBlockComment.hs b/test/testdata/PragmaThenSingleLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {- single line block comment -} + +module PragmaThenSingleLineBlockComment where + +a = (1,) diff --git a/test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs b/test/testdata/PragmaThenSingleLineBlockHaddock.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenSingleLineBlockHaddock.hs b/test/testdata/PragmaThenSingleLineBlockHaddock.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenSingleLineBlockHaddock.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| single line block haddock -} + +module PragmaThenSingleLineBlockHaddock where + +a = (1,) diff --git a/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs b/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.expected.hs new file mode 100644 --- /dev/null +++ b/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/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs b/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs new file mode 100644 --- /dev/null +++ b/test/testdata/PragmaThenSingleLineBlockHaddockSingleLineBlockComment.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} {-| single line block haddock -} {- single line block comment -} + +module PragmaThenSingleLineBlockHaddockSingleLineBlockComment where + +a = (1,) diff --git a/test/testdata/hie.yaml b/test/testdata/hie.yaml --- a/test/testdata/hie.yaml +++ b/test/testdata/hie.yaml @@ -1,6 +1,7 @@ cradle: direct: arguments: + - "-XHaskell2010" - "NeedsPragmas" - "TypeApplications" - "NamedFieldPuns"