{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeOperators         #-}
module Test.Hls.Util
  (
      codeActionSupportCaps
    , expectCodeAction
    , dontExpectCodeAction
    , expectDiagnostic
    , expectNoMoreDiagnostics
    , expectSameLocations
    , failIfSessionTimeout
    , flushStackEnvironment
    , fromAction
    , fromCommand
    , getCompletionByLabel
    , ghcVersion, GhcVersion(..)
    , hostOS, OS(..)
    , matchesCurrentEnv, EnvSpec(..)
    , noLiteralCaps
    , ignoreForGhcVersions
    , ignoreInEnv
    , inspectCodeAction
    , inspectCommand
    , inspectDiagnostic
    , knownBrokenOnWindows
    , knownBrokenForGhcVersions
    , knownBrokenInEnv
    , setupBuildToolFiles
    , SymbolLocation
    , waitForDiagnosticsFrom
    , waitForDiagnosticsFromSource
    , waitForDiagnosticsFromSourceWithTimeout
    , withCurrentDirectoryInTmp
    , withCurrentDirectoryInTmp'
  )
where

import           Control.Applicative.Combinators (skipManyTill, (<|>))
import           Control.Exception               (catch, throwIO)
import           Control.Lens                    ((^.))
import           Control.Monad
import           Control.Monad.IO.Class
import qualified Data.Aeson                      as A
import           Data.Bool                       (bool)
import           Data.Default
import           Data.List.Extra                 (find)
import qualified Data.Set                        as Set
import qualified Data.Text                       as T
import           Development.IDE                 (GhcVersion(..), ghcVersion)
import qualified Language.LSP.Test               as Test
import           Language.LSP.Types              hiding (Reason (..))
import qualified Language.LSP.Types.Capabilities as C
import qualified Language.LSP.Types.Lens         as L
import           System.Directory
import           System.Environment
import           System.FilePath
import           System.IO.Temp
import           System.Info.Extra               (isMac, isWindows)
import           System.Time.Extra               (Seconds, sleep)
import           Test.Tasty                      (TestTree)
import           Test.Tasty.ExpectedFailure      (expectFailBecause,
                                                  ignoreTestBecause)
import           Test.Tasty.HUnit                (Assertion, assertFailure,
                                                  (@?=))

noLiteralCaps :: C.ClientCapabilities
noLiteralCaps :: ClientCapabilities
noLiteralCaps = ClientCapabilities
forall a. Default a => a
def { $sel:_textDocument:ClientCapabilities :: Maybe TextDocumentClientCapabilities
C._textDocument = TextDocumentClientCapabilities
-> Maybe TextDocumentClientCapabilities
forall a. a -> Maybe a
Just TextDocumentClientCapabilities
textDocumentCaps }
  where
    textDocumentCaps :: TextDocumentClientCapabilities
textDocumentCaps = TextDocumentClientCapabilities
forall a. Default a => a
def { $sel:_codeAction:TextDocumentClientCapabilities :: Maybe CodeActionClientCapabilities
C._codeAction = CodeActionClientCapabilities -> Maybe CodeActionClientCapabilities
forall a. a -> Maybe a
Just CodeActionClientCapabilities
codeActionCaps }
    codeActionCaps :: CodeActionClientCapabilities
codeActionCaps = Maybe Bool
-> Maybe CodeActionLiteralSupport
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe CodeActionResolveClientCapabilities
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe CodeActionLiteralSupport
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe CodeActionResolveClientCapabilities
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

codeActionSupportCaps :: C.ClientCapabilities
codeActionSupportCaps :: ClientCapabilities
codeActionSupportCaps = ClientCapabilities
forall a. Default a => a
def { $sel:_textDocument:ClientCapabilities :: Maybe TextDocumentClientCapabilities
C._textDocument = TextDocumentClientCapabilities
-> Maybe TextDocumentClientCapabilities
forall a. a -> Maybe a
Just TextDocumentClientCapabilities
textDocumentCaps }
  where
    textDocumentCaps :: TextDocumentClientCapabilities
textDocumentCaps = TextDocumentClientCapabilities
forall a. Default a => a
def { $sel:_codeAction:TextDocumentClientCapabilities :: Maybe CodeActionClientCapabilities
C._codeAction = CodeActionClientCapabilities -> Maybe CodeActionClientCapabilities
forall a. a -> Maybe a
Just CodeActionClientCapabilities
codeActionCaps }
    codeActionCaps :: CodeActionClientCapabilities
codeActionCaps = Maybe Bool
-> Maybe CodeActionLiteralSupport
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe CodeActionResolveClientCapabilities
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (CodeActionLiteralSupport -> Maybe CodeActionLiteralSupport
forall a. a -> Maybe a
Just CodeActionLiteralSupport
literalSupport) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe CodeActionResolveClientCapabilities
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
    literalSupport :: CodeActionLiteralSupport
literalSupport = CodeActionKindClientCapabilities -> CodeActionLiteralSupport
CodeActionLiteralSupport CodeActionKindClientCapabilities
forall a. Default a => a
def

-- ---------------------------------------------------------------------

setupBuildToolFiles :: IO ()
setupBuildToolFiles :: IO ()
setupBuildToolFiles = do
  [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files FilePath -> IO ()
setupDirectFilesIn

setupDirectFilesIn :: FilePath -> IO ()
setupDirectFilesIn :: FilePath -> IO ()
setupDirectFilesIn FilePath
f =
  FilePath -> FilePath -> IO ()
writeFile (FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"hie.yaml") FilePath
hieYamlCradleDirectContents


-- ---------------------------------------------------------------------

files :: [FilePath]
files :: [FilePath]
files =
  [  FilePath
"./test/testdata/"
   -- , "./test/testdata/addPackageTest/cabal-exe/"
   -- , "./test/testdata/addPackageTest/hpack-exe/"
   -- , "./test/testdata/addPackageTest/cabal-lib/"
   -- , "./test/testdata/addPackageTest/hpack-lib/"
   -- , "./test/testdata/addPragmas/"
   -- , "./test/testdata/badProjects/cabal/"
   -- , "./test/testdata/completion/"
   -- , "./test/testdata/definition/"
   -- , "./test/testdata/gototest/"
   -- , "./test/testdata/redundantImportTest/"
   -- , "./test/testdata/wErrorTest/"
  ]

data EnvSpec = HostOS OS | GhcVer GhcVersion
    deriving (Int -> EnvSpec -> FilePath -> FilePath
[EnvSpec] -> FilePath -> FilePath
EnvSpec -> FilePath
(Int -> EnvSpec -> FilePath -> FilePath)
-> (EnvSpec -> FilePath)
-> ([EnvSpec] -> FilePath -> FilePath)
-> Show EnvSpec
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EnvSpec] -> FilePath -> FilePath
$cshowList :: [EnvSpec] -> FilePath -> FilePath
show :: EnvSpec -> FilePath
$cshow :: EnvSpec -> FilePath
showsPrec :: Int -> EnvSpec -> FilePath -> FilePath
$cshowsPrec :: Int -> EnvSpec -> FilePath -> FilePath
Show, EnvSpec -> EnvSpec -> Bool
(EnvSpec -> EnvSpec -> Bool)
-> (EnvSpec -> EnvSpec -> Bool) -> Eq EnvSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvSpec -> EnvSpec -> Bool
$c/= :: EnvSpec -> EnvSpec -> Bool
== :: EnvSpec -> EnvSpec -> Bool
$c== :: EnvSpec -> EnvSpec -> Bool
Eq)

matchesCurrentEnv :: EnvSpec -> Bool
matchesCurrentEnv :: EnvSpec -> Bool
matchesCurrentEnv (HostOS OS
os)  = OS
hostOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
os
matchesCurrentEnv (GhcVer GhcVersion
ver) = GhcVersion
ghcVersion GhcVersion -> GhcVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GhcVersion
ver

data OS = Windows | MacOS | Linux
    deriving (Int -> OS -> FilePath -> FilePath
[OS] -> FilePath -> FilePath
OS -> FilePath
(Int -> OS -> FilePath -> FilePath)
-> (OS -> FilePath) -> ([OS] -> FilePath -> FilePath) -> Show OS
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [OS] -> FilePath -> FilePath
$cshowList :: [OS] -> FilePath -> FilePath
show :: OS -> FilePath
$cshow :: OS -> FilePath
showsPrec :: Int -> OS -> FilePath -> FilePath
$cshowsPrec :: Int -> OS -> FilePath -> FilePath
Show, OS -> OS -> Bool
(OS -> OS -> Bool) -> (OS -> OS -> Bool) -> Eq OS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OS -> OS -> Bool
$c/= :: OS -> OS -> Bool
== :: OS -> OS -> Bool
$c== :: OS -> OS -> Bool
Eq)

hostOS :: OS
hostOS :: OS
hostOS
    | Bool
isWindows = OS
Windows
    | Bool
isMac = OS
MacOS
    | Bool
otherwise = OS
Linux

-- | Mark as broken if /any/ of environmental spec mathces the current environment.
knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
knownBrokenInEnv :: [EnvSpec] -> FilePath -> TestTree -> TestTree
knownBrokenInEnv [EnvSpec]
envSpecs FilePath
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = FilePath -> TestTree -> TestTree
expectFailBecause FilePath
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

knownBrokenOnWindows :: String -> TestTree -> TestTree
knownBrokenOnWindows :: FilePath -> TestTree -> TestTree
knownBrokenOnWindows = [EnvSpec] -> FilePath -> TestTree -> TestTree
knownBrokenInEnv [OS -> EnvSpec
HostOS OS
Windows]

knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
knownBrokenForGhcVersions :: [GhcVersion] -> FilePath -> TestTree -> TestTree
knownBrokenForGhcVersions [GhcVersion]
vers = [EnvSpec] -> FilePath -> TestTree -> TestTree
knownBrokenInEnv ((GhcVersion -> EnvSpec) -> [GhcVersion] -> [EnvSpec]
forall a b. (a -> b) -> [a] -> [b]
map GhcVersion -> EnvSpec
GhcVer [GhcVersion]
vers)

-- | IgnoreTest if /any/ of environmental spec mathces the current environment.
ignoreInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
ignoreInEnv :: [EnvSpec] -> FilePath -> TestTree -> TestTree
ignoreInEnv [EnvSpec]
envSpecs FilePath
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = FilePath -> TestTree -> TestTree
ignoreTestBecause FilePath
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

ignoreForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
ignoreForGhcVersions :: [GhcVersion] -> FilePath -> TestTree -> TestTree
ignoreForGhcVersions [GhcVersion]
vers = [EnvSpec] -> FilePath -> TestTree -> TestTree
ignoreInEnv ((GhcVersion -> EnvSpec) -> [GhcVersion] -> [EnvSpec]
forall a b. (a -> b) -> [a] -> [b]
map GhcVersion -> EnvSpec
GhcVer [GhcVersion]
vers)

-- ---------------------------------------------------------------------

hieYamlCradleDirectContents :: String
hieYamlCradleDirectContents :: FilePath
hieYamlCradleDirectContents = [FilePath] -> FilePath
unlines
  [ FilePath
"# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN"
  , FilePath
"cradle:"
  , FilePath
"  direct:"
  , FilePath
"    arguments:"
  , FilePath
"      - -i."
  ]


-- ---------------------------------------------------------------------

flushStackEnvironment :: IO ()
flushStackEnvironment :: IO ()
flushStackEnvironment = do
  -- We need to clear these environment variables to prevent
  -- collisions with stack usages
  -- See https://github.com/commercialhaskell/stack/issues/4875
  FilePath -> IO ()
unsetEnv FilePath
"GHC_PACKAGE_PATH"
  FilePath -> IO ()
unsetEnv FilePath
"GHC_ENVIRONMENT"
  FilePath -> IO ()
unsetEnv FilePath
"HASKELL_PACKAGE_SANDBOX"
  FilePath -> IO ()
unsetEnv FilePath
"HASKELL_PACKAGE_SANDBOXES"

-- ---------------------------------------------------------------------

-- | Like 'withCurrentDirectory', but will copy the directory over to the system
-- temporary directory first to avoid haskell-language-server's source tree from
-- interfering with the cradle.
--
-- Ignores directories containing build artefacts to avoid interference and
-- provide reproducible test-behaviour.
withCurrentDirectoryInTmp :: FilePath -> IO a -> IO a
withCurrentDirectoryInTmp :: FilePath -> IO a -> IO a
withCurrentDirectoryInTmp FilePath
dir IO a
f =
  [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
forall a. [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
withTempCopy [FilePath]
ignored FilePath
dir ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
newDir ->
    FilePath -> IO a -> IO a
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
newDir IO a
f
  where
    ignored :: [FilePath]
ignored = [FilePath
"dist", FilePath
"dist-newstyle", FilePath
".stack-work"]


-- | Like 'withCurrentDirectory', but will copy the directory over to the system
-- temporary directory first to avoid haskell-language-server's source tree from
-- interfering with the cradle.
--
-- You may specify directories to ignore, but should be careful to maintain reproducibility.
withCurrentDirectoryInTmp' :: [FilePath] -> FilePath -> IO a -> IO a
withCurrentDirectoryInTmp' :: [FilePath] -> FilePath -> IO a -> IO a
withCurrentDirectoryInTmp' [FilePath]
ignored FilePath
dir IO a
f =
  [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
forall a. [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
withTempCopy [FilePath]
ignored FilePath
dir ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
newDir ->
    FilePath -> IO a -> IO a
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
newDir IO a
f

-- | Example call: @withTempCopy ignored src f@
--
-- Copy directory 'src' to into a temporary directory ignoring any directories
-- (and files) that are listed in 'ignored'. Pass the temporary directory
-- containing the copied sources to the continuation.
withTempCopy :: [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
withTempCopy :: [FilePath] -> FilePath -> (FilePath -> IO a) -> IO a
withTempCopy [FilePath]
ignored FilePath
srcDir FilePath -> IO a
f = do
  FilePath -> (FilePath -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"hls-test" ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
newDir -> do
    [FilePath] -> FilePath -> FilePath -> IO ()
copyDir [FilePath]
ignored FilePath
srcDir FilePath
newDir
    FilePath -> IO a
f FilePath
newDir

-- | Example call: @copyDir ignored src dst@
--
-- Copy directory 'src' to 'dst' ignoring any directories (and files)
-- that are listed in 'ignored'.
copyDir :: [FilePath] -> FilePath -> FilePath -> IO ()
copyDir :: [FilePath] -> FilePath -> FilePath -> IO ()
copyDir [FilePath]
ignored FilePath
src FilePath
dst = do
  [FilePath]
cnts <- FilePath -> IO [FilePath]
listDirectory FilePath
src
  [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
cnts ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath
file FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
ignored) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let srcFp :: FilePath
srcFp = FilePath
src FilePath -> FilePath -> FilePath
</> FilePath
file
          dstFp :: FilePath
dstFp = FilePath
dst FilePath -> FilePath -> FilePath
</> FilePath
file
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
srcFp
      if Bool
isDir
        then FilePath -> IO ()
createDirectory FilePath
dstFp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FilePath] -> FilePath -> FilePath -> IO ()
copyDir [FilePath]
ignored FilePath
srcFp FilePath
dstFp
        else FilePath -> FilePath -> IO ()
copyFile FilePath
srcFp FilePath
dstFp

fromAction :: (Command |? CodeAction) -> CodeAction
fromAction :: (Command |? CodeAction) -> CodeAction
fromAction (InR CodeAction
action) = CodeAction
action
fromAction Command |? CodeAction
_            = FilePath -> CodeAction
forall a. HasCallStack => FilePath -> a
error FilePath
"Not a code action"

fromCommand :: (Command |? CodeAction) -> Command
fromCommand :: (Command |? CodeAction) -> Command
fromCommand (InL Command
command) = Command
command
fromCommand Command |? CodeAction
_             = FilePath -> Command
forall a. HasCallStack => FilePath -> a
error FilePath
"Not a command"

onMatch :: [a] -> (a -> Bool) -> String -> IO a
onMatch :: [a] -> (a -> Bool) -> FilePath -> IO a
onMatch [a]
as a -> Bool
predicate FilePath
err = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
predicate [a]
as)

noMatch :: [a] -> (a -> Bool) -> String -> IO ()
noMatch :: [a] -> (a -> Bool) -> FilePath -> IO ()
noMatch [] a -> Bool
_ FilePath
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
noMatch [a]
as a -> Bool
predicate FilePath
err = IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err) ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
predicate [a]
as)

inspectDiagnostic :: [Diagnostic] -> [T.Text] -> IO Diagnostic
inspectDiagnostic :: [Diagnostic] -> [Text] -> IO Diagnostic
inspectDiagnostic [Diagnostic]
diags [Text]
s = [Diagnostic] -> (Diagnostic -> Bool) -> FilePath -> IO Diagnostic
forall a. [a] -> (a -> Bool) -> FilePath -> IO a
onMatch [Diagnostic]
diags (\Diagnostic
ca -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`T.isInfixOf` (Diagnostic
ca Diagnostic -> Getting Text Diagnostic Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Diagnostic Text
forall s a. HasMessage s a => Lens' s a
L.message)) [Text]
s) FilePath
err
    where err :: FilePath
err = FilePath
"expected diagnostic matching '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Text] -> FilePath
forall a. Show a => a -> FilePath
show [Text]
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' but did not find one"

expectDiagnostic :: [Diagnostic] -> [T.Text] -> IO ()
expectDiagnostic :: [Diagnostic] -> [Text] -> IO ()
expectDiagnostic [Diagnostic]
diags [Text]
s = IO Diagnostic -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Diagnostic -> IO ()) -> IO Diagnostic -> IO ()
forall a b. (a -> b) -> a -> b
$ [Diagnostic] -> [Text] -> IO Diagnostic
inspectDiagnostic [Diagnostic]
diags [Text]
s

inspectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO CodeAction
inspectCodeAction :: [Command |? CodeAction] -> [Text] -> IO CodeAction
inspectCodeAction [Command |? CodeAction]
cars [Text]
s = (Command |? CodeAction) -> CodeAction
fromAction ((Command |? CodeAction) -> CodeAction)
-> IO (Command |? CodeAction) -> IO CodeAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command |? CodeAction]
-> ((Command |? CodeAction) -> Bool)
-> FilePath
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> FilePath -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate FilePath
err
    where predicate :: (Command |? CodeAction) -> Bool
predicate (InR CodeAction
ca) = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`T.isInfixOf` (CodeAction
ca CodeAction -> Getting Text CodeAction Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CodeAction Text
forall s a. HasTitle s a => Lens' s a
L.title)) [Text]
s
          predicate Command |? CodeAction
_        = Bool
False
          err :: FilePath
err = FilePath
"expected code action matching '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Text] -> FilePath
forall a. Show a => a -> FilePath
show [Text]
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' but did not find one"

expectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO ()
expectCodeAction :: [Command |? CodeAction] -> [Text] -> IO ()
expectCodeAction [Command |? CodeAction]
cars [Text]
s = IO CodeAction -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CodeAction -> IO ()) -> IO CodeAction -> IO ()
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Text] -> IO CodeAction
inspectCodeAction [Command |? CodeAction]
cars [Text]
s

dontExpectCodeAction :: [Command |? CodeAction] -> [T.Text] -> IO ()
dontExpectCodeAction :: [Command |? CodeAction] -> [Text] -> IO ()
dontExpectCodeAction [Command |? CodeAction]
cars [Text]
s =
  [Command |? CodeAction]
-> ((Command |? CodeAction) -> Bool) -> FilePath -> IO ()
forall a. [a] -> (a -> Bool) -> FilePath -> IO ()
noMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate FilePath
err
    where predicate :: (Command |? CodeAction) -> Bool
predicate (InR CodeAction
ca) = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`T.isInfixOf` (CodeAction
ca CodeAction -> Getting Text CodeAction Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CodeAction Text
forall s a. HasTitle s a => Lens' s a
L.title)) [Text]
s
          predicate Command |? CodeAction
_        = Bool
False
          err :: FilePath
err = FilePath
"didn't expected code action matching '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Text] -> FilePath
forall a. Show a => a -> FilePath
show [Text]
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' but found one anyway"


inspectCommand :: [Command |? CodeAction] -> [T.Text] -> IO Command
inspectCommand :: [Command |? CodeAction] -> [Text] -> IO Command
inspectCommand [Command |? CodeAction]
cars [Text]
s = (Command |? CodeAction) -> Command
fromCommand ((Command |? CodeAction) -> Command)
-> IO (Command |? CodeAction) -> IO Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command |? CodeAction]
-> ((Command |? CodeAction) -> Bool)
-> FilePath
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> FilePath -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate FilePath
err
    where predicate :: (Command |? CodeAction) -> Bool
predicate (InL Command
command) = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all  (Text -> Text -> Bool
`T.isInfixOf` (Command
command Command -> Getting Text Command Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Command Text
forall s a. HasTitle s a => Lens' s a
L.title)) [Text]
s
          predicate Command |? CodeAction
