{-# 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 (
  -- * Log entries
  Severity (..),
  RobotLogSource (..),
  LogSource (..),
  LogEntry (..),
  leTime,
  leSource,
  leSeverity,
  leName,
  leText,

  -- * Utilities
  logToText,
) where

import Control.Lens (makeLenses, view)
import Data.Aeson (FromJSON, ToJSON)
import Data.Foldable (toList)
import Data.Text (Text)
import GHC.Generics (Generic)
import Swarm.Game.Location (Location)
import Swarm.Game.Tick (TickNumber)
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
(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, Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord 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
$ccompare :: Severity -> Severity -> Ordering
compare :: Severity -> Severity -> Ordering
$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
>= :: Severity -> Severity -> Bool
$cmax :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
min :: Severity -> Severity -> Severity
Ord, (forall x. Severity -> Rep Severity x)
-> (forall x. Rep Severity x -> Severity) -> Generic Severity
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
$cfrom :: forall x. Severity -> Rep Severity x
from :: forall x. Severity -> Rep Severity x
$cto :: forall x. Rep Severity x -> Severity
to :: forall x. Rep Severity x -> Severity
Generic, Maybe Severity
Value -> Parser [Severity]
Value -> Parser Severity
(Value -> Parser Severity)
-> (Value -> Parser [Severity])
-> Maybe Severity
-> FromJSON Severity
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Severity
parseJSON :: Value -> Parser Severity
$cparseJSONList :: Value -> Parser [Severity]
parseJSONList :: Value -> Parser [Severity]
$comittedField :: Maybe Severity
omittedField :: Maybe Severity
FromJSON, [Severity] -> Value
[Severity] -> Encoding
Severity -> Bool
Severity -> Value
Severity -> Encoding
(Severity -> Value)
-> (Severity -> Encoding)
-> ([Severity] -> Value)
-> ([Severity] -> Encoding)
-> (Severity -> Bool)
-> ToJSON Severity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Severity -> Value
toJSON :: Severity -> Value
$ctoEncoding :: Severity -> Encoding
toEncoding :: Severity -> Encoding
$ctoJSONList :: [Severity] -> Value
toJSONList :: [Severity] -> Value
$ctoEncodingList :: [Severity] -> Encoding
toEncodingList :: [Severity] -> Encoding
$comitField :: Severity -> Bool
omitField :: Severity -> Bool
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
  | -- | Produced as a status message from a command.
    CmdStatus
  deriving (Int -> RobotLogSource -> ShowS
[RobotLogSource] -> ShowS
RobotLogSource -> String
(Int -> RobotLogSource -> ShowS)
-> (RobotLogSource -> String)
-> ([RobotLogSource] -> ShowS)
-> Show RobotLogSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RobotLogSource -> ShowS
showsPrec :: Int -> RobotLogSource -> ShowS
$cshow :: RobotLogSource -> String
show :: RobotLogSource -> String
$cshowList :: [RobotLogSource] -> ShowS
showList :: [RobotLogSource] -> ShowS
Show, RobotLogSource -> RobotLogSource -> Bool
(RobotLogSource -> RobotLogSource -> Bool)
-> (RobotLogSource -> RobotLogSource -> Bool) -> Eq RobotLogSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RobotLogSource -> RobotLogSource -> Bool
== :: RobotLogSource -> RobotLogSource -> Bool
$c/= :: RobotLogSource -> RobotLogSource -> Bool
/= :: RobotLogSource -> RobotLogSource -> Bool
Eq, Eq RobotLogSource
Eq RobotLogSource =>
(RobotLogSource -> RobotLogSource -> Ordering)
-> (RobotLogSource -> RobotLogSource -> Bool)
-> (RobotLogSource -> RobotLogSource -> Bool)
-> (RobotLogSource -> RobotLogSource -> Bool)
-> (RobotLogSource -> RobotLogSource -> Bool)
-> (RobotLogSource -> RobotLogSource -> RobotLogSource)
-> (RobotLogSource -> RobotLogSource -> RobotLogSource)
-> Ord 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
$ccompare :: RobotLogSource -> RobotLogSource -> Ordering
compare :: RobotLogSource -> RobotLogSource -> Ordering
$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
>= :: RobotLogSource -> RobotLogSource -> Bool
$cmax :: RobotLogSource -> RobotLogSource -> RobotLogSource
max :: RobotLogSource -> RobotLogSource -> RobotLogSource
$cmin :: RobotLogSource -> RobotLogSource -> RobotLogSource
min :: RobotLogSource -> RobotLogSource -> RobotLogSource
Ord, (forall x. RobotLogSource -> Rep RobotLogSource x)
-> (forall x. Rep RobotLogSource x -> RobotLogSource)
-> Generic RobotLogSource
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
$cfrom :: forall x. RobotLogSource -> Rep RobotLogSource x
from :: forall x. RobotLogSource -> Rep RobotLogSource x
$cto :: forall x. Rep RobotLogSource x -> RobotLogSource
to :: forall x. Rep RobotLogSource x -> RobotLogSource
Generic, Maybe RobotLogSource
Value -> Parser [RobotLogSource]
Value -> Parser RobotLogSource
(Value -> Parser RobotLogSource)
-> (Value -> Parser [RobotLogSource])
-> Maybe RobotLogSource
-> FromJSON RobotLogSource
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RobotLogSource
parseJSON :: Value -> Parser RobotLogSource
$cparseJSONList :: Value -> Parser [RobotLogSource]
parseJSONList :: Value -> Parser [RobotLogSource]
$comittedField :: Maybe RobotLogSource
omittedField :: Maybe RobotLogSource
FromJSON, [RobotLogSource] -> Value
[RobotLogSource] -> Encoding
RobotLogSource -> Bool
RobotLogSource -> Value
RobotLogSource -> Encoding
(RobotLogSource -> Value)
-> (RobotLogSource -> Encoding)
-> ([RobotLogSource] -> Value)
-> ([RobotLogSource] -> Encoding)
-> (RobotLogSource -> Bool)
-> ToJSON RobotLogSource
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RobotLogSource -> Value
toJSON :: RobotLogSource -> Value
$ctoEncoding :: RobotLogSource -> Encoding
toEncoding :: RobotLogSource -> Encoding
$ctoJSONList :: [RobotLogSource] -> Value
toJSONList :: [RobotLogSource] -> Value
$ctoEncodingList :: [RobotLogSource] -> Encoding
toEncodingList :: [RobotLogSource] -> Encoding
$comitField :: RobotLogSource -> Bool
omitField :: RobotLogSource -> Bool
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
(Int -> LogSource -> ShowS)
-> (LogSource -> String)
-> ([LogSource] -> ShowS)
-> Show LogSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogSource -> ShowS
showsPrec :: Int -> LogSource -> ShowS
$cshow :: LogSource -> String
show :: LogSource -> String
$cshowList :: [LogSource] -> ShowS
showList :: [LogSource] -> ShowS
Show, LogSource -> LogSource -> Bool
(LogSource -> LogSource -> Bool)
-> (LogSource -> LogSource -> Bool) -> Eq LogSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogSource -> LogSource -> Bool
== :: LogSource -> LogSource -> Bool
$c/= :: LogSource -> LogSource -> Bool
/= :: LogSource -> LogSource -> Bool
Eq, Eq LogSource
Eq LogSource =>
(LogSource -> LogSource -> Ordering)
-> (LogSource -> LogSource -> Bool)
-> (LogSource -> LogSource -> Bool)
-> (LogSource -> LogSource -> Bool)
-> (LogSource -> LogSource -> Bool)
-> (LogSource -> LogSource -> LogSource)
-> (LogSource -> LogSource -> LogSource)
-> Ord 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
$ccompare :: LogSource -> LogSource -> Ordering
compare :: LogSource -> LogSource -> Ordering
$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
>= :: LogSource -> LogSource -> Bool
$cmax :: LogSource -> LogSource -> LogSource
max :: LogSource -> LogSource -> LogSource
$cmin :: LogSource -> LogSource -> LogSource
min :: LogSource -> LogSource -> LogSource
Ord, (forall x. LogSource -> Rep LogSource x)
-> (forall x. Rep LogSource x -> LogSource) -> Generic LogSource
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
$cfrom :: forall x. LogSource -> Rep LogSource x
from :: forall x. LogSource -> Rep LogSource x
$cto :: forall x. Rep LogSource x -> LogSource
to :: forall x. Rep LogSource x -> LogSource
Generic, Maybe LogSource
Value -> Parser [LogSource]
Value -> Parser LogSource
(Value -> Parser LogSource)
-> (Value -> Parser [LogSource])
-> Maybe LogSource
-> FromJSON LogSource
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser LogSource
parseJSON :: Value -> Parser LogSource
$cparseJSONList :: Value -> Parser [LogSource]
parseJSONList :: Value -> Parser [LogSource]
$comittedField :: Maybe LogSource
omittedField :: Maybe LogSource
FromJSON, [LogSource] -> Value
[LogSource] -> Encoding
LogSource -> Bool
LogSource -> Value
LogSource -> Encoding
(LogSource -> Value)
-> (LogSource -> Encoding)
-> ([LogSource] -> Value)
-> ([LogSource] -> Encoding)
-> (LogSource -> Bool)
-> ToJSON LogSource
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: LogSource -> Value
toJSON :: LogSource -> Value
$ctoEncoding :: LogSource -> Encoding
toEncoding :: LogSource -> Encoding
$ctoJSONList :: [LogSource] -> Value
toJSONList :: [LogSource] -> Value
$ctoEncodingList :: [LogSource] -> Encoding
toEncodingList :: [LogSource] -> Encoding
$comitField :: LogSource -> Bool
omitField :: LogSource -> Bool
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
(Int -> LogEntry -> ShowS)
-> (LogEntry -> String) -> ([LogEntry] -> ShowS) -> Show LogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogEntry -> ShowS
showsPrec :: Int -> LogEntry -> ShowS
$cshow :: LogEntry -> String
show :: LogEntry -> String
$cshowList :: [LogEntry] -> ShowS
showList :: [LogEntry] -> ShowS
Show, LogEntry -> LogEntry -> Bool
(LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool) -> Eq LogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogEntry -> LogEntry -> Bool
== :: LogEntry -> LogEntry -> Bool
$c/= :: LogEntry -> LogEntry -> Bool
/= :: LogEntry -> LogEntry -> Bool
Eq, Eq LogEntry
Eq LogEntry =>
(LogEntry -> LogEntry -> Ordering)
-> (LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> LogEntry)
-> (LogEntry -> LogEntry -> LogEntry)
-> Ord 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
$ccompare :: LogEntry -> LogEntry -> Ordering
compare :: LogEntry -> LogEntry -> Ordering
$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
>= :: LogEntry -> LogEntry -> Bool
$cmax :: LogEntry -> LogEntry -> LogEntry
max :: LogEntry -> LogEntry -> LogEntry
$cmin :: LogEntry -> LogEntry -> LogEntry
min :: LogEntry -> LogEntry -> LogEntry
Ord, (forall x. LogEntry -> Rep LogEntry x)
-> (forall x. Rep LogEntry x -> LogEntry) -> Generic LogEntry
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
$cfrom :: forall x. LogEntry -> Rep LogEntry x
from :: forall x. LogEntry -> Rep LogEntry x
$cto :: forall x. Rep LogEntry x -> LogEntry
to :: forall x. Rep LogEntry x -> LogEntry
Generic, Maybe LogEntry
Value -> Parser [LogEntry]
Value -> Parser LogEntry
(Value -> Parser LogEntry)
-> (Value -> Parser [LogEntry])
-> Maybe LogEntry
-> FromJSON LogEntry
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser LogEntry
parseJSON :: Value -> Parser LogEntry
$cparseJSONList :: Value -> Parser [LogEntry]
parseJSONList :: Value -> Parser [LogEntry]
$comittedField :: Maybe LogEntry
omittedField :: Maybe LogEntry
FromJSON, [LogEntry] -> Value
[LogEntry] -> Encoding
LogEntry -> Bool
LogEntry -> Value
LogEntry -> Encoding
(LogEntry -> Value)
-> (LogEntry -> Encoding)
-> ([LogEntry] -> Value)
-> ([LogEntry] -> Encoding)
-> (LogEntry -> Bool)
-> ToJSON LogEntry
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: LogEntry -> Value
toJSON :: LogEntry -> Value
$ctoEncoding :: LogEntry -> Encoding
toEncoding :: LogEntry -> Encoding
$ctoJSONList :: [LogEntry] -> Value
toJSONList :: [LogEntry] -> Value
$ctoEncodingList :: [LogEntry] -> Encoding
toEncodingList :: [LogEntry] -> Encoding
$comitField :: LogEntry -> Bool
omitField :: LogEntry -> Bool
ToJSON)

makeLenses ''LogEntry

-- | Extract the text from a container of log entries.
logToText :: Foldable t => t LogEntry -> [Text]
logToText :: forall (t :: * -> *). Foldable t => t LogEntry -> [Text]
logToText = (LogEntry -> Text) -> [LogEntry] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text LogEntry Text -> LogEntry -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text LogEntry Text
Lens' LogEntry Text
leText) ([LogEntry] -> [Text])
-> (t LogEntry -> [LogEntry]) -> t LogEntry -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t LogEntry -> [LogEntry]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList