module Development.IDE.Test.Diagnostic where

import           Control.Lens            ((^.))
import qualified Data.Text               as T
import           GHC.Stack               (HasCallStack)
import           Language.LSP.Types
import           Language.LSP.Types.Lens as Lsp

-- | (0-based line number, 0-based column number)
type Cursor = (UInt, UInt)

cursorPosition :: Cursor -> Position
cursorPosition :: Cursor -> Position
cursorPosition (UInt
line,  UInt
col) = UInt -> UInt -> Position
Position UInt
line UInt
col

type ErrorMsg = String

requireDiagnostic
    :: (Foldable f, Show (f Diagnostic), HasCallStack)
    => f Diagnostic
    -> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)
    -> Maybe ErrorMsg
requireDiagnostic :: forall (f :: * -> *).
(Foldable f, Show (f Diagnostic), HasCallStack) =>
f Diagnostic
-> (DiagnosticSeverity, Cursor, Text, Maybe DiagnosticTag)
-> Maybe ErrorMsg
requireDiagnostic f Diagnostic
actuals expected :: (DiagnosticSeverity, Cursor, Text, Maybe DiagnosticTag)
expected@(DiagnosticSeverity
severity, Cursor
cursor, Text
expectedMsg, Maybe DiagnosticTag
expectedTag)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Diagnostic -> Bool
match f Diagnostic
actuals = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            ErrorMsg
"Could not find " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> ErrorMsg
show (DiagnosticSeverity, Cursor, Text, Maybe DiagnosticTag)
expected forall a. Semigroup a => a -> a -> a
<>
            ErrorMsg
" in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> ErrorMsg
show f Diagnostic
actuals
  where
    match :: Diagnostic -> Bool
    match :: Diagnostic -> Bool
match Diagnostic
d =
        forall a. a -> Maybe a
Just DiagnosticSeverity
severity forall a. Eq a => a -> a -> Bool
== Diagnostic -> Maybe DiagnosticSeverity
_severity Diagnostic
d
        Bool -> Bool -> Bool
&& Cursor -> Position
cursorPosition Cursor
cursor forall a. Eq a => a -> a -> Bool
== Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStart s a => Lens' s a
start
        Bool -> Bool -> Bool
&& Text -> Text
standardizeQuotes (Text -> Text
T.toLower Text
expectedMsg) Text -> Text -> Bool
`T.isInfixOf`
           Text -> Text
standardizeQuotes (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasMessage s a => Lens' s a
message)
        Bool -> Bool -> Bool
&& Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
hasTag Maybe DiagnosticTag
expectedTag (Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasTags s a => Lens' s a
tags)

    hasTag :: Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
    hasTag :: Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
hasTag Maybe DiagnosticTag
Nothing  Maybe (List DiagnosticTag)
_                          = Bool
True
    hasTag (Just DiagnosticTag
_) Maybe (List DiagnosticTag)
Nothing                    = Bool
False
    hasTag (Just DiagnosticTag
actualTag) (Just (List [DiagnosticTag]
tags)) = DiagnosticTag
actualTag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DiagnosticTag]
tags

standardizeQuotes :: T.Text -> T.Text
standardizeQuotes :: Text -> Text
standardizeQuotes Text
msg = let
        repl :: Char -> Char
repl Char
'‘' = Char
'\''
        repl Char
'’' = Char
'\''
        repl Char
'`' = Char
'\''
        repl  Char
c  = Char
c
    in  (Char -> Char) -> Text -> Text
T.map Char -> Char
repl Text
msg