git.iko.soy/ghcide
on 8bce2dd help sign in
ghcide/test/src/Development/IDE/Test.hs
74 lines 3.0 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4module Development.IDE.Test
5 ( Cursor
6 , cursorPosition
7 , requireDiagnostic
8 , expectDiagnostics
9 ) where
11import Control.Applicative.Combinators
12import Control.Lens hiding (List)
13import Control.Monad
14import Control.Monad.IO.Class
15import qualified Data.Map.Strict as Map
16import qualified Data.Text as T
17import Language.Haskell.LSP.Test hiding (message, openDoc')
18import qualified Language.Haskell.LSP.Test as LspTest
19import Language.Haskell.LSP.Types
20import Language.Haskell.LSP.Types.Lens as Lsp
21import Test.Tasty.HUnit
24-- | (0-based line number, 0-based column number)
25type Cursor = (Int, Int)
27cursorPosition :: Cursor -> Position
28cursorPosition (line, col) = Position line col
30requireDiagnostic :: List Diagnostic -> (DiagnosticSeverity, Cursor, T.Text) -> Assertion
31requireDiagnostic actuals expected@(severity, cursor, expectedMsg) = do
32 unless (any match actuals) $
33 assertFailure $
34 "Could not find " <> show expected <>
35 " in " <> show actuals
36 where
37 match :: Diagnostic -> Bool
38 match d =
39 Just severity == _severity d
40 && cursorPosition cursor == d ^. range . start
41 && standardizeQuotes (T.toLower expectedMsg) `T.isInfixOf`
42 standardizeQuotes (T.toLower $ d ^. message)
44expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
45expectDiagnostics expected = do
46 expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) (fmap toNormalizedUri . getDocUri) expected
47 go expected'
48 where
49 go m
50 | Map.null m = pure ()
51 | otherwise = do
52 diagsNot <- skipManyTill anyMessage LspTest.message :: Session PublishDiagnosticsNotification
53 let fileUri = diagsNot ^. params . uri
54 case Map.lookup (diagsNot ^. params . uri . to toNormalizedUri) m of
55 Nothing -> liftIO $ assertFailure $
56 "Got diagnostics for " <> show fileUri <>
57 " but only expected diagnostics for " <> show (Map.keys m)
58 Just expected -> do
59 let actual = diagsNot ^. params . diagnostics
60 liftIO $ mapM_ (requireDiagnostic actual) expected
61 liftIO $ unless (length expected == length actual) $
62 assertFailure $
63 "Incorrect number of diagnostics for " <> show fileUri <>
64 ", expected " <> show expected <>
65 " but got " <> show actual
66 go $ Map.delete (diagsNot ^. params . uri . to toNormalizedUri) m
68standardizeQuotes :: T.Text -> T.Text
69standardizeQuotes msg = let
70 repl '‘' = '\''
71 repl '’' = '\''
72 repl '`' = '\''
73 repl c = c
74 in T.map repl msg