-- | Server notification types (warnings, deprecations, performance hints).
module Database.Bolty.Notification
  ( Notification(..)
  , Severity(..)
  , Position(..)
  , parseNotifications
  ) where

import           Prelude

import           Data.Int                      (Int64)
import           Data.Kind                     (Type)
import qualified Data.HashMap.Lazy             as H
import qualified Data.Text                     as T
import qualified Data.Vector                   as V

import           Data.PackStream.Ps            (Ps(..))
import           Data.PackStream.Integer       (fromPSInteger)


-- | A notification emitted by the server during query execution.
-- Notifications include warnings about performance (cartesian products,
-- missing indexes), deprecation notices, and hints.
type Notification :: Type
data Notification = Notification
  { Notification -> Text
nCode        :: !T.Text
  -- ^ e.g. @"Neo.ClientNotification.Statement.CartesianProduct"@
  , Notification -> Text
nTitle       :: !T.Text
  -- ^ Human-readable title.
  , Notification -> Text
nDescription :: !T.Text
  -- ^ Detailed description of the issue.
  , Notification -> Severity
nSeverity    :: !Severity
  -- ^ WARNING or INFORMATION.
  , Notification -> Text
nCategory    :: !T.Text
  -- ^ e.g. @"PERFORMANCE"@, @"DEPRECATION"@, @"HINT"@, @"UNRECOGNIZED"@, @"UNSUPPORTED"@, @"GENERIC"@, @"SECURITY"@, @"TOPOLOGY"@, @"SCHEMA"@.
  , Notification -> Maybe Position
nPosition    :: !(Maybe Position)
  -- ^ Position in the Cypher query, if available.
  }
  deriving stock (Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Notification -> ShowS
showsPrec :: Int -> Notification -> ShowS
$cshow :: Notification -> String
show :: Notification -> String
$cshowList :: [Notification] -> ShowS
showList :: [Notification] -> ShowS
Show, Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
/= :: Notification -> Notification -> Bool
Eq)


-- | Severity level of a notification.
type Severity :: Type
data Severity = SevWarning | SevInformation | SevUnknown !T.Text
  deriving stock (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Severity -> ShowS
showsPrec :: Int -> Severity -> ShowS
$cshow :: Severity -> String
show :: Severity -> String
$cshowList :: [Severity] -> ShowS
showList :: [Severity] -> ShowS
Show, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
/= :: Severity -> Severity -> Bool
Eq)


-- | Position in a Cypher query string.
type Position :: Type
data Position = Position
  { Position -> Int64
offset :: !Int64
  , Position -> Int64
line   :: !Int64
  , Position -> Int64
col    :: !Int64
  }
  deriving stock (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq)


-- | Parse the raw @notifications@ field from PULL SUCCESS metadata.
-- Returns an empty vector if the field is 'Nothing' or not a list.
parseNotifications :: Maybe Ps -> V.Vector Notification
parseNotifications :: Maybe Ps -> Vector Notification
parseNotifications Maybe Ps
Nothing = Vector Notification
forall a. Vector a
V.empty
parseNotifications (Just (PsList Vector Ps
items)) = (Ps -> Maybe Notification) -> Vector Ps -> Vector Notification
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Ps -> Maybe Notification
parseOne Vector Ps
items
parseNotifications (Just Ps
_) = Vector Notification
forall a. Vector a
V.empty


-- | Parse a single notification dictionary.
parseOne :: Ps -> Maybe Notification
parseOne :: Ps -> Maybe Notification
parseOne (PsDictionary HashMap Text Ps
m) = do
  code <- Text -> HashMap Text Ps -> Maybe Text
lookupText Text
"code" HashMap Text Ps
m
  title <- lookupText "title" m
  desc <- lookupText "description" m
  let severity = Maybe Ps -> Severity
parseSeverity (Maybe Ps -> Severity) -> Maybe Ps -> Severity
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"severity" HashMap Text Ps
m
  let category = case Text -> HashMap Text Ps -> Maybe Text
lookupText Text
"category" HashMap Text Ps
m of
                   Just Text
c  -> Text
c
                   Maybe Text
Nothing -> Text
""
  let position = Maybe Ps -> Maybe Position
parsePosition (Maybe Ps -> Maybe Position) -> Maybe Ps -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"position" HashMap Text Ps
m
  Just Notification
    { nCode        = code
    , nTitle       = title
    , nDescription = desc
    , nSeverity    = severity
    , nCategory    = category
    , nPosition    = position
    }
parseOne Ps
_ = Maybe Notification
forall a. Maybe a
Nothing


lookupText :: T.Text -> H.HashMap T.Text Ps -> Maybe T.Text
lookupText :: Text -> HashMap Text Ps -> Maybe Text
lookupText Text
key HashMap Text Ps
m = case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
m of
  Just (PsString Text
t) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  Maybe Ps
_                 -> Maybe Text
forall a. Maybe a
Nothing


parseSeverity :: Maybe Ps -> Severity
parseSeverity :: Maybe Ps -> Severity
parseSeverity (Just (PsString Text
"WARNING"))     = Severity
SevWarning
parseSeverity (Just (PsString Text
"INFORMATION")) = Severity
SevInformation
parseSeverity (Just (PsString Text
other))         = Text -> Severity
SevUnknown Text
other
parseSeverity Maybe Ps
_                               = Text -> Severity
SevUnknown Text
""


parsePosition :: Maybe Ps -> Maybe Position
parsePosition :: Maybe Ps -> Maybe Position
parsePosition (Just (PsDictionary HashMap Text Ps
m)) = do
  off  <- Text -> HashMap Text Ps -> Maybe Int64
lookupInt64 Text
"offset" HashMap Text Ps
m
  ln   <- lookupInt64 "line" m
  c    <- lookupInt64 "column" m
  Just Position{offset = off, line = ln, col = c}
parsePosition Maybe Ps
_ = Maybe Position
forall a. Maybe a
Nothing


lookupInt64 :: T.Text -> H.HashMap T.Text Ps -> Maybe Int64
lookupInt64 :: Text -> HashMap Text Ps -> Maybe Int64
lookupInt64 Text
key HashMap Text Ps
m = case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
m of
  Just (PsInteger PSInteger
n) -> PSInteger -> Maybe Int64
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
n
  Maybe Ps
_                  -> Maybe Int64
forall a. Maybe a
Nothing