{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# 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
    , failIfSessionTimeout
    , getCompletionByLabel
    , noLiteralCaps
    , inspectCodeAction
    , inspectCommand
    , inspectDiagnostic
    , waitForDiagnosticsFrom
    , waitForDiagnosticsFromSource
    , waitForDiagnosticsFromSourceWithTimeout
    -- * Temporary directories
    , withCurrentDirectoryInTmp
    , withCurrentDirectoryInTmp'
    , withCanonicalTempDir
    -- * Extract positions from input file.
    , extractCursorPositions
    , mkParameterisedLabel
    , trimming
  )
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 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                         (assertFailure)

import qualified Data.List                                as List
import qualified Data.Text.Internal.Search                as T
import qualified Data.Text.Utf16.Rope.Mixed               as Rope
import           Development.IDE.Plugin.Completions.Logic (getCompletionPrefixFromRope)
import           Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..))
import           NeatInterpolation                        (trimming)

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 ClientCodeActionLiteralOptions
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe ClientCodeActionResolveOptions
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Maybe ClientCodeActionLiteralOptions
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 ClientCodeActionResolveOptions
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 ClientCodeActionLiteralOptions
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe ClientCodeActionResolveOptions
-> Maybe Bool
-> CodeActionClientCapabilities
CodeActionClientCapabilities (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (ClientCodeActionLiteralOptions
-> Maybe ClientCodeActionLiteralOptions
forall a. a -> Maybe a
Just ClientCodeActionLiteralOptions
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 ClientCodeActionResolveOptions
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
    literalSupport :: ClientCodeActionLiteralOptions
literalSupport = ClientCodeActionKindOptions -> ClientCodeActionLiteralOptions
ClientCodeActionLiteralOptions ([CodeActionKind] -> ClientCodeActionKindOptions
ClientCodeActionKindOptions [])

codeActionResolveCaps :: ClientCapabilities
codeActionResolveCaps :: ClientCapabilities
codeActionResolveCaps = ClientCapabilities
Test.fullLatestClientCaps
                          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)
-> ((ClientCodeActionResolveOptions
     -> Identity ClientCodeActionResolveOptions)
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (ClientCodeActionResolveOptions
    -> Identity ClientCodeActionResolveOptions)
-> 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))
-> ((ClientCodeActionResolveOptions
     -> Identity ClientCodeActionResolveOptions)
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (ClientCodeActionResolveOptions
    -> Identity ClientCodeActionResolveOptions)
-> 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)
-> ((ClientCodeActionResolveOptions
     -> Identity ClientCodeActionResolveOptions)
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (ClientCodeActionResolveOptions
    -> Identity ClientCodeActionResolveOptions)
-> 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))
-> ((ClientCodeActionResolveOptions
     -> Identity ClientCodeActionResolveOptions)
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (ClientCodeActionResolveOptions
    -> Identity ClientCodeActionResolveOptions)
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ClientCodeActionResolveOptions
 -> Identity (Maybe ClientCodeActionResolveOptions))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasResolveSupport s a => Lens' s a
Lens'
  CodeActionClientCapabilities (Maybe ClientCodeActionResolveOptions)
L.resolveSupport ((Maybe ClientCodeActionResolveOptions
  -> Identity (Maybe ClientCodeActionResolveOptions))
 -> CodeActionClientCapabilities
 -> Identity CodeActionClientCapabilities)
-> ((ClientCodeActionResolveOptions
     -> Identity ClientCodeActionResolveOptions)
    -> Maybe ClientCodeActionResolveOptions
    -> Identity (Maybe ClientCodeActionResolveOptions))
-> (ClientCodeActionResolveOptions
    -> Identity ClientCodeActionResolveOptions)
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientCodeActionResolveOptions
 -> Identity ClientCodeActionResolveOptions)
-> Maybe ClientCodeActionResolveOptions
-> Identity (Maybe ClientCodeActionResolveOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ((ClientCodeActionResolveOptions
  -> Identity ClientCodeActionResolveOptions)
 -> ClientCapabilities -> Identity ClientCapabilities)
-> ClientCodeActionResolveOptions
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientCodeActionResolveOptions {$sel:_properties:ClientCodeActionResolveOptions :: [Text]
_properties= [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.fullLatestClientCaps
                          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 ClientCodeActionResolveOptions
     -> Identity (Maybe ClientCodeActionResolveOptions))
    -> Maybe TextDocumentClientCapabilities
    -> Identity (Maybe TextDocumentClientCapabilities))
-> (Maybe ClientCodeActionResolveOptions
    -> Identity (Maybe ClientCodeActionResolveOptions))
-> 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 ClientCodeActionResolveOptions
     -> Identity (Maybe ClientCodeActionResolveOptions))
    -> TextDocumentClientCapabilities
    -> Identity TextDocumentClientCapabilities)
