Notification.hs

-- | 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
  { nCode        :: !T.Text
  -- ^ e.g. @"Neo.ClientNotification.Statement.CartesianProduct"@
  , nTitle       :: !T.Text
  -- ^ Human-readable title.
  , nDescription :: !T.Text
  -- ^ Detailed description of the issue.
  , nSeverity    :: !Severity
  -- ^ WARNING or INFORMATION.
  , nCategory    :: !T.Text
  -- ^ e.g. @"PERFORMANCE"@, @"DEPRECATION"@, @"HINT"@, @"UNRECOGNIZED"@, @"UNSUPPORTED"@, @"GENERIC"@, @"SECURITY"@, @"TOPOLOGY"@, @"SCHEMA"@.
  , nPosition    :: !(Maybe Position)
  -- ^ Position in the Cypher query, if available.
  }
  deriving stock (Show, Eq)


-- | Severity level of a notification.
type Severity :: Type
data Severity = SevWarning | SevInformation | SevUnknown !T.Text
  deriving stock (Show, Eq)


-- | Position in a Cypher query string.
type Position :: Type
data Position = Position
  { offset :: !Int64
  , line   :: !Int64
  , col    :: !Int64
  }
  deriving stock (Show, 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 Nothing = V.empty
parseNotifications (Just (PsList items)) = V.mapMaybe parseOne items
parseNotifications (Just _) = V.empty


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


lookupText :: T.Text -> H.HashMap T.Text Ps -> Maybe T.Text
lookupText key m = case H.lookup key m of
  Just (PsString t) -> Just t
  _                 -> Nothing


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


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


lookupInt64 :: T.Text -> H.HashMap T.Text Ps -> Maybe Int64
lookupInt64 key m = case H.lookup key m of
  Just (PsInteger n) -> fromPSInteger n
  _                  -> Nothing