{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
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.Row
import           Data.Proxy
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.Protocol.Types
import           Language.LSP.Protocol.Message
import qualified Language.LSP.Protocol.Lens         as L
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
            ( [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'