-> (Maybe ClientCodeActionResolveOptions
    -> Identity (Maybe ClientCodeActionResolveOptions))
-> 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 ClientCodeActionResolveOptions
     -> Identity (Maybe ClientCodeActionResolveOptions))
    -> Maybe CodeActionClientCapabilities
    -> Identity (Maybe CodeActionClientCapabilities))
-> (Maybe ClientCodeActionResolveOptions
    -> Identity (Maybe ClientCodeActionResolveOptions))
-> 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 ClientCodeActionResolveOptions
     -> Identity (Maybe ClientCodeActionResolveOptions))
    -> CodeActionClientCapabilities
    -> Identity CodeActionClientCapabilities)
-> (Maybe ClientCodeActionResolveOptions
    -> Identity (Maybe ClientCodeActionResolveOptions))
-> Maybe CodeActionClientCapabilities
-> Identity (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ClientCodeActionResolveOptions
 -> Identity (Maybe ClientCodeActionResolveOptions))
-> CodeActionClientCapabilities
-> Identity CodeActionClientCapabilities
forall s a. HasResolveSupport s a => Lens' s a
Lens'
  CodeActionClientCapabilities (Maybe ClientCodeActionResolveOptions)
L.resolveSupport) ((Maybe ClientCodeActionResolveOptions
  -> Identity (Maybe ClientCodeActionResolveOptions))
 -> ClientCapabilities -> Identity ClientCapabilities)
-> Maybe ClientCodeActionResolveOptions
-> ClientCapabilities
-> ClientCapabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ClientCodeActionResolveOptions
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 -> [Char]
(Int -> EnvSpec -> ShowS)
-> (EnvSpec -> [Char]) -> ([EnvSpec] -> ShowS) -> Show EnvSpec
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvSpec -> ShowS
showsPrec :: Int -> EnvSpec -> ShowS
$cshow :: EnvSpec -> [Char]
show :: EnvSpec -> [Char]
$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 -> [Char]
(Int -> OS -> ShowS)
-> (OS -> [Char]) -> ([OS] -> ShowS) -> Show OS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OS -> ShowS
showsPrec :: Int -> OS -> ShowS
$cshow :: OS -> [Char]
show :: OS -> [Char]
$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] -> [Char] -> TestTree -> TestTree
knownBrokenInEnv [EnvSpec]
envSpecs [Char]
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = [Char] -> TestTree -> TestTree
expectFailBecause [Char]
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] -> [Char] -> TestTree -> TestTree
knownBrokenInSpecificEnv [EnvSpec]
envSpecs [Char]
reason
    | (EnvSpec -> Bool) -> [EnvSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all EnvSpec -> Bool
matchesCurrentEnv [EnvSpec]
envSpecs = [Char] -> TestTree -> TestTree
expectFailBecause [Char]
reason
    | Bool
otherwise = TestTree -> TestTree
forall a. a -> a
id

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

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

ignoreForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree
ignoreForGhcVersions :: [GhcVersion] -> [Char] -> TestTree -> TestTree
ignoreForGhcVersions [GhcVersion]
vers = [EnvSpec] -> [Char] -> 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) -> [Char] -> TestTree -> TestTree
onlyWorkForGhcVersions GhcVersion -> Bool
p [Char]
reason =
    if GhcVersion -> Bool
p GhcVersion
ghcVersion
        then TestTree -> TestTree
forall a. a -> a
id
        else [Char] -> TestTree -> TestTree
expectFailBecause [Char]
reason

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

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

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

onMatch :: [a] -> (a -> Bool) -> String -> IO a
onMatch :: forall a. [a] -> (a -> Bool) -> [Char] -> IO a
onMatch [a]
as a -> Bool
predicate [Char]
err = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO a
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
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) -> [Char] -> IO ()
noMatch [] a -> Bool
_ [Char]
_           = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
noMatch [a]
as a -> Bool
predicate [Char]
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 ()) ([Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
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) -> [Char] -> IO Diagnostic
forall a. [a] -> (a -> Bool) -> [Char] -> 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) [Char]
err
    where err :: [Char]
