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

-- |
-- Module      :  Swarm.Game.Log
-- Copyright   :  Ondřej Šebek
-- Maintainer  :  ondras98@icloud.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A data type to represent in-game logs by robots.
--
-- Because of the use of system robots, we sometimes
-- want to use special kinds of logs that will be
-- shown to the player.
--
-- TODO: #1039 Currently we abuse this system for system
-- logs, which is fun, but we should eventually make
-- a dedicated `SystemLogEntry` type for 'RuntimeState'
-- message queue.
module Swarm.Game.Log (
  LogSource (..),
  ErrorLevel (..),

  -- * Robot log entries
  LogEntry (..),
  leText,
  leSource,
  leRobotName,
  leTime,
  leLocation,
  leRobotID,
) where

import Control.Lens hiding (contains)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Swarm.Util.Location (Location)

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

-- | Source of the robot log.
data LogSource
  = -- | Log produced by 'Swarm.Language.Syntax.Say'
    Said
  | -- | Log produced by 'Swarm.Language.Syntax.Log'
    Logged
  | -- | Log produced by an exception or system.
    ErrorTrace ErrorLevel
  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)

-- | An entry in a robot's log.
data LogEntry = LogEntry
  { LogEntry -> Integer
_leTime :: Integer
  -- ^ The time at which the entry was created.
  --   Note that this is the first field we sort on.
  , LogEntry -> LogSource
_leSource :: LogSource
  -- ^ Whether this log records a said message.
  , LogEntry -> Text
_leRobotName :: Text
  -- ^ The name of the robot that generated the entry.
  , LogEntry -> Int
_leRobotID :: Int
  -- ^ The ID of the robot that generated the entry.
  , LogEntry -> Location
_leLocation :: Location
  -- ^ Location of the robot at log entry creation.
  , 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