{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A data type to represent log messages, both for robot logs and
-- the system log.
module Swarm.Log (
  Severity (..),
  RobotLogSource (..),
  LogSource (..),
  LogEntry (..),
  leTime,
  leSource,
  leSeverity,
  leName,
  leText,
) where

import Control.Lens (makeLenses)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Swarm.Game.CESK (TickNumber)
import Swarm.Game.Location (Location)
import Swarm.Game.Universe (Cosmic)

-- | Severity of the error - critical errors are bugs
--   and should be reported as Issues.
data Severity = Info | Debug | Warning | Error | Critical
  deriving (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, Severity -> Severity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
Ord, forall x. Rep Severity x -> Severity
forall x. Severity -> Rep Severity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Severity x -> Severity
$cfrom :: forall x. Severity -> Rep Severity x
Generic, Value -> Parser [Severity]
Value -> Parser Severity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Severity]
$cparseJSONList :: Value -> Parser [Severity]
parseJSON :: Value -> Parser Severity
$cparseJSON :: Value -> Parser Severity
FromJSON, [Severity] -> Encoding
[Severity] -> Value
Severity -> Encoding
Severity -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Severity] -> Encoding
$ctoEncodingList :: [Severity] -> Encoding
toJSONList :: [Severity] -> Value
$ctoJSONList :: [Severity] -> Value
toEncoding :: Severity -> Encoding
$ctoEncoding :: Severity -> Encoding
toJSON :: Severity -> Value
$ctoJSON :: Severity -> Value
ToJSON)

-- | How a robot log entry was produced.
data RobotLogSource
  = -- | Produced by 'Swarm.Language.Syntax.Say'
    Said
  | -- | Produced by 'Swarm.Language.Syntax.Log'
    Logged
  | -- | Produced as the result of an error.
    RobotError
  deriving (Int -> RobotLogSource -> ShowS
[RobotLogSource] -> ShowS
RobotLogSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RobotLogSource] -> ShowS
$cshowList :: [RobotLogSource] -> ShowS
show :: RobotLogSource -> String
$cshow :: RobotLogSource -> String
showsPrec :: Int -> RobotLogSource -> ShowS
$cshowsPrec :: Int -> RobotLogSource -> ShowS
Show, RobotLogSource -> RobotLogSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotLogSource -> RobotLogSource -> Bool
$c/= :: RobotLogSource -> RobotLogSource -> Bool
== :: RobotLogSource -> RobotLogSource -> Bool
$c== :: RobotLogSource -> RobotLogSource -> Bool
Eq, Eq RobotLogSource
RobotLogSource -> RobotLogSource -> Bool
RobotLogSource -> RobotLogSource -> Ordering
RobotLogSource -> RobotLogSource -> RobotLogSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RobotLogSource -> RobotLogSource -> RobotLogSource
$cmin :: RobotLogSource -> RobotLogSource -> RobotLogSource
max :: RobotLogSource -> RobotLogSource -> RobotLogSource
$cmax :: RobotLogSource -> RobotLogSource -> RobotLogSource
>= :: RobotLogSource -> RobotLogSource -> Bool
$c>= :: RobotLogSource -> RobotLogSource -> Bool
> :: RobotLogSource -> RobotLogSource -> Bool
$c> :: RobotLogSource -> RobotLogSource -> Bool
<= :: RobotLogSource -> RobotLogSource -> Bool
$c<= :: RobotLogSource -> RobotLogSource -> Bool
< :: RobotLogSource -> RobotLogSource -> Bool
$c< :: RobotLogSource -> RobotLogSource -> Bool
compare :: RobotLogSource -> RobotLogSource -> Ordering
$ccompare :: RobotLogSource -> RobotLogSource -> Ordering
Ord, forall x. Rep RobotLogSource x -> RobotLogSource
forall x. RobotLogSource -> Rep RobotLogSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RobotLogSource x -> RobotLogSource
$cfrom :: forall x. RobotLogSource -> Rep RobotLogSource x
Generic, Value -> Parser [RobotLogSource]
Value -> Parser RobotLogSource
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RobotLogSource]
$cparseJSONList :: Value -> Parser [RobotLogSource]
parseJSON :: Value -> Parser RobotLogSource
$cparseJSON :: Value -> Parser RobotLogSource
FromJSON, [RobotLogSource] -> Encoding
[RobotLogSource] -> Value
RobotLogSource -> Encoding
RobotLogSource -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RobotLogSource] -> Encoding
$ctoEncodingList :: [RobotLogSource] -> Encoding
toJSONList :: [RobotLogSource] -> Value
$ctoJSONList :: [RobotLogSource] -> Value
toEncoding :: RobotLogSource -> Encoding
$ctoEncoding :: RobotLogSource -> Encoding
toJSON :: RobotLogSource -> Value
$ctoJSON :: RobotLogSource -> Value
ToJSON)