err = [Char]
"expected diagnostic matching '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"' 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)
-> [Char]
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> [Char] -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate [Char]
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 :: [Char]
err = [Char]
"expected code action matching '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"' 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) -> [Char] -> IO ()
forall a. [a] -> (a -> Bool) -> [Char] -> IO ()
noMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate [Char]
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 :: [Char]
err = [Char]
"didn't expected code action matching '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"' 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)
-> [Char]
-> IO (Command |? CodeAction)
forall a. [a] -> (a -> Bool) -> [Char] -> IO a
onMatch [Command |? CodeAction]
cars (Command |? CodeAction) -> Bool
predicate [Char]
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 :: [Char]
err = [Char]
"expected code action matching '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"' 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 -> [Char] -> Session [Diagnostic]
waitForDiagnosticsFromSource = Seconds -> TextDocumentIdentifier -> [Char] -> 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 -> [Char] -> Session ()
expectNoMoreDiagnostics Seconds
timeout TextDocumentIdentifier
doc [Char]
src = do
    [Diagnostic]
diags <- Seconds -> TextDocumentIdentifier -> [Char] -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
doc [Char]
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
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"Got unexpected diagnostics for " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Uri -> [Char]
forall a. Show a => a -> [Char]
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) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            [Char]
" got " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Diagnostic] -> [Char]
forall a. Show a => a -> [Char]
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 -> [Char] -> Session [Diagnostic]
waitForDiagnosticsFromSourceWithTimeout Seconds
timeout TextDocumentIdentifier
document [Char]
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 ([Char] -> Text
T.pack [Char]
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
_) = [Char] -> IO a
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> IO a) -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$ SessionException -> [Char]
forall a. Show a => a -> [Char]
show SessionException
e
          errorHandler SessionException
e                  = SessionException -> IO a
forall e a. Exception e => e -> IO a
throwIO SessionException
e

-- ---------------------------------------------------------------------
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)
-> ([Char] -> IO CompletionItem) -> [Char] -> m CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO CompletionItem
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> m CompletionItem) -> [Char] -> m CompletionItem
forall a b. (a -> b) -> a -> b
$
            [Char]
"Completion with label " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
desiredLabel
            [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" not found in " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Char]
forall a. Show a => a -> [Char]
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. ([Char] -> IO a) -> IO a
withCanonicalTempDir [Char] -> IO a
f = ([Char] -> IO a) -> IO a
forall a. ([Char] -> IO a) -> IO a
System.IO.Extra.withTempDir (([Char] -> IO a) -> IO a) -> ([Char] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
  [Char]
dir' <- [Char] -> IO [Char]
canonicalizePath [Char]
dir
  [Char] -> IO a
f [Char]
dir'

-- ----------------------------------------------------------------------------
-- Extract Position data from the source file itself.
-- ----------------------------------------------------------------------------

-- | Pretty labelling for tests that use the parameterised test helpers.
mkParameterisedLabel :: PosPrefixInfo -> String
mkParameterisedLabel :: PosPrefixInfo -> [Char]
mkParameterisedLabel PosPrefixInfo
posPrefixInfo = [[Char]] -> [Char]
unlines
    [ [Char]
"Full Line:       \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (PosPrefixInfo -> Text
fullLine PosPrefixInfo
posPrefixInfo) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
    , [Char]
"Cursor Column:   \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Position
cursorPos PosPrefixInfo
posPrefixInfo Position -> Getting UInt Position UInt -> UInt
forall s a. s -> Getting a s a -> a
^. Getting UInt Position UInt
forall s a. HasCharacter s a => Lens' s a
Lens' Position UInt
L.character) Char
' ' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"^" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
    , [Char]
"Prefix Text:     \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (PosPrefixInfo -> Text
prefixText PosPrefixInfo
posPrefixInfo) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
    ]

-- | Given a in-memory representation of a file, where a user can specify the
-- current cursor position using a '^' in the next line.
--
-- This function allows to generate multiple tests for a single input file, without
-- the hassle of calculating by hand where there cursor is supposed to be.
--
-- Example (line number has been added for readability):
--
-- @
--   0: foo = 2
--   1:  ^
--   2: bar =
--   3:      ^
-- @
--
-- This example input file contains two cursor positions (y, x), at
--
-- * (1, 1), and
-- * (3, 5).
--
-- 'extractCursorPositions' will search for '^' characters, and determine there are
-- two cursor positions in the text.
-- First, it will normalise the text to:
--
-- @
--   0: foo = 2
--   1: bar =
-- @
--
-- stripping away the '^' characters. Then, the actual cursor positions are:
--
-- * (0, 1) and
-- * (2, 5).
--
extractCursorPositions :: T.Text -> (T.Text, [PosPrefixInfo])
extractCursorPositions :: Text -> (Text, [PosPrefixInfo])
extractCursorPositions Text
t =
    let
        textLines :: [Text]
