packages feed

hls-pragmas-plugin 1.0.0.1 → 1.0.1.0

raw patch · 43 files changed

+683/−136 lines, 43 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hls-pragmas-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               hls-pragmas-plugin-version:            1.0.0.1+version:            1.0.1.0 synopsis:           Pragmas plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -47,3 +47,4 @@     , hls-test-utils      >=1.0 && <1.2     , lens     , lsp-types+    , text
src/Ide/Plugin/Pragmas.hs view
@@ -14,6 +14,7 @@ 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)@@ -51,7 +52,7 @@   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)) endOfModuleHeader mbContents+      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 @@ -80,10 +81,16 @@  suggestDisableWarning :: Diagnostic -> [PragmaEdit] suggestDisableWarning Diagnostic {_code}-  | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code =+  | Just (J.InR (T.stripPrefix "-W" -> Just w)) <- _code+  , w `notElem` warningBlacklist =     pure ("Disable \"" <> w <> "\" warnings", OptGHC w)   | otherwise = [] +-- Don't suggest disabling type errors as a solution to all type errors+warningBlacklist :: [T.Text]+-- warningBlacklist = []+warningBlacklist = ["deferred-type-errors"]+ -- ---------------------------------------------------------------------  -- | Offer to add a missing Language Pragma to the top of a file.@@ -143,6 +150,9 @@  -- --------------------------------------------------------------------- +flags :: [T.Text]+flags = map (T.pack . stripLeading '-') $ flagsForCompletion False+ completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion completion _ide _ complParams = do     let (J.TextDocumentIdentifier uri) = complParams ^. J.textDocument@@ -153,12 +163,22 @@             result <$> VFS.getCompletionPrefix position cnts             where                 result (Just pfix)-                    | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix+                    | "{-# language" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)                     = J.List $ map buildCompletion                         (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)+                    | "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)+                    = 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 "}"))                     | otherwise                     = J.List []                 result Nothing = J.List []+                isPragmaPrefix line = "{-#" `T.isPrefixOf` line                 buildCompletion p =                     J.CompletionItem                       { _label = p,@@ -180,14 +200,71 @@                         _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 #-}")+  ]+  where suffix = case mSuffix of+                  (Just s) -> s+                  Nothing -> "" --- --------------------------------------------------------------------- --- | Find first line after (last pragma / last shebang / beginning of file).--- Useful for inserting pragmas.-endOfModuleHeader :: T.Text -> Range-endOfModuleHeader contents = Range loc loc-    where-        loc = Position line 0-        line = maybe 0 succ (lastLineWithPrefix "{-#" <|> lastLineWithPrefix "#!")-        lastLineWithPrefix pre = listToMaybe $ reverse $ findIndices (T.isPrefixOf pre) $ T.lines contents+mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem+mkPragmaCompl insertText label detail =+  J.CompletionItem label (Just J.CiKeyword) Nothing (Just 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 _ [] = []+stripLeading c (s:ss)+  | s == c = ss+  | otherwise = s:ss+++mkExtCompl :: T.Text -> J.CompletionItem+mkExtCompl label =+  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
@@ -4,6 +4,7 @@   ) where  import           Control.Lens            ((^.))+import qualified Data.Text               as T import qualified Ide.Plugin.Pragmas      as Pragmas import qualified Language.LSP.Types.Lens as L import           System.FilePath@@ -19,150 +20,95 @@ tests =   testGroup "pragmas"   [ codeActionTests+  , codeActionTests'   , completionTests   ]  codeActionTests :: TestTree codeActionTests =   testGroup "code actions"-  [ goldenWithPragmas "adds TypeSynonymInstances pragma" "NeedsPragmas" $ \doc -> do-      _ <- waitForDiagnosticsFromSource doc "typecheck"-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Add \"TypeSynonymInstances\"" `elem` map (^. L.title) cas @? "Contains TypeSynonymInstances code action"-      liftIO $ "Add \"FlexibleInstances\"" `elem` map (^. L.title) cas @? "Contains FlexibleInstances code action"-      executeCodeAction $ head cas+  [ 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 "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")]+  , codeActionTest "adds LANGUAGE after OptGHC at start ignoring later INLINE pragma" "AddPragmaAfterOptsGhcIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE ignore later Ann pragma" "AddPragmaIgnoreLaterAnnPragma" [("Add \"BangPatterns\"", "Contains BangPatterns code action")]+  , codeActionTest "adds LANGUAGE after interchanging pragmas ignoring later Ann pragma" "AddLanguageAfterInterchaningIgnoringLaterAnn" [("Add \"BangPatterns\"", "Contains BangPatterns code action")]+  , codeActionTest "adds LANGUAGE after OptGHC preceded by another language pragma" "AddLanguageAfterLanguageThenOptsGhc" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]+  , codeActionTest "adds LANGUAGE pragma after shebang and last language pragma" "AfterShebangAndPragma" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]+  , codeActionTest "adds above module keyword on first line" "ModuleOnFirstLine" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma after GHC_OPTIONS" "AfterGhcOptions" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma after shebang and GHC_OPTIONS" "AfterShebangAndOpts" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma after shebang, GHC_OPTIONS and language pragma" "AfterShebangAndOptionsAndPragma" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma after all others ignoring later INLINE pragma" "AfterShebangAndOptionsAndPragmasIgnoreInline" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma after all others ignoring multiple later INLINE pragma" "AfterAllWithMultipleInlines" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds LANGUAGE pragma correctly ignoring later INLINE pragma" "AddLanguagePragma" [("Add \"TupleSections\"", "Contains TupleSections code action")]+  , codeActionTest "adds TypeApplications pragma" "TypeApplications" [("Add \"TypeApplications\"", "Contains TypeApplications code action")]+  , codeActionTest "after shebang" "AfterShebang" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]+  , codeActionTest "append to existing pragmas" "AppendToExisting" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]+  , codeActionTest "before doc comments" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")]+  , codeActionTest "before doc comments" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")]+  , codeActionTest "before doc comments" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")]+  , codeActionTest "adds TypeSynonymInstances pragma" "NeedsPragmas" [("Add \"TypeSynonymInstances\"", "Contains TypeSynonymInstances code action"), ("Add \"FlexibleInstances\"", "Contains FlexibleInstances code action")]+  ] -  , goldenWithPragmas "adds TypeApplications pragma" "TypeApplications" $ \doc -> do-      _ <- waitForDiagnosticsFrom doc-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action"-      executeCodeAction $ head cas+codeActionTest :: String -> FilePath -> [(T.Text, String)] -> TestTree+codeActionTest testComment fp actions =+  goldenWithPragmas testComment fp $ \doc -> do+    _ <- waitForDiagnosticsFrom doc+    cas <- map fromAction <$> getAllCodeActions doc+    mapM_ (\(action, contains) -> go action contains cas) actions+    executeCodeAction $ head cas+    where+      go action contains cas = liftIO $ action `elem` map (^. L.title) cas @? contains -  , goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do+codeActionTests' :: TestTree+codeActionTests' =+  testGroup "additional code actions"+  [ 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       let ca = head cas       liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action"       executeCodeAction ca--  , goldenWithPragmas "after shebang" "AfterShebang" $ \doc -> do-      _ <- waitForDiagnosticsFrom doc-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"-      executeCodeAction $ head cas--  , goldenWithPragmas "append to existing pragmas" "AppendToExisting" $ \doc -> do-      _ <- waitForDiagnosticsFrom doc-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"-      executeCodeAction $ head cas--  , goldenWithPragmas "before doc comments" "BeforeDocComment" $ \doc -> do-      _ <- waitForDiagnosticsFrom doc-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Add \"NamedFieldPuns\"" `elem` map (^. L.title) cas @? "Contains NamedFieldPuns code action"-      executeCodeAction $ head cas--  , goldenWithPragmas "before doc comments" "MissingSignatures" $ \doc -> do-      _ <- waitForDiagnosticsFrom doc-      cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Disable \"missing-signatures\" warnings" `elem` map (^. L.title) cas @? "Contains missing-signatures code action"-      executeCodeAction $ head cas--  , goldenWithPragmas "before doc comments" "UnusedImports" $ \doc -> do+  , goldenWithPragmas "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do       _ <- waitForDiagnosticsFrom doc       cas <- map fromAction <$> getAllCodeActions doc-      liftIO $ "Disable \"unused-imports\" warnings" `elem` map (^. L.title) cas @? "Contains unused-imports code action"-      executeCodeAction $ head cas+      liftIO $ "Disable \"deferred-type-errors\" warnings" `notElem` map (^. L.title) cas @? "Doesn't contain deferred-type-errors code action"+      liftIO $ length cas == 0 @? "Expected no code actions, but got: " <> show cas   ]  completionTests :: TestTree completionTests =-  testGroup "completions"-  [ testCase "completes pragmas" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      _ <- waitForDiagnostics-      let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 4)-      let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "LANGUAGE"-        item ^. L.kind @?= Just CiKeyword-        item ^. L.insertTextFormat @?= Just Snippet-        item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}"--  , testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 4)-      let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "LANGUAGE"-        item ^. L.kind @?= Just CiKeyword-        item ^. L.insertTextFormat @?= Just Snippet-        item ^. L.insertText @?= Just "LANGUAGE ${1:extension}"--  , testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      _ <- waitForDiagnostics-      let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 4)-      let item = head $ filter ((== "OPTIONS_GHC") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "OPTIONS_GHC"-        item ^. L.kind @?= Just CiKeyword-        item ^. L.insertTextFormat @?= Just Snippet-        item ^. L.insertText @?= Just "OPTIONS_GHC -${1:option} #-}"--  , testCase "completes ghc options pragma values" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red  #-}\n"-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 24)-      let item = head $ filter ((== "Wno-redundant-constraints") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "Wno-redundant-constraints"-        item ^. L.kind @?= Just CiKeyword-        item ^. L.insertTextFormat @?= Nothing-        item ^. L.insertText @?= Nothing--  , testCase "completes language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      _ <- waitForDiagnostics-      let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 24)-      let item = head $ filter ((== "OverloadedStrings") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "OverloadedStrings"-        item ^. L.kind @?= Just CiKeyword--  , testCase "completes the Strict language extension" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      _ <- waitForDiagnostics-      let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 16)-      let item = head $ filter ((== "Strict") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "Strict"-        item ^. L.kind @?= Just CiKeyword--  , testCase "completes No- language extensions" $ runSessionWithServer pragmasPlugin testDataDir $ do-      doc <- openDoc "Completion.hs" "haskell"-      _ <- waitForDiagnostics-      let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"-      _ <- applyEdit doc te-      compls <- getCompletions doc (Position 0 23)-      let item = head $ filter ((== "NoOverloadedStrings") . (^. L.label)) compls-      liftIO $ do-        item ^. L.label @?= "NoOverloadedStrings"-        item ^. L.kind @?= Just CiKeyword+  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 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]+  , completionTest "completes language extensions" "Completion.hs" "" "OverloadedStrings" Nothing Nothing Nothing [0, 24, 0, 31, 0, 24]+  , completionTest "completes language extensions case insensitive" "Completion.hs" "lAnGuaGe Overloaded" "OverloadedStrings" Nothing Nothing Nothing [0, 4, 0, 34, 0, 24]+  , completionTest "completes the Strict language extension" "Completion.hs" "Str" "Strict" Nothing Nothing Nothing [0, 13, 0, 31, 0, 16]+  , 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 testComment fileName te' label textFormat insertText detail [a, b, c, d, x, y] =+  testCase testComment $ runSessionWithServer pragmasPlugin testDataDir $ do+    doc <- openDoc fileName "haskell"+    _ <- waitForDiagnostics+    let te = TextEdit (Range (Position a b) (Position c d)) te'+    _ <- applyEdit doc te+    compls <- getCompletions doc (Position x y)+    let item = head $ filter ((== label) . (^. L.label)) compls+    liftIO $ do+      item ^. L.label @?= label+      item ^. L.kind @?= Just CiKeyword+      item ^. L.insertTextFormat @?= textFormat+      item ^. L.insertText @?= insertText+      item ^. L.detail @?= detail  goldenWithPragmas :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithPragmas title path = goldenWithHaskellDoc pragmasPlugin title testDataDir path "expected" "hs"
+ test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.expected.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+{-# LANGUAGE BangPatterns #-}++data Metaprogram = Metaprogram+  { mp_name             :: !Text+  , mp_known_by_auto    :: !Bool+  , mp_show_code_action :: !Bool+  , mp_program          :: !(TacticsM ())+  }+  deriving stock Generic+{-# ANN Metaprogram "hello" #-}++instance NFData Metaprogram where+  rnf (!(Metaprogram !_ !_ !_ !_)) = ()
+ test/testdata/AddLanguageAfterInterchaningIgnoringLaterAnn.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}++data Metaprogram = Metaprogram+  { mp_name             :: !Text+  , mp_known_by_auto    :: !Bool+  , mp_show_code_action :: !Bool+  , mp_program          :: !(TacticsM ())+  }+  deriving stock Generic+{-# ANN Metaprogram "hello" #-}++instance NFData Metaprogram where+  rnf (!(Metaprogram !_ !_ !_ !_)) = ()
+ test/testdata/AddLanguageAfterLanguageThenOptsGhc.expected.hs view
@@ -0,0 +1,21 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE  OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+{-# LANGUAGE NamedFieldPuns #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++test :: Int -> Integer+test x = x * 2++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/AddLanguageAfterLanguageThenOptsGhc.hs view
@@ -0,0 +1,20 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE  OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++test :: Int -> Integer+test x = x * 2++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/AddLanguagePragma.expected.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module NeedsLanguagePragma where++tupleSection = (1,) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int+addOne x = x + 1
+ test/testdata/AddLanguagePragma.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++module NeedsLanguagePragma where++tupleSection = (1,) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int+addOne x = x + 1
+ test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.expected.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddLanguagePragmaAfterInterchaningOptsGhcAndLangs.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddOptsGhcAfterLanguage.expected.hs view
@@ -0,0 +1,12 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE  OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++test :: Int -> Integer+test x = x * 2
+ test/testdata/AddOptsGhcAfterLanguage.hs view
@@ -0,0 +1,11 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE  OverloadedStrings #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++test :: Int -> Integer+test x = x * 2
+ test/testdata/AddPragmaAfterOptsGhcIgnoreInline.expected.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE TupleSections #-}+data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AddPragmaAfterOptsGhcIgnoreInline.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -Wall #-}+data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.expected.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddPragmaAfterShebangPrecededByLangAndOptsGhc.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddPragmaAfterShebangPrecededByLanguage.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddPragmaAfterShebangPrecededByLanguage.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddPragmaIgnoreInline.expected.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TupleSections #-}+data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AddPragmaIgnoreInline.hs view
@@ -0,0 +1,10 @@+data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AddPragmaIgnoreLaterAnnPragma.expected.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE BangPatterns #-}+data Metaprogram = Metaprogram+  { mp_name             :: !Text+  , mp_known_by_auto    :: !Bool+  , mp_show_code_action :: !Bool+  , mp_program          :: !(TacticsM ())+  }+  deriving stock Generic+{-# ANN Metaprogram "hello" #-}++instance NFData Metaprogram where+  rnf (!(Metaprogram !_ !_ !_ !_)) = ()
+ test/testdata/AddPragmaIgnoreLaterAnnPragma.hs view
@@ -0,0 +1,11 @@+data Metaprogram = Metaprogram+  { mp_name             :: !Text+  , mp_known_by_auto    :: !Bool+  , mp_show_code_action :: !Bool+  , mp_program          :: !(TacticsM ())+  }+  deriving stock Generic+{-# ANN Metaprogram "hello" #-}++instance NFData Metaprogram where+  rnf (!(Metaprogram !_ !_ !_ !_)) = ()
+ test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.expected.hs view
@@ -0,0 +1,6 @@+{-#   OPTIONS_GHC -Wall #-}+{-#       LANGUAGE  OverloadedStrings #-}+{-#      OPTIONS_GHC -Wno-deferred-type-errors #-}+{-# LANGUAGE TupleSections #-}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AddPragmaWithNonStandardSpacingInPrecedingPragmas.hs view
@@ -0,0 +1,5 @@+{-#   OPTIONS_GHC -Wall #-}+{-#       LANGUAGE  OverloadedStrings #-}+{-#      OPTIONS_GHC -Wno-deferred-type-errors #-}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AfterAllWithMultipleInlines.expected.hs view
@@ -0,0 +1,22 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int+addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1
+ test/testdata/AfterAllWithMultipleInlines.hs view
@@ -0,0 +1,21 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int+addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1
+ test/testdata/AfterGhcOptions.expected.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1
+ test/testdata/AfterGhcOptions.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1++{-# INLINE subOne #-}+subOne :: Int -> Int+subOne x = x - 1
+ test/testdata/AfterShebangAndOptionsAndPragma.expected.hs view
@@ -0,0 +1,13 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AfterShebangAndOptionsAndPragma.hs view
@@ -0,0 +1,12 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.expected.hs view
@@ -0,0 +1,18 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AfterShebangAndOptionsAndPragmasIgnoreInline.hs view
@@ -0,0 +1,17 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2++{-# INLINE addOne #-}+addOne :: Int -> Int +addOne x = x + 1
+ test/testdata/AfterShebangAndOpts.expected.hs view
@@ -0,0 +1,12 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE TupleSections #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AfterShebangAndOpts.hs view
@@ -0,0 +1,11 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}++data Something = Something {+    foo :: !String,+    bar :: !Int+}++tupleSection = (1, ) <$> Just 2
+ test/testdata/AfterShebangAndPragma.expected.hs view
@@ -0,0 +1,16 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# LANGUAGE  OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/AfterShebangAndPragma.hs view
@@ -0,0 +1,15 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# LANGUAGE  OverloadedStrings #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/BeforeDocInterchanging.expected.hs view
@@ -0,0 +1,18 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+{-# LANGUAGE NamedFieldPuns #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/BeforeDocInterchanging.hs view
@@ -0,0 +1,17 @@+#! /usr/bin/env nix-shell+#! nix-shell --pure -i runghc -p "haskellPackages.ghcWithPackages (hp: with hp; [ turtle ])"+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}+-- | Doc Comment+{- Block -}++module BeforeDocComment where++data Record = Record+  { a :: Int,+    b :: Double,+    c :: String+  }++f Record{a, b} = a
+ test/testdata/DeferredTypeErrors.expected.hs view
@@ -0,0 +1,4 @@+module DeferredTypeErrors where++foo :: Int+foo = ()
+ test/testdata/DeferredTypeErrors.hs view
@@ -0,0 +1,4 @@+module DeferredTypeErrors where++foo :: Int+foo = ()
+ test/testdata/ModuleOnFirstLine.expected.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TupleSections #-}+module Main where++tupleSection = (1,) <$> Just 2
+ test/testdata/ModuleOnFirstLine.hs view
@@ -0,0 +1,3 @@+module Main where++tupleSection = (1,) <$> Just 2