-- | Source of a log entry.
data LogSource
  = -- | Log produced by a robot.  Stores information about which
    --   command was used and the ID and location of the producing
    --   robot.
    RobotLog RobotLogSource Int (Cosmic Location)
  | -- | Log produced by an exception or system.
    SystemLog
  deriving (Int -> LogSource -> ShowS
[LogSource] -> ShowS
LogSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogSource] -> ShowS
$cshowList :: [LogSource] -> ShowS
show :: LogSource -> String
$cshow :: LogSource -> String
showsPrec :: Int -> LogSource -> ShowS
$cshowsPrec :: Int -> LogSource -> ShowS
Show, LogSource -> LogSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogSource -> LogSource -> Bool
$c/= :: LogSource -> LogSource -> Bool
== :: LogSource -> LogSource -> Bool
$c== :: LogSource -> LogSource -> Bool
Eq, Eq LogSource
LogSource -> LogSource -> Bool
LogSource -> LogSource -> Ordering
LogSource -> LogSource -> LogSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogSource -> LogSource -> LogSource
$cmin :: LogSource -> LogSource -> LogSource
max :: LogSource -> LogSource -> LogSource
$cmax :: LogSource -> LogSource -> LogSource
>= :: LogSource -> LogSource -> Bool
$c>= :: LogSource -> LogSource -> Bool
> :: LogSource -> LogSource -> Bool
$c> :: LogSource -> LogSource -> Bool
<= :: LogSource -> LogSource -> Bool
$c<= :: LogSource -> LogSource -> Bool
< :: LogSource -> LogSource -> Bool
$c< :: LogSource -> LogSource -> Bool
compare :: LogSource -> LogSource -> Ordering
$ccompare :: LogSource -> LogSource -> Ordering
Ord, forall x. Rep LogSource x -> LogSource
forall x. LogSource -> Rep LogSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogSource x -> LogSource
$cfrom :: forall x. LogSource -> Rep LogSource x
Generic, Value -> Parser [LogSource]
Value -> Parser LogSource
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LogSource]
$cparseJSONList :: Value -> Parser [LogSource]
parseJSON :: Value -> Parser LogSource
$cparseJSON :: Value -> Parser LogSource
FromJSON, [LogSource] -> Encoding
[LogSource] -> Value
LogSource -> Encoding
LogSource -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LogSource] -> Encoding
$ctoEncodingList :: [LogSource] -> Encoding
toJSONList :: [LogSource] -> Value
$ctoJSONList :: [LogSource] -> Value
toEncoding :: LogSource -> Encoding
$ctoEncoding :: LogSource -> Encoding
toJSON :: LogSource -> Value
$ctoJSON :: LogSource -> Value
ToJSON)

-- | A log entry.
data LogEntry = LogEntry
  { LogEntry -> TickNumber
_leTime :: TickNumber
  -- ^ The time at which the entry was created.
  --   Note that this is the first field we sort on.
  , LogEntry -> LogSource
_leSource :: LogSource
  -- ^ Where this log message came from.
  , LogEntry -> Severity
_leSeverity :: Severity
  -- ^ Severity level of this log message.
  , LogEntry -> Text
_leName :: Text
  -- ^ Name of the robot or subsystem that generated this log entry.
  , LogEntry -> Text
_leText :: Text
  -- ^ The text of the log entry.
  }
  deriving (Int -> LogEntry -> ShowS
[LogEntry] -> ShowS
LogEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogEntry] -> ShowS
$cshowList :: [LogEntry] -> ShowS
show :: LogEntry -> String
$cshow :: LogEntry -> String
showsPrec :: Int -> LogEntry -> ShowS
$cshowsPrec :: Int -> LogEntry -> ShowS
Show, LogEntry -> LogEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogEntry -> LogEntry -> Bool
$c/= :: LogEntry -> LogEntry -> Bool
== :: LogEntry -> LogEntry -> Bool
$c== :: LogEntry -> LogEntry -> Bool
Eq, Eq LogEntry
LogEntry -> LogEntry -> Bool
LogEntry -> LogEntry -> Ordering
LogEntry -> LogEntry -> LogEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogEntry -> LogEntry -> LogEntry
$cmin :: LogEntry -> LogEntry -> LogEntry
max :: LogEntry -> LogEntry -> LogEntry
$cmax :: LogEntry -> LogEntry -> LogEntry
>= :: LogEntry -> LogEntry -> Bool
$c>= :: LogEntry -> LogEntry -> Bool
> :: LogEntry -> LogEntry -> Bool
$c> :: LogEntry -> LogEntry -> Bool
<= :: LogEntry -> LogEntry -> Bool
$c<= :: LogEntry -> LogEntry -> Bool
< :: LogEntry -> LogEntry -> Bool
$c< :: LogEntry -> LogEntry -> Bool
compare :: LogEntry -> LogEntry -> Ordering
$ccompare :: LogEntry -> LogEntry -> Ordering
Ord, forall x. Rep LogEntry x -> LogEntry
forall x. LogEntry -> Rep LogEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogEntry x -> LogEntry
$cfrom :: forall x. LogEntry -> Rep LogEntry x
Generic, Value -> Parser [LogEntry]
Value -> Parser LogEntry
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LogEntry]
$cparseJSONList :: Value -> Parser [LogEntry]
parseJSON :: Value -> Parser LogEntry
$cparseJSON :: Value -> Parser LogEntry
FromJSON, [LogEntry] -> Encoding
[LogEntry] -> Value
LogEntry -> Encoding
LogEntry -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LogEntry] -> Encoding
$ctoEncodingList :: [LogEntry] -> Encoding
toJSONList :: [LogEntry] -> Value
$ctoJSONList :: [LogEntry] -> Value
toEncoding :: LogEntry -> Encoding
$ctoEncoding :: LogEntry -> Encoding
toJSON :: LogEntry -> Value
$ctoJSON :: LogEntry -> Value
ToJSON)

makeLenses ''LogEntry