module Development.IDE.Test.Diagnostic where

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

-- | (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)
    | (Diagnostic -> Bool) -> f Diagnostic -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Diagnostic -> Bool
match f Diagnostic
actuals = Maybe ErrorMsg
forall a. Maybe a
Nothing
    | Bool
otherwise = ErrorMsg -> Maybe ErrorMsg
forall a. a -> Maybe a
Just (ErrorMsg -> Maybe ErrorMsg) -> ErrorMsg -> Maybe ErrorMsg
forall a b. (a -> b) -> a -> b
$
            ErrorMsg
"Could not find " ErrorMsg -> ErrorMsg -> ErrorMsg
forall a. Semigroup a => a -> a -> a
<> (DiagnosticSeverity, Cursor, Text, Maybe DiagnosticTag) -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show (DiagnosticSeverity, Cursor, Text, Maybe DiagnosticTag)
expected ErrorMsg -> ErrorMsg -> ErrorMsg
forall a. Semigroup a => a -> a -> a
<>
            ErrorMsg
" in " ErrorMsg -> ErrorMsg -> ErrorMsg
forall a. Semigroup a => a -> a -> a
<> f Diagnostic -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show f Diagnostic
actuals
  where
    match :: Diagnostic -> Bool
    match :: Diagnostic -> Bool
match Diagnostic
d =
        DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
severity Maybe DiagnosticSeverity -> Maybe DiagnosticSeverity -> Bool
forall a. Eq a => a -> a -> Bool
== Diagnostic -> Maybe DiagnosticSeverity
_severity Diagnostic
d
        Bool -> Bool -> Bool
&& Cursor -> Position
cursorPosition Cursor
cursor Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Diagnostic
d Diagnostic -> Getting Position Diagnostic Position -> Position
forall s a. s -> Getting a s a -> a
^. (Range -> Const Position Range)
-> Diagnostic -> Const Position Diagnostic
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
range ((Range -> Const Position Range)
 -> Diagnostic -> Const Position Diagnostic)
-> ((Position -> Const Position Position)
    -> Range -> Const Position Range)
-> Getting Position Diagnostic Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Position Position)
-> Range -> Const Position Range
forall s a. HasStart s a => Lens' s a
Lens' Range Position
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Diagnostic
d 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
message)
        Bool -> Bool -> Bool
&& Maybe DiagnosticTag -> Maybe [DiagnosticTag] -> Bool
hasTag Maybe DiagnosticTag
expectedTag (Diagnostic
d Diagnostic
-> Getting
     (Maybe [DiagnosticTag]) Diagnostic (Maybe [DiagnosticTag])
-> Maybe [DiagnosticTag]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [DiagnosticTag]) Diagnostic (Maybe [DiagnosticTag])
forall s a. HasTags s a => Lens' s a
Lens' Diagnostic (Maybe [DiagnosticTag])
tags)

    hasTag :: Maybe DiagnosticTag -> Maybe [DiagnosticTag] -> Bool
    hasTag :: Maybe DiagnosticTag -> Maybe [DiagnosticTag] -> Bool
hasTag Maybe DiagnosticTag
Nothing  Maybe [DiagnosticTag]
_                   = Bool
True
    hasTag (Just DiagnosticTag
_) Maybe [DiagnosticTag]
Nothing             = Bool
False
    hasTag (Just DiagnosticTag
actualTag) (Just [DiagnosticTag]
tags) = DiagnosticTag
actualTag DiagnosticTag -> [DiagnosticTag] -> Bool
forall a. Eq a => a -> [a] -> Bool
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