From 1a58fe49d62ad7ec3d2d7e43a8e17b9c54a1e46d Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 26 Apr 2024 21:38:36 +0800 Subject: [PATCH 1/2] migrate ghcide-tests CompletionTests to hls-test-utils --- ghcide/test/exe/CompletionTests.hs | 90 ++++++++++++++++-------------- 1 file changed, 48 insertions(+), 42 deletions(-) diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index cf3198e74d..224b8e99c7 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -1,9 +1,13 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module CompletionTests (tests) where +import Config import Control.Lens ((^.)) import qualified Control.Lens as Lens import Control.Monad @@ -14,7 +18,6 @@ import Data.Maybe import Data.Row import qualified Data.Text as T import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) -import Development.IDE.Test (waitForTypecheck) import Development.IDE.Types.Location import Ide.Plugin.Config import qualified Language.LSP.Protocol.Lens as L @@ -25,10 +28,13 @@ import Language.LSP.Protocol.Types hiding SemanticTokensEdit (..), mkRange) import Language.LSP.Test -import System.FilePath +import Test.Hls (knownBrokenInEnv, + waitForTypecheck) +import qualified Test.Hls.FileSystem as FS +import Test.Hls.FileSystem (file, text) +import Test.Hls.Util (knownBrokenOnWindows) import Test.Tasty import Test.Tasty.HUnit -import TestUtils tests :: TestTree @@ -44,9 +50,19 @@ tests , testGroup "doc" completionDocTests ] +testSessionPluginEmpty :: TestName -> Session () -> TestTree +testSessionPluginEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]]) + +testSessionPluginEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree +testSessionPluginEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)]) + +testSessionPluginSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree +testSessionPluginSingleFile testName fp txt session = + testWithDummyPlugin testName (mkIdeTestFs [FS.directCradle [T.pack fp] , file fp (text txt)]) session + completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, CompletionItemKind, T.Text, Bool, Bool, Maybe [TextEdit])] -> TestTree -completionTest name src pos expected = testSessionWait name $ do - docId <- createDoc "A.hs" "haskell" (T.unlines src) +completionTest name src pos expected = testSessionPluginSingleFile name "A.hs" (T.unlines src) $ do + docId <- openDoc "A.hs" "haskell" _ <- waitForDiagnostics compls <- getAndResolveCompletions docId pos let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls] @@ -185,7 +201,7 @@ localCompletionTests = [ [("abcd", CompletionItemKind_Function, "abcd", True, False, Nothing) ,("abcde", CompletionItemKind_Function, "abcde", True, False, Nothing) ], - testSessionWait "incomplete entries" $ do + testSessionPluginEmpty "incomplete entries" $ do let src a = "data Data = " <> a doc <- createDoc "A.hs" "haskell" $ src "AAA" void $ waitForTypecheck doc @@ -261,7 +277,7 @@ nonLocalCompletionTests = [] ] where - brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC92, GHC94, GHC96, GHC98]) "Windows has strange things in scope for some reason" + brokenForWinGhc = knownBrokenOnWindows "Windows has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ @@ -283,7 +299,7 @@ otherCompletionTests = [ (Position 3 11) [("Integer", CompletionItemKind_Struct, "Integer", True, True, Nothing)], - testSession "duplicate record fields" $ do + testSessionPluginEmpty "duplicate record fields" $ do void $ createDoc "B.hs" "haskell" $ T.unlines @@ -304,22 +320,21 @@ otherCompletionTests = [ let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"] liftIO $ take 1 compls' @?= ["member"], - testSessionWait "maxCompletions" $ do + testSessionPluginEmpty "maxCompletions" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "a = Prelude." ] _ <- waitForDiagnostics - compls <- getCompletions doc (Position 3 13) + compls <- getCompletions doc (Position 3 13) liftIO $ length compls @?= maxCompletions def ] packageCompletionTests :: [TestTree] packageCompletionTests = - [ testSession' "fromList" $ \dir -> do - liftIO $ writeFile (dir "hie.yaml") - "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" + [ testSessionPluginEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do + doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -337,9 +352,9 @@ packageCompletionTests = map ("Defined in "<>) ( [ "'Data.List.NonEmpty" , "'GHC.Exts" - ] ++ if ghcVersion >= GHC94 then [ "'GHC.IsList" ] else []) + ] ++ (["'GHC.IsList" | ghcVersion >= GHC94])) - , testSessionWait "Map" $ do + , testSessionPluginEmpty "Map" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -359,7 +374,7 @@ packageCompletionTests = , "'Data.Map.Lazy" , "'Data.Map.Strict" ] - , testSessionWait "no duplicates" $ do + , testSessionPluginEmpty "no duplicates" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -381,7 +396,7 @@ packageCompletionTests = ) compls liftIO $ length duplicate @?= 1 - , testSessionWait "non-local before global" $ do + , testSessionPluginEmpty "non-local before global" $ do -- non local completions are more specific doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", @@ -402,9 +417,7 @@ packageCompletionTests = projectCompletionTests :: [TestTree] projectCompletionTests = - [ testSession' "from hiedb" $ \dir-> do - liftIO $ writeFile (dir "hie.yaml") - "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" + [ testSessionPluginEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", "anidentifier = ()" @@ -423,9 +436,7 @@ projectCompletionTests = , _label == "anidentifier" ] liftIO $ compls' @?= ["Defined in 'A"], - testSession' "auto complete project imports" $ \dir-> do - liftIO $ writeFile (dir "hie.yaml") - "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" + testSessionPluginEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do _ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines [ "module ALocalModule (anidentifier) where", "anidentifier = ()" @@ -440,9 +451,7 @@ projectCompletionTests = let item = head $ filter ((== "ALocalModule") . (^. L.label)) compls liftIO $ do item ^. L.label @?= "ALocalModule", - testSession' "auto complete functions from qualified imports without alias" $ \dir-> do - liftIO $ writeFile (dir "hie.yaml") - "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" + testSessionPluginEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", "anidentifier = ()" @@ -457,9 +466,8 @@ projectCompletionTests = let item = head compls liftIO $ do item ^. L.label @?= "anidentifier", - testSession' "auto complete functions from qualified imports with alias" $ \dir-> do - liftIO $ writeFile (dir "hie.yaml") - "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" + testSessionPluginEmptyWithCradle "auto complete functions from qualified imports with alias" + "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", "anidentifier = ()" @@ -478,7 +486,7 @@ projectCompletionTests = completionDocTests :: [TestTree] completionDocTests = - [ testSession "local define" $ do + [ testSessionPluginEmpty "local define" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = ()" @@ -486,14 +494,14 @@ completionDocTests = ] let expected = "*Defined at line 2, column 1 in this module*\n" test doc (Position 2 8) "foo" Nothing [expected] - , testSession "local empty doc" $ do + , testSessionPluginEmpty "local empty doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = ()" , "bar = fo" ] test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"] - , testSession "local single line doc without newline" $ do + , testSessionPluginEmpty "local single line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- |docdoc" @@ -501,7 +509,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"] - , testSession "local multi line doc with newline" $ do + , testSessionPluginEmpty "local multi line doc with newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -510,7 +518,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"] - , testSession "local multi line doc without newline" $ do + , testSessionPluginEmpty "local multi line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -520,28 +528,28 @@ completionDocTests = , "bar = fo" ] test doc (Position 5 8) "foo" Nothing ["*Defined at line 5, column 1 in this module*\n* * *\n\n\nabcabc \n\ndef\n"] - , testSession "extern empty doc" $ do + , testSessionPluginEmpty "extern empty doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = od" ] let expected = "*Imported from 'Prelude'*\n" test doc (Position 1 8) "odd" (Just $ T.length expected) [expected] - , brokenForMacGhc9 $ testSession "extern single line doc without '\\n'" $ do + , testSessionPluginEmpty "extern single line doc without '\\n'" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = no" ] let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n" test doc (Position 1 8) "not" (Just $ T.length expected) [expected] - , brokenForMacGhc9 $ testSession "extern mulit line doc" $ do + , testSessionPluginEmpty "extern mulit line doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = i" ] let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n" test doc (Position 1 7) "id" (Just $ T.length expected) [expected] - , testSession "extern defined doc" $ do + , testSessionPluginEmpty "extern defined doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = i" @@ -550,8 +558,6 @@ completionDocTests = test doc (Position 1 7) "id" (Just $ T.length expected) [expected] ] where - -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903 - brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9" test doc pos label mn expected = do _ <- waitForDiagnostics compls <- getCompletions doc pos From a42787f7f17386d0d6b2ae89f18e760b39c8990a Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 26 Apr 2024 21:42:08 +0800 Subject: [PATCH 2/2] cleanup --- ghcide/test/exe/CompletionTests.hs | 57 +++++++++++++++--------------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 224b8e99c7..94d3287479 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -28,8 +28,7 @@ import Language.LSP.Protocol.Types hiding SemanticTokensEdit (..), mkRange) import Language.LSP.Test -import Test.Hls (knownBrokenInEnv, - waitForTypecheck) +import Test.Hls (waitForTypecheck) import qualified Test.Hls.FileSystem as FS import Test.Hls.FileSystem (file, text) import Test.Hls.Util (knownBrokenOnWindows) @@ -50,18 +49,18 @@ tests , testGroup "doc" completionDocTests ] -testSessionPluginEmpty :: TestName -> Session () -> TestTree -testSessionPluginEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]]) +testSessionEmpty :: TestName -> Session () -> TestTree +testSessionEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]]) -testSessionPluginEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree -testSessionPluginEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)]) +testSessionEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree +testSessionEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)]) -testSessionPluginSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree -testSessionPluginSingleFile testName fp txt session = +testSessionSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree +testSessionSingleFile testName fp txt session = testWithDummyPlugin testName (mkIdeTestFs [FS.directCradle [T.pack fp] , file fp (text txt)]) session completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, CompletionItemKind, T.Text, Bool, Bool, Maybe [TextEdit])] -> TestTree -completionTest name src pos expected = testSessionPluginSingleFile name "A.hs" (T.unlines src) $ do +completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do docId <- openDoc "A.hs" "haskell" _ <- waitForDiagnostics compls <- getAndResolveCompletions docId pos @@ -201,7 +200,7 @@ localCompletionTests = [ [("abcd", CompletionItemKind_Function, "abcd", True, False, Nothing) ,("abcde", CompletionItemKind_Function, "abcde", True, False, Nothing) ], - testSessionPluginEmpty "incomplete entries" $ do + testSessionEmpty "incomplete entries" $ do let src a = "data Data = " <> a doc <- createDoc "A.hs" "haskell" $ src "AAA" void $ waitForTypecheck doc @@ -299,7 +298,7 @@ otherCompletionTests = [ (Position 3 11) [("Integer", CompletionItemKind_Struct, "Integer", True, True, Nothing)], - testSessionPluginEmpty "duplicate record fields" $ do + testSessionEmpty "duplicate record fields" $ do void $ createDoc "B.hs" "haskell" $ T.unlines @@ -320,7 +319,7 @@ otherCompletionTests = [ let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"] liftIO $ take 1 compls' @?= ["member"], - testSessionPluginEmpty "maxCompletions" $ do + testSessionEmpty "maxCompletions" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -333,7 +332,7 @@ otherCompletionTests = [ packageCompletionTests :: [TestTree] packageCompletionTests = - [ testSessionPluginEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do + [ testSessionEmptyWithCradle "fromList" "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", @@ -354,7 +353,7 @@ packageCompletionTests = , "'GHC.Exts" ] ++ (["'GHC.IsList" | ghcVersion >= GHC94])) - , testSessionPluginEmpty "Map" $ do + , testSessionEmpty "Map" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -374,7 +373,7 @@ packageCompletionTests = , "'Data.Map.Lazy" , "'Data.Map.Strict" ] - , testSessionPluginEmpty "no duplicates" $ do + , testSessionEmpty "no duplicates" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -396,7 +395,7 @@ packageCompletionTests = ) compls liftIO $ length duplicate @?= 1 - , testSessionPluginEmpty "non-local before global" $ do + , testSessionEmpty "non-local before global" $ do -- non local completions are more specific doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", @@ -417,7 +416,7 @@ packageCompletionTests = projectCompletionTests :: [TestTree] projectCompletionTests = - [ testSessionPluginEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do + [ testSessionEmptyWithCradle "from hiedb" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", "anidentifier = ()" @@ -436,7 +435,7 @@ projectCompletionTests = , _label == "anidentifier" ] liftIO $ compls' @?= ["Defined in 'A"], - testSessionPluginEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do + testSessionEmptyWithCradle "auto complete project imports" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}" $ do _ <- createDoc "ALocalModule.hs" "haskell" $ T.unlines [ "module ALocalModule (anidentifier) where", "anidentifier = ()" @@ -451,7 +450,7 @@ projectCompletionTests = let item = head $ filter ((== "ALocalModule") . (^. L.label)) compls liftIO $ do item ^. L.label @?= "ALocalModule", - testSessionPluginEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do + testSessionEmptyWithCradle "auto complete functions from qualified imports without alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", "anidentifier = ()" @@ -466,7 +465,7 @@ projectCompletionTests = let item = head compls liftIO $ do item ^. L.label @?= "anidentifier", - testSessionPluginEmptyWithCradle "auto complete functions from qualified imports with alias" + testSessionEmptyWithCradle "auto complete functions from qualified imports with alias" "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"A\", \"B\"]}}" $ do _ <- createDoc "A.hs" "haskell" $ T.unlines [ "module A (anidentifier) where", @@ -486,7 +485,7 @@ projectCompletionTests = completionDocTests :: [TestTree] completionDocTests = - [ testSessionPluginEmpty "local define" $ do + [ testSessionEmpty "local define" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = ()" @@ -494,14 +493,14 @@ completionDocTests = ] let expected = "*Defined at line 2, column 1 in this module*\n" test doc (Position 2 8) "foo" Nothing [expected] - , testSessionPluginEmpty "local empty doc" $ do + , testSessionEmpty "local empty doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = ()" , "bar = fo" ] test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"] - , testSessionPluginEmpty "local single line doc without newline" $ do + , testSessionEmpty "local single line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- |docdoc" @@ -509,7 +508,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"] - , testSessionPluginEmpty "local multi line doc with newline" $ do + , testSessionEmpty "local multi line doc with newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -518,7 +517,7 @@ completionDocTests = , "bar = fo" ] test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"] - , testSessionPluginEmpty "local multi line doc without newline" $ do + , testSessionEmpty "local multi line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc" @@ -528,28 +527,28 @@ completionDocTests = , "bar = fo" ] test doc (Position 5 8) "foo" Nothing ["*Defined at line 5, column 1 in this module*\n* * *\n\n\nabcabc \n\ndef\n"] - , testSessionPluginEmpty "extern empty doc" $ do + , testSessionEmpty "extern empty doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = od" ] let expected = "*Imported from 'Prelude'*\n" test doc (Position 1 8) "odd" (Just $ T.length expected) [expected] - , testSessionPluginEmpty "extern single line doc without '\\n'" $ do + , testSessionEmpty "extern single line doc without '\\n'" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = no" ] let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n" test doc (Position 1 8) "not" (Just $ T.length expected) [expected] - , testSessionPluginEmpty "extern mulit line doc" $ do + , testSessionEmpty "extern mulit line doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = i" ] let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n" test doc (Position 1 7) "id" (Just $ T.length expected) [expected] - , testSessionPluginEmpty "extern defined doc" $ do + , testSessionEmpty "extern defined doc" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "foo = i"