textLines = Text -> [Text]
T.lines Text
t
        foldState :: FoldState
foldState = (FoldState -> Text -> FoldState)
-> FoldState -> [Text] -> FoldState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' FoldState -> Text -> FoldState
go FoldState
emptyFoldState [Text]
textLines
        finalText :: Text
finalText = FoldState -> Text
foldStateToText FoldState
foldState
        reconstructCompletionPrefix :: Position -> PosPrefixInfo
reconstructCompletionPrefix Position
pos = Position -> Rope -> PosPrefixInfo
getCompletionPrefixFromRope Position
pos (Text -> Rope
Rope.fromText Text
finalText)
        cursorPositions :: [PosPrefixInfo]
cursorPositions = [PosPrefixInfo] -> [PosPrefixInfo]
forall a. [a] -> [a]
reverse ([PosPrefixInfo] -> [PosPrefixInfo])
-> ([Position] -> [PosPrefixInfo]) -> [Position] -> [PosPrefixInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> PosPrefixInfo) -> [Position] -> [PosPrefixInfo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Position -> PosPrefixInfo
reconstructCompletionPrefix ([Position] -> [PosPrefixInfo]) -> [Position] -> [PosPrefixInfo]
forall a b. (a -> b) -> a -> b
$ FoldState -> [Position]
foldStatePositions FoldState
foldState
    in
        (Text
finalText, [PosPrefixInfo]
cursorPositions)

    where
        go :: FoldState -> Text -> FoldState
go FoldState
foldState Text
l = case Text -> Text -> [Int]
T.indices Text
"^" Text
l of
            [] -> FoldState -> Text -> FoldState
addTextLine FoldState
foldState Text
l
            [Int]
xs -> (FoldState -> Int -> FoldState) -> FoldState -> [Int] -> FoldState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' FoldState -> Int -> FoldState
addTextCursor FoldState
foldState [Int]
xs

-- | 'FoldState' is an implementation detail used to parse some file contents,
-- extracting the cursor positions identified by '^' and producing a cleaned
-- representation of the file contents.
data FoldState = FoldState
    { FoldState -> Int
foldStateRows      :: !Int
    -- ^ The row index of the cleaned file contents.
    --
    -- For example, the file contents
    --
    -- @
    --   0: foo
    --   1: ^
    --   2: bar
    -- @
    -- will report that 'bar' is actually occurring in line '1', as '^' is
    -- a cursor position.
    -- Lines containing cursor positions are removed.
    , FoldState -> [Position]
foldStatePositions :: ![Position]
    -- ^ List of cursors positions found in the file contents.
    --
    -- List is stored in reverse for efficient 'cons'ing
    , FoldState -> [Text]
foldStateFinalText :: ![T.Text]
    -- ^ Final file contents with all lines containing cursor positions removed.
    --
    -- List is stored in reverse for efficient 'cons'ing
    }

emptyFoldState :: FoldState
emptyFoldState :: FoldState
emptyFoldState = FoldState
    { $sel:foldStateRows:FoldState :: Int
foldStateRows = Int
0
    , $sel:foldStatePositions:FoldState :: [Position]
foldStatePositions = []
    , $sel:foldStateFinalText:FoldState :: [Text]
foldStateFinalText = []
    }

-- | Produce the final file contents, without any lines containing cursor positions.
foldStateToText :: FoldState -> T.Text
foldStateToText :: FoldState -> Text
foldStateToText FoldState
state = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ FoldState -> [Text]
foldStateFinalText FoldState
state

-- | We found a '^' at some location! Add it to the list of known cursor positions.
--
-- If the row index is '0', we throw an error, as there can't be a cursor position above the first line.
addTextCursor :: FoldState -> Int -> FoldState
addTextCursor :: FoldState -> Int -> FoldState
addTextCursor FoldState
state Int
col
    | FoldState -> Int
foldStateRows FoldState
state Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> FoldState
forall a. HasCallStack => [Char] -> a
error ([Char] -> FoldState) -> [Char] -> FoldState
forall a b. (a -> b) -> a -> b
$ [Char]
"addTextCursor: Invalid '^' found at: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
col, FoldState -> Int
foldStateRows FoldState
state)
    | Bool
otherwise = FoldState
state
        { foldStatePositions = Position (fromIntegral (foldStateRows state) - 1) (fromIntegral col) : foldStatePositions state
        }

addTextLine :: FoldState -> T.Text -> FoldState
addTextLine :: FoldState -> Text -> FoldState
addTextLine FoldState
state Text
l = FoldState
state
    { foldStateFinalText = l : foldStateFinalText state
    , foldStateRows = foldStateRows state + 1
    }