_             = Bool
False
          err :: FilePath
err = FilePath
"expected code action matching '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Text] -> FilePath
forall a. Show a => a -> FilePath
show [Text]
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' but did not find one"

waitForDiagnosticsFrom :: TextDocumentIdentifier -> Test.Session [Diagnostic]
waitForDiagnosticsFrom :: TextDocumentIdentifier -> Session [Diagnostic]
waitForDiagnosticsFrom TextDocumentIdentifier
doc = do
    NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
Test.anyMessage (SServerMethod 'TextDocumentPublishDiagnostics
-> Session (ServerMessage 'TextDocumentPublishDiagnostics)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
Test.message SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics)
    let (List [Diagnostic]
diags) = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const
      (List Diagnostic)
      (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics
    if TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
L.uri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
/= NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((Uri -> Const Uri Uri)
    -> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams
forall s a. HasUri s a => Lens' s a
L.uri
       then TextDocumentIdentifier -> Session [Diagnostic]
waitForDiagnosticsFrom TextDocumentIdentifier
doc
       else [Diagnostic] -> Session [Diagnostic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags

waitForDiagnosticsFromSource :: TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
waitForDiagnosticsFromSource :: TextDocumentIdentifier -> FilePath -> Session [Diagnostic]
waitForDiagnosticsFromSource TextDocumentIdentifier
doc FilePath
src = do
    NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
Test.anyMessage (SServerMethod 'TextDocumentPublishDiagnostics
-> Session (ServerMessage 'TextDocumentPublishDiagnostics)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
Test.message SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics)
    let (List [Diagnostic]
diags) = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const
      (List Diagnostic)
      (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics
    let res :: [Diagnostic]
res = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
    if TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
L.uri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
/= NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((Uri -> Const Uri Uri)
    -> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams
forall s a. HasUri s a => Lens' s a
L.uri Bool -> Bool -> Bool
|| [Diagnostic] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
       then TextDocumentIdentifier -> FilePath -> Session [Diagnostic]
waitForDiagnosticsFromSource TextDocumentIdentifier
doc FilePath
src
       else [Diagnostic] -> Session [Diagnostic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res
  where
    matches :: Diagnostic -> Bool
    matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d Diagnostic
-> Getting (Maybe Text) Diagnostic (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Diagnostic (Maybe Text)
forall s a. HasSource s a => Lens' s a
L.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
T.pack FilePath
src)

-- | wait for @timeout@ seconds and report an assertion failure
-- if any diagnostic messages arrive in that period
expectNoMoreDiagnostics :: Seconds -> TextDocumentIdentifier -> String -> Test.Session ()
expectNoMoreDiagnostics :: Seconds -> TextDocumentIdentifier -> FilePath -> Session ()
expectNoMoreDiagnostics Seconds
timeout TextDocumentIdentifier
doc FilePath
src = do
    [Diagnostic]
diags <- Seconds
-> TextDocumentIdentifier -> FilePath -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
doc FilePath
src
    Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Diagnostic] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
diags) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
        IO () -> Session ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> IO a
assertFailure (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath
"Got unexpected diagnostics for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Uri -> FilePath
forall a. Show a => a -> FilePath
show (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
L.uri) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
            FilePath
" got " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Diagnostic] -> FilePath
forall a. Show a => a -> FilePath
show [Diagnostic]
diags

-- | wait for @timeout@ seconds and return diagnostics for the given @document and @source.
-- If timeout is 0 it will wait until the session timeout
waitForDiagnosticsFromSourceWithTimeout :: Seconds -> TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout :: Seconds
-> TextDocumentIdentifier -> FilePath -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
document FilePath
source = do
    Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Seconds
timeout Seconds -> Seconds -> Bool
forall a. Ord a => a -> a -> Bool
> Seconds
0) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ do
        -- Give any further diagnostic messages time to arrive.
        IO () -> Session ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ Seconds -> IO ()
sleep Seconds
timeout
        -- Send a dummy message to provoke a response from the server.
        -- This guarantees that we have at least one message to
        -- process, so message won't block or timeout.
        Session () -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ SClientMethod 'CustomMethod
-> MessageParams 'CustomMethod -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
Test.sendNotification (Text -> SClientMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
"non-existent-method") Value
MessageParams 'CustomMethod
A.Null
    Session [Diagnostic]
handleMessages
  where
    matches :: Diagnostic -> Bool
    matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d Diagnostic
-> Getting (Maybe Text) Diagnostic (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Diagnostic (Maybe Text)
forall s a. HasSource s a => Lens' s a
L.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
T.pack FilePath
source)

    handleMessages :: Session [Diagnostic]
handleMessages = Session [Diagnostic]
handleDiagnostic Session [Diagnostic]
-> Session [Diagnostic] -> Session [Diagnostic]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Session [Diagnostic]
forall a. Session [a]
handleCustomMethodResponse Session [Diagnostic]
-> Session [Diagnostic] -> Session [Diagnostic]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Session [Diagnostic]
ignoreOthers
    handleDiagnostic :: Session [Diagnostic]
handleDiagnostic = do
        NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- SServerMethod 'TextDocumentPublishDiagnostics
-> Session (ServerMessage 'TextDocumentPublishDiagnostics)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
Test.message SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics
        let fileUri :: Uri
fileUri = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const Uri (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((Uri -> Const Uri Uri)
    -> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting
     Uri (NotificationMessage 'TextDocumentPublishDiagnostics) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams
forall s a. HasUri s a => Lens' s a
L.uri
            (List [Diagnostic]
diags) = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
L.params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const
      (List Diagnostic)
      (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics
            res :: [Diagnostic]
res = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
        if Uri
fileUri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
== TextDocumentIdentifier
document TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
L.uri Bool -> Bool -> Bool
&& Bool -> Bool
not ([Diagnostic] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res)
            then [Diagnostic] -> Session [Diagnostic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags else Session [Diagnostic]
handleMessages
    handleCustomMethodResponse :: Session [a]
handleCustomMethodResponse =
        -- the CustomClientMethod triggers a RspCustomServer
        -- handle that and then exit
        Session FromServerMessage -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((FromServerMessage -> Maybe FromServerMessage)
-> Session FromServerMessage
forall a. (FromServerMessage -> Maybe a) -> Session a
Test.satisfyMaybe FromServerMessage -> Maybe FromServerMessage
responseForNonExistentMethod) Session () -> Session [a] -> Session [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Session [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    responseForNonExistentMethod :: FromServerMessage -> Maybe FromServerMessage
    responseForNonExistentMethod :: FromServerMessage -> Maybe FromServerMessage
responseForNonExistentMethod FromServerMessage
notif
        | FromServerMess SMethod m
SWindowLogMessage Message m
logMsg <- FromServerMessage
notif,
          Text
"non-existent-method" Text -> Text -> Bool
`T.isInfixOf` (Message m
NotificationMessage 'WindowLogMessage
logMsg NotificationMessage 'WindowLogMessage
-> Getting Text (NotificationMessage 'WindowLogMessage) Text
-> Text
forall s a. s -> Getting a s a -> a
^. (LogMessageParams -> Const Text LogMessageParams)
-> NotificationMessage 'WindowLogMessage
-> Const Text (NotificationMessage 'WindowLogMessage)
forall s a. HasParams s a => Lens' s a
L.params ((LogMessageParams -> Const Text LogMessageParams)
 -> NotificationMessage 'WindowLogMessage
 -> Const Text (NotificationMessage 'WindowLogMessage))
-> ((Text -> Const Text Text)
    -> LogMessageParams -> Const Text LogMessageParams)
-> Getting Text (NotificationMessage 'WindowLogMessage) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> LogMessageParams -> Const Text LogMessageParams
forall s a. HasMessage s a => Lens' s a
L.message)  = FromServerMessage -> Maybe FromServerMessage
forall a. a -> Maybe a
Just FromServerMessage
notif
        | Bool
otherwise = Maybe FromServerMessage
forall a. Maybe a
Nothing

    ignoreOthers :: Session [Diagnostic]
ignoreOthers = Session FromServerMessage -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Session FromServerMessage
Test.anyMessage Session () -> Session [Diagnostic] -> Session [Diagnostic]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Session [Diagnostic]
handleMessages

failIfSessionTimeout :: IO a -> IO a
failIfSessionTimeout :: IO a -> IO a
failIfSessionTimeout IO a
action = IO a
action IO a -> (SessionException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SessionException -> IO a
forall a. SessionException -> IO a
errorHandler
    where errorHandler :: Test.SessionException -> IO a
          errorHandler :: SessionException -> IO a
errorHandler e :: SessionException
e@(Test.Timeout Maybe FromServerMessage
_) = FilePath -> IO a
forall a. HasCallStack => FilePath -> IO a
assertFailure (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ SessionException -> FilePath
forall a. Show a => a -> FilePath
show SessionException
e
          errorHandler SessionException
e                  = SessionException -> IO a
forall e a. Exception e => e -> IO a
throwIO SessionException
e

-- | To locate a symbol, we provide a path to the file from the HLS root
-- directory, the line number, and the column number. (0 indexed.)
type SymbolLocation = (FilePath, UInt, UInt)

expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion
[Location]
actual expectSameLocations :: [Location] -> [SymbolLocation] -> IO ()
`expectSameLocations` [SymbolLocation]
expected = do
    let actual' :: Set (Uri, UInt, UInt)
actual' =
            (Location -> (Uri, UInt, UInt))
-> Set Location -> Set (Uri, UInt, UInt)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Location
location -> (Location
location Location -> Getting Uri Location Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri Location Uri
forall s a. HasUri s a => Lens' s a
L.uri
                                   , Location
location Location -> Getting UInt Location UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Range -> Const UInt Range) -> Location -> Const UInt Location
forall s a. HasRange s a => Lens' s a
L.range ((Range -> Const UInt Range) -> Location -> Const UInt Location)
-> ((UInt -> Const UInt UInt) -> Range -> Const UInt Range)
-> Getting UInt Location UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasStart s a => Lens' s a
L.start ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> (UInt -> Const UInt UInt)
-> Range
-> Const UInt Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
L.line
                                   , Location
location Location -> Getting UInt Location UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Range -> Const UInt Range) -> Location -> Const UInt Location
forall s a. HasRange s a => Lens' s a
L.range ((Range -> Const UInt Range) -> Location -> Const UInt Location)
-> ((UInt -> Const UInt UInt) -> Range -> Const UInt Range)
-> Getting UInt Location UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasStart s a => Lens' s a
L.start ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> (UInt -> Const UInt UInt)
-> Range
-> Const UInt Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasCharacter s a => Lens' s a
L.character))
            (Set Location -> Set (Uri, UInt, UInt))
-> Set Location -> Set (Uri, UInt, UInt)
forall a b. (a -> b) -> a -> b
$ [Location] -> Set Location
forall a. Ord a => [a] -> Set a
Set.fromList [Location]
actual
    Set (Uri, UInt, UInt)
expected' <- [(Uri, UInt, UInt)] -> Set (Uri, UInt, UInt)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Uri, UInt, UInt)] -> Set (Uri, UInt, UInt))
-> IO [(Uri, UInt, UInt)] -> IO (Set (Uri, UInt, UInt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ([SymbolLocation]
-> (SymbolLocation -> IO (Uri, UInt, UInt))
-> IO [(Uri, UInt, UInt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SymbolLocation]
expected ((SymbolLocation -> IO (Uri, UInt, UInt))
 -> IO [(Uri, UInt, UInt)])
-> (SymbolLocation -> IO (Uri, UInt, UInt))
-> IO [(Uri, UInt, UInt)]
forall a b. (a -> b) -> a -> b
$ \(FilePath
file, UInt
l, UInt
c) -> do
                              FilePath
fp <- FilePath -> IO FilePath
canonicalizePath FilePath
file
                              (Uri, UInt, UInt) -> IO (Uri, UInt, UInt)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Uri
filePathToUri FilePath
fp, UInt
l, UInt
c))
    Set (Uri, UInt, UInt)
actual' Set (Uri, UInt, UInt) -> Set (Uri, UInt, UInt) -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= Set (Uri, UInt, UInt)
expected'

-- ---------------------------------------------------------------------
getCompletionByLabel :: MonadIO m => T.Text -> [CompletionItem] -> m CompletionItem
getCompletionByLabel :: Text -> [CompletionItem] -> m CompletionItem
getCompletionByLabel Text
desiredLabel [CompletionItem]
compls = 
    case (CompletionItem -> Bool)
-> [CompletionItem] -> Maybe CompletionItem
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CompletionItem
c -> CompletionItem
c CompletionItem -> Getting Text CompletionItem Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CompletionItem Text
forall s a. HasLabel s a => Lens' s a
L.label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
desiredLabel) [CompletionItem]
compls of
        Just CompletionItem
c -> CompletionItem -> m CompletionItem
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItem
c
        Maybe CompletionItem
Nothing -> IO CompletionItem -> m CompletionItem
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionItem -> m CompletionItem)
-> (FilePath -> IO CompletionItem) -> FilePath -> m CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO CompletionItem
forall a. HasCallStack => FilePath -> IO a
assertFailure (FilePath -> m CompletionItem) -> FilePath -> m CompletionItem
forall a b. (a -> b) -> a -> b
$
            FilePath
"Completion with label " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
desiredLabel
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not found in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Text] -> FilePath
forall a. Show a => a -> FilePath
show ((CompletionItem -> Text) -> [CompletionItem] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompletionItem -> Getting Text CompletionItem Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CompletionItem Text
forall s a. HasLabel s a => Lens' s a
L.label) [CompletionItem]
compls)