{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE OverloadedStrings     #-}
module Test.Hls.Util
  (  -- * Test Capabilities
      codeActionResolveCaps
    , codeActionNoResolveCaps
    , codeActionSupportCaps
    , expectCodeAction
    -- * Environment specifications
    -- for ignoring tests
    , ghcVersion, GhcVersion(..)
    , hostOS, OS(..)
    , matchesCurrentEnv, EnvSpec(..)
    , ignoreForGhcVersions
    , ignoreInEnv
    , onlyRunForGhcVersions
    , knownBrokenOnWindows
    , knownBrokenForGhcVersions
    , knownBrokenInEnv
    , knownBrokenInSpecificEnv
    , onlyWorkForGhcVersions
    -- * Extract code actions
    , fromAction
    , fromCommand
    -- * Session Assertion Helpers
    , dontExpectCodeAction
    , expectDiagnostic
    , expectNoMoreDiagnostics
    , expectSameLocations
    , failIfSessionTimeout
    , getCompletionByLabel
    , noLiteralCaps
    , inspectCodeAction
    , inspectCommand
    , inspectDiagnostic
    , SymbolLocation
    , waitForDiagnosticsFrom
    , waitForDiagnosticsFromSource
    , waitForDiagnosticsFromSourceWithTimeout
    -- * Temporary directories
    , withCurrentDirectoryInTmp
    , withCurrentDirectoryInTmp'
    , withCanonicalTempDir
  )
where

import           Control.Applicative.Combinators (skipManyTill, (<|>))
import           Control.Exception               (catch, throwIO)
import           Control.Lens                    (_Just, (&), (.~), (?~), (^.))
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           Data.Proxy
import           Data.Row
import qualified Data.Set                        as Set
import qualified Data.Text                       as T
import           Development.IDE                 (GhcVersion (..), ghcVersion)
import qualified Language.LSP.Protocol.Lens      as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import qualified Language.LSP.Test               as Test
import           System.Directory
import           System.FilePath
import           System.Info.Extra               (isMac, isWindows)
import qualified System.IO.Extra
import           System.IO.Temp
import           System.Time.Extra               (Seconds, sleep)
import           Test.Tasty                      (TestTree)
import           Test.Tasty.ExpectedFailure      (expectFailBecause,
                                                  ignoreTestBecause)
import           Test.Tasty.HUnit                (Assertion, assertFailure,
                                                  (@?=))

noLiteralCaps :: ClientCapabilities
noLiteralCaps :: ClientCapabilities
noLiteralCaps = ClientCapabilities
forall a. Default a => a
def ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& (Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> TextDocumentClientCapabilities
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TextDocumentClientCapabilities
textDocumentCaps
  where
    textDocumentCaps :: TextDocumentClientCapabilities
textDocumentCaps = TextDocumentClientCapabilities
forall a. Default a => a
def { _codeAction = Just codeActionCaps }
    codeActionCaps :: CodeActionClientCapabilities
codeActionCaps = Maybe Bool
-> Maybe
     (Rec
        (("codeActionKind"
          .== Rec (("valueSet" .== [CodeActionKind]) .+ Empty))
         .+ Empty))
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe (Rec (("properties" .== [Text]) .+ Empty))
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe
  (Rec
     (("codeActionKind"
       .== Rec (("valueSet" .== [CodeActionKind]) .+ Empty))
      .+ Empty))
Maybe
  (Rec
     ('R
        '["codeActionKind"
          ':-> Rec ('R '["valueSet" ':-> [CodeActionKind]])]))
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 (Rec (("properties" .== [Text]) .+ Empty))
Maybe (Rec ('R '["properties" ':-> [Text]]))
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

codeActionSupportCaps :: ClientCapabilities
codeActionSupportCaps :: ClientCapabilities
codeActionSupportCaps = ClientCapabilities
forall a. Default a => a
def ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& (Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> TextDocumentClientCapabilities
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TextDocumentClientCapabilities
textDocumentCaps
  where
    textDocumentCaps :: TextDocumentClientCapabilities
textDocumentCaps = TextDocumentClientCapabilities
forall a. Default a => a
def { _codeAction = Just codeActionCaps }
    codeActionCaps :: CodeActionClientCapabilities
codeActionCaps = Maybe Bool
-> Maybe
     (Rec
        (("codeActionKind"
          .== Rec (("valueSet" .== [CodeActionKind]) .+ Empty))
         .+ Empty))
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe (Rec (("properties" .== [Text]) .+ Empty))
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Rec
  ('R
     '["codeActionKind"
       ':-> Rec ('R '["valueSet" ':-> [CodeActionKind]])])
-> Maybe
     (Rec
        ('R
           '["codeActionKind"
             ':-> Rec ('R '["valueSet" ':-> [CodeActionKind]])]))
forall a. a -> Maybe a
Just Rec
  ('R
     '["codeActionKind"
       ':-> Rec ('R '["valueSet" ':-> [CodeActionKind]])])
forall {a}.
Rec ('R '["codeActionKind" ':-> Rec ('R '["valueSet" ':-> [a]])])
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 (Rec (("properties" .== [Text]) .+ Empty))
Maybe (Rec ('R '["properties" ':-> [Text]]))
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
    literalSupport :: Rec ("codeActionKind" .== Rec ('R '["valueSet" ':-> [a]]))
literalSupport = Label "codeActionKind"
#codeActionKind Label "codeActionKind"
-> Rec ('R '["valueSet" ':-> [a]])
-> Rec ("codeActionKind" .== Rec ('R '["valueSet" ':-> [a]]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.==  (Label "valueSet"
#valueSet Label "valueSet" -> [a] -> Rec ("valueSet" .== [a])
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== [])

codeActionResolveCaps :: ClientCapabilities
codeActionResolveCaps :: ClientCapabilities
codeActionResolveCaps = ClientCapabilities
Test.fullCaps
                          ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& ((Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> ((Rec ('R '["properties" ':-> [Text]])
     -> Identity (Rec ('R '["properties" ':-> [Text]])))
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (Rec ('R '["properties" ':-> [Text]])
    -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> ClientCapabilities
-> Identity ClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Identity TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ((Rec ('R '["properties" ':-> [Text]])
     -> Identity (Rec ('R '["properties" ':-> [Text]])))
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (Rec ('R '["properties" ':-> [Text]])
    -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Identity (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> ((Rec ('R '["properties" ':-> [Text]])
     -> Identity (Rec ('R '["properties" ':-> [Text]])))
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (Rec ('R '["properties" ':-> [Text]])
    -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Identity CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> ((Rec ('R '["properties" ':-> [Text]])
     -> Identity (Rec ('R '["properties" ':-> [Text]])))
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (Rec ('R '["properties" ':-> [Text]])
    -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Rec ('R '["properties" ':-> [Text]]))
 -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasResolveSupport s a => Lens' s a
Lens'
  CodeActionClientCapabilities
  (Maybe (Rec ('R '["properties" ':-> [Text]])))
L.resolveSupport ((Maybe (Rec ('R '["properties" ':-> [Text]]))
  -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
 -> CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> ((Rec ('R '["properties" ':-> [Text]])
     -> Identity (Rec ('R '["properties" ':-> [Text]])))
    -> Maybe (Rec ('R '["properties" ':-> [Text]]))
    -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> (Rec ('R '["properties" ':-> [Text]])
    -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec ('R '["properties" ':-> [Text]])
 -> Identity (Rec ('R '["properties" ':-> [Text]])))
-> Maybe (Rec ('R '["properties" ':-> [Text]]))
-> Identity (Maybe (Rec ('R '["properties" ':-> [Text]])))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ((Rec ('R '["properties" ':-> [Text]])
  -> Identity (Rec ('R '["properties" ':-> [Text]])))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> Rec ('R '["properties" ':-> [Text]])
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Label "properties"
#properties Label "properties" -> [Text] -> Rec ("properties" .== [Text])
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== [Text
"edit"])
                          ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& ((Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> ((Bool -> Identity Bool)
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (Bool -> Identity Bool)
-> ClientCapabilities
-> Identity ClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Identity TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ((Bool -> Identity Bool)
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (Bool -> Identity Bool)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Identity (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> ((Bool -> Identity Bool)
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (Bool -> Identity Bool)
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Identity CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> ((Bool -> Identity Bool)
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (Bool -> Identity Bool)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasDataSupport s a => Lens' s a
Lens' CodeActionClientCapabilities (Maybe Bool)
L.dataSupport ((Maybe Bool -> Identity (Maybe Bool))
 -> CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> ((Bool -> Identity Bool) -> Maybe Bool -> Identity (Maybe Bool))
-> (Bool -> Identity Bool)
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Maybe Bool -> Identity (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ((Bool -> Identity Bool)
 -> ClientCapabilities -> Identity ClientCapabilities)
-> Bool -> ClientCapabilities -> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

codeActionNoResolveCaps :: ClientCapabilities
codeActionNoResolveCaps :: ClientCapabilities
codeActionNoResolveCaps = ClientCapabilities
Test.fullCaps
                          ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& ((Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> ((Maybe (Rec ('R '["properties" ':-> [Text]]))
     -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (Maybe (Rec ('R '["properties" ':-> [Text]]))
    -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> ClientCapabilities
-> Identity ClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Identity TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ((Maybe (Rec ('R '["properties" ':-> [Text]]))
     -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (Maybe (Rec ('R '["properties" ':-> [Text]]))
    -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Identity (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> ((Maybe (Rec ('R '["properties" ':-> [Text]]))
     -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (Maybe (Rec ('R '["properties" ':-> [Text]]))
    -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Identity CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> ((Maybe (Rec ('R '["properties" ':-> [Text]]))
     -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (Maybe (Rec ('R '["properties" ':-> [Text]]))
    -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Rec ('R '["properties" ':-> [Text]]))
 -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasResolveSupport s a => Lens' s a
Lens'
  CodeActionClientCapabilities
  (Maybe (Rec ('R '["properties" ':-> [Text]])))
L.resolveSupport) ((Maybe (Rec ('R '["properties" ':-> [Text]]))
  -> Identity (Maybe (Rec ('R '["properties" ':-> [Text]]))))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> Maybe (Rec ('R '["properties" ':-> [Text]]))
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Rec ('R '["properties" ':-> [Text]]))
forall a. Maybe a
Nothing
                          ClientCapabilities
-> (ClientCapabilities -> ClientCapabilities) -> ClientCapabilities
forall a b. a -> (a -> b) -> b
& ((Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Identity ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Identity (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> ((Bool -> Identity Bool)
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (Bool -> Identity Bool)
-> ClientCapabilities
-> Identity ClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Identity TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Identity (Maybe TextDocumentClientCapabilities))
-> ((Bool -> Identity Bool)
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (Bool -> Identity Bool)
-> Maybe TextDocumentClientCapabilities
-> Identity (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Identity (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Identity TextDocumentClientCapabilities)
-> ((Bool -> Identity Bool)
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (Bool -> Identity Bool)
-> TextDocumentClientCapabilities
-> Identity TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Identity CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Identity (Maybe CodeActionClientCapabilities))
-> ((Bool -> Identity Bool)
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (Bool -> Identity Bool)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasDataSupport s a => Lens' s a
Lens' CodeActionClientCapabilities (Maybe Bool)
L.dataSupport ((Maybe Bool -> Identity (Maybe Bool))
 -> CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> ((Bool -> Identity Bool) -> Maybe Bool -> Identity (Maybe Bool))
-> (Bool -> Identity Bool)
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Maybe Bool -> Identity (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ((Bool -> Identity Bool)
 -> ClientCapabilities -> Identity ClientCapabilities)
-> Bool -> ClientCapabilities -> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
-- ---------------------------------------------------------------------
-- Environment specification for ignoring tests
-- ---------------------------------------------------------------------

data EnvSpec = HostOS OS | GhcVer GhcVersion
    deriving (Int -> EnvSpec -> ShowS
[EnvSpec] -> ShowS
EnvSpec -> String
(Int -> EnvSpec -> ShowS)
-> (EnvSpec -> String) -> ([EnvSpec] -> ShowS) -> Show EnvSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvSpec -> ShowS
showsPrec :: Int -> EnvSpec -> ShowS
$cshow :: EnvSpec -> String
show :: EnvSpec -> String
$cshowList :: [EnvSpec] -> ShowS
showList :: [EnvSpec] -> ShowS
Show, EnvSpec -> EnvSpec -> Bool
(EnvSpec -> EnvSpec -> Bool)
-> (EnvSpec -> EnvSpec -> Bool) -> Eq EnvSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvSpec -> EnvSpec -> Bool
== :: EnvSpec -> EnvSpec -> Bool
$c/= :: EnvSpec -> EnvSpec -> Bool
/= :: 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 -> ShowS
[OS] -> ShowS
OS -> String
(Int -> OS -> ShowS)
-> (OS -> String) -> ([OS] -> ShowS) -> Show OS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OS -> ShowS
showsPrec :: Int -> OS -> ShowS
$cshow :: OS -> String
show :: OS -> String
$cshowList :: [OS] -> ShowS
showList :: [OS] -> ShowS
Show, OS -> OS -> Bool
(OS -> OS -> Bool) -> (OS -> OS -> Bool) -> Eq OS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OS -> OS -> Bool
== :: OS -> OS -> Bool
$c/= :: OS -> OS -> Bool
/= :: 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 the environmental specs matches the current environment.
knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
knownBrokenInEnv :: [EnvSpec] -> String -> TestTree -> TestTree
knownBrokenInEnv [EnvSpec]
envSpecs String
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = String -> TestTree -> TestTree
expectFailBecause String
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

-- | Mark as broken if /all/ environmental specs match the current environment.
knownBrokenInSpecificEnv :: [EnvSpec] -> String -> TestTree -> TestTree
knownBrokenInSpecificEnv :: [EnvSpec] -> String -> TestTree -> TestTree
knownBrokenInSpecificEnv [EnvSpec]
envSpecs String
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = String -> TestTree -> TestTree
expectFailBecause String
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

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

knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
knownBrokenForGhcVersions [GhcVersion]
vers = [EnvSpec] -> String -> 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] -> String -> TestTree -> TestTree
ignoreInEnv [EnvSpec]
envSpecs String
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = String -> TestTree -> TestTree
ignoreTestBecause String
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

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

-- | Mark as broken if GHC does not match only work versions.
onlyWorkForGhcVersions :: (GhcVersion -> Bool) -> String -> TestTree -> TestTree
onlyWorkForGhcVersions :: (GhcVersion -> Bool) -> String -> TestTree -> TestTree
onlyWorkForGhcVersions GhcVersion -> Bool
p String
reason =
    if GhcVersion -> Bool
p GhcVersion
ghcVersion
        then TestTree -> TestTree
forall a. a -> a
id
        else String -> TestTree -> TestTree
expectFailBecause String
reason

-- | Ignore the test if GHC does not match only work versions.
onlyRunForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
onlyRunForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
onlyRunForGhcVersions [GhcVersion]
vers =
    if GhcVersion
ghcVersion GhcVersion -> [GhcVersion] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GhcVersion]
vers
    then (TestTree -> TestTree) -> String -> TestTree -> TestTree
forall a b. a -> b -> a
const TestTree -> TestTree
forall a. a -> a
id
    else String -> TestTree -> TestTree
ignoreTestBecause

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

-- | 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 :: forall a. String -> IO a -> IO a
withCurrentDirectoryInTmp String
dir IO a
f =
  [String] -> String -> (String -> IO a) -> IO a
forall a. [String] -> String -> (String -> IO a) -> IO a
withTempCopy [String]
ignored String
dir ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
newDir ->
    String -> IO a -> IO a
forall a. String -> IO a -> IO a
withCurrentDirectory String
newDir IO a
f
  where
    ignored :: [String]
ignored = [String
"dist", String
"dist-newstyle", String
".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' :: forall a. [String] -> String -> IO a -> IO a
withCurrentDirectoryInTmp' [String]
ignored String
dir IO a
f =
  [String] -> String -> (String -> IO a) -> IO a
forall a. [String] -> String -> (String -> IO a) -> IO a
withTempCopy [String]
ignored String
dir ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
newDir ->
    String -> IO a -> IO a
forall a. String -> IO a -> IO a
withCurrentDirectory String
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 :: forall a. [String] -> String -> (String -> IO a) -> IO a
withTempCopy [String]
ignored String
srcDir String -> IO a
f = do
  String -> (String -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"hls-test" ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
newDir -> do
    [String] -> String -> String -> IO ()
copyDir [String]
ignored String
srcDir String
newDir
    String -> IO a
f String
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 :: [String] -> String -> String -> IO ()
copyDir [String]
ignored String
src String
dst = do
  [String]
cnts <- String -> IO [String]
listDirectory String
src
  [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cnts ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
file String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ignored) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let srcFp :: String
srcFp = String
src String -> ShowS
</> String
file
          dstFp :: String
dstFp = String
dst String -> ShowS
</> String
file
      Bool
isDir <- String -> IO Bool
doesDirectoryExist String
srcFp
      if Bool
isDir
        then String -> IO ()
createDirectory String
dstFp IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> String -> String -> IO ()
copyDir [String]
ignored String
srcFp String
dstFp
        else String -> String -> IO ()
copyFile String
srcFp String
dstFp

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

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

onMatch :: [a] -> (a -> Bool) -> String -> IO a
onMatch :: forall a. [a] -> (a -> Bool) -> String -> IO a
onMatch [a]
as a -> Bool
predicate String
err = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) a -> IO a
forall a. 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 :: forall a. [a] -> (a -> Bool) -> String -> IO ()
noMatch [] a -> Bool
_ String
_           = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
noMatch [a]
as a -> Bool
predicate String
err = IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
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) -> String -> IO Diagnostic
forall a. [a] -> (a -> Bool) -> String -> 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
Lens' Diagnostic Text
L.message)) [Text]
s) String
err
    where err :: String
err = String
"expected diagnostic matching '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' 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)
-> String
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> String -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate String
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
Lens' CodeAction Text
L.title)) [Text]
s
          predicate Command |? CodeAction
_        = Bool
False
          err :: String
err = String
"expected code action matching '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' 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) -> String -> IO ()
forall a. [a] -> (a -> Bool) -> String -> IO ()
noMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate String
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
Lens' CodeAction Text
L.title)) [Text]
s
          predicate Command |? CodeAction
_        = Bool
False
          err :: String
err = String
"didn't expected code action matching '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' 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)
-> String
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> String -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate String
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
Lens' Command Text
L.title)) [Text]
s
          predicate Command |? CodeAction
_             = Bool
False
          err :: String
err = String
"expected code action matching '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' but did not find one"

waitForDiagnosticsFrom :: TextDocumentIdentifier -> Test.Session [Diagnostic]
waitForDiagnosticsFrom :: TextDocumentIdentifier -> Session [Diagnostic]
waitForDiagnosticsFrom TextDocumentIdentifier
doc = do
    TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
-> Session
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
Test.anyMessage (SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
Test.message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics)
    let diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
  -> Const [Diagnostic] PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      [Diagnostic]
      (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
    -> PublishDiagnosticsParams
    -> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
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
Lens' TextDocumentIdentifier Uri
L.uri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
/= TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     Uri
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     Uri (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      Uri (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> ((Uri -> Const Uri Uri)
    -> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting
     Uri
     (TNotificationMessage 'Method_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
Lens' PublishDiagnosticsParams Uri
L.uri
       then TextDocumentIdentifier -> Session [Diagnostic]
waitForDiagnosticsFrom TextDocumentIdentifier
doc
       else [Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags

waitForDiagnosticsFromSource :: TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
waitForDiagnosticsFromSource :: TextDocumentIdentifier -> String -> Session [Diagnostic]
waitForDiagnosticsFromSource = Seconds -> TextDocumentIdentifier -> String -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
5

-- | 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 -> String -> Session ()
expectNoMoreDiagnostics Seconds
timeout TextDocumentIdentifier
doc String
src = do
    [Diagnostic]
diags <- Seconds -> TextDocumentIdentifier -> String -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
doc String
src
    Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Diagnostic] -> Bool
forall a. [a] -> 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 a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            String
"Got unexpected diagnostics for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Uri -> String
forall a. Show a => a -> String
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
Lens' TextDocumentIdentifier Uri
L.uri) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            String
" got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Diagnostic] -> String
forall a. Show a => a -> String
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 -> String -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
document String
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
$
        -- Give any further diagnostic messages time to arrive.
        IO () -> Session ()
forall a. IO a -> Session a
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.
    LspId ('Method_CustomMethod "test")
testId <- SClientMethod ('Method_CustomMethod "test")
-> MessageParams ('Method_CustomMethod "test")
-> Session (LspId ('Method_CustomMethod "test"))
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
Test.sendRequest (Proxy "test" -> SClientMethod ('Method_CustomMethod "test")
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"test")) Value
MessageParams ('Method_CustomMethod "test")
A.Null
    LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
handleMessages LspId ('Method_CustomMethod "test")
testId
  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
Lens' Diagnostic (Maybe Text)
L.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
source)

    handleMessages :: LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
handleMessages LspId ('Method_CustomMethod "test")
testId = LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
handleDiagnostic LspId ('Method_CustomMethod "test")
testId Session [Diagnostic]
-> Session [Diagnostic] -> Session [Diagnostic]
forall a. Session a -> Session a -> Session a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
forall {a}. LspId ('Method_CustomMethod "test") -> Session [a]
handleMethod_CustomMethodResponse LspId ('Method_CustomMethod "test")
testId Session [Diagnostic]
-> Session [Diagnostic] -> Session [Diagnostic]
forall a. Session a -> Session a -> Session a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
ignoreOthers LspId ('Method_CustomMethod "test")
testId
    handleDiagnostic :: LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
handleDiagnostic LspId ('Method_CustomMethod "test")
testId = do
        TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
Test.message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics
        let fileUri :: Uri
fileUri = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     Uri
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     Uri (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      Uri (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> ((Uri -> Const Uri Uri)
    -> PublishDiagnosticsParams -> Const Uri PublishDiagnosticsParams)
-> Getting
     Uri
     (TNotificationMessage 'Method_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
Lens' PublishDiagnosticsParams Uri
L.uri
            diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
  -> Const [Diagnostic] PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      [Diagnostic]
      (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
    -> PublishDiagnosticsParams
    -> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
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
Lens' TextDocumentIdentifier Uri
L.uri Bool -> Bool -> Bool
&& Bool -> Bool
not ([Diagnostic] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res)
            then [Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res else LspId ('Method_CustomMethod "test") -> Session [Diagnostic]
handleMessages LspId ('Method_CustomMethod "test")
testId
    handleMethod_CustomMethodResponse :: LspId ('Method_CustomMethod "test") -> Session [a]
handleMethod_CustomMethodResponse LspId ('Method_CustomMethod "test")
testId = do
        TResponseMessage ('Method_CustomMethod "test")
_ <- SClientMethod ('Method_CustomMethod "test")
-> LspId ('Method_CustomMethod "test")
-> Session (TResponseMessage ('Method_CustomMethod "test"))
forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
Test.responseForId (Proxy "test" -> SClientMethod ('Method_CustomMethod "test")
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"test")) LspId ('Method_CustomMethod "test")
testId
        [a] -> Session [a]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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

failIfSessionTimeout :: IO a -> IO a
failIfSessionTimeout :: forall a. 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 :: forall a. SessionException -> IO a
errorHandler e :: SessionException
e@(Test.Timeout Maybe FromServerMessage
_) = String -> IO a
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ SessionException -> String
forall a. Show a => a -> String
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
Lens' Location Uri
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
Lens' Location Range
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
Lens' Range Position
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
Lens' Position UInt
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
Lens' Location Range
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
Lens' Range Position
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
Lens' Position UInt
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
$ \(String
file, UInt
l, UInt
c) -> do
                              String
fp <- String -> IO String
canonicalizePath String
file
                              (Uri, UInt, UInt) -> IO (Uri, UInt, UInt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Uri
filePathToUri String
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 :: forall (m :: * -> *).
MonadIO m =>
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
Lens' CompletionItem Text
L.label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
desiredLabel) [CompletionItem]
compls of
        Just CompletionItem
c -> CompletionItem -> m CompletionItem
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItem
c
        Maybe CompletionItem
Nothing -> IO CompletionItem -> m CompletionItem
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionItem -> m CompletionItem)
-> (String -> IO CompletionItem) -> String -> m CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO CompletionItem
forall a. HasCallStack => String -> IO a
assertFailure (String -> m CompletionItem) -> String -> m CompletionItem
forall a b. (a -> b) -> a -> b
$
            String
"Completion with label " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
desiredLabel
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not found in " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show ((CompletionItem -> Text) -> [CompletionItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
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
Lens' CompletionItem Text
L.label) [CompletionItem]
compls)

-- ---------------------------------------------------------------------
-- Run with a canonicalized temp dir
withCanonicalTempDir :: (FilePath -> IO a) -> IO a
withCanonicalTempDir :: forall a. (String -> IO a) -> IO a
withCanonicalTempDir String -> IO a
f = (String -> IO a) -> IO a
forall a. (String -> IO a) -> IO a
System.IO.Extra.withTempDir ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
  String
dir' <- String -> IO String
canonicalizePath String
dir
  String -> IO a
f String
dir'