{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}

module Hercules.API.Logs.LogEntry where

import Control.Applicative
import qualified Data.Aeson.Types as A
import Data.Vector (Vector)
import Data.Word (Word64)
import Hercules.API.Prelude

newtype ActivityId = ActivityId Word64
  deriving newtype ([ActivityId] -> Encoding
[ActivityId] -> Value
ActivityId -> Encoding
ActivityId -> Value
(ActivityId -> Value)
-> (ActivityId -> Encoding)
-> ([ActivityId] -> Value)
-> ([ActivityId] -> Encoding)
-> ToJSON ActivityId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityId] -> Encoding
$ctoEncodingList :: [ActivityId] -> Encoding
toJSONList :: [ActivityId] -> Value
$ctoJSONList :: [ActivityId] -> Value
toEncoding :: ActivityId -> Encoding
$ctoEncoding :: ActivityId -> Encoding
toJSON :: ActivityId -> Value
$ctoJSON :: ActivityId -> Value
ToJSON, Value -> Parser [ActivityId]
Value -> Parser ActivityId
(Value -> Parser ActivityId)
-> (Value -> Parser [ActivityId]) -> FromJSON ActivityId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityId]
$cparseJSONList :: Value -> Parser [ActivityId]
parseJSON :: Value -> Parser ActivityId
$cparseJSON :: Value -> Parser ActivityId
FromJSON, Int -> ActivityId -> ShowS
[ActivityId] -> ShowS
ActivityId -> String
(Int -> ActivityId -> ShowS)
-> (ActivityId -> String)
-> ([ActivityId] -> ShowS)
-> Show ActivityId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityId] -> ShowS
$cshowList :: [ActivityId] -> ShowS
show :: ActivityId -> String
$cshow :: ActivityId -> String
showsPrec :: Int -> ActivityId -> ShowS
$cshowsPrec :: Int -> ActivityId -> ShowS
Show, ActivityId -> ActivityId -> Bool
(ActivityId -> ActivityId -> Bool)
-> (ActivityId -> ActivityId -> Bool) -> Eq ActivityId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityId -> ActivityId -> Bool
$c/= :: ActivityId -> ActivityId -> Bool
== :: ActivityId -> ActivityId -> Bool
$c== :: ActivityId -> ActivityId -> Bool
Eq, ActivityId -> ()
(ActivityId -> ()) -> NFData ActivityId
forall a. (a -> ()) -> NFData a
rnf :: ActivityId -> ()
$crnf :: ActivityId -> ()
NFData)

newtype ActivityType = ActivityType Word64
  deriving newtype ([ActivityType] -> Encoding
[ActivityType] -> Value
ActivityType -> Encoding
ActivityType -> Value
(ActivityType -> Value)
-> (ActivityType -> Encoding)
-> ([ActivityType] -> Value)
-> ([ActivityType] -> Encoding)
-> ToJSON ActivityType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityType] -> Encoding
$ctoEncodingList :: [ActivityType] -> Encoding
toJSONList :: [ActivityType] -> Value
$ctoJSONList :: [ActivityType] -> Value
toEncoding :: ActivityType -> Encoding
$ctoEncoding :: ActivityType -> Encoding
toJSON :: ActivityType -> Value
$ctoJSON :: ActivityType -> Value
ToJSON, Value -> Parser [ActivityType]
Value -> Parser ActivityType
(Value -> Parser ActivityType)
-> (Value -> Parser [ActivityType]) -> FromJSON ActivityType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityType]
$cparseJSONList :: Value -> Parser [ActivityType]
parseJSON :: Value -> Parser ActivityType
$cparseJSON :: Value -> Parser ActivityType
FromJSON, Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
(Int -> ActivityType -> ShowS)
-> (ActivityType -> String)
-> ([ActivityType] -> ShowS)
-> Show ActivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show, ActivityType -> ActivityType -> Bool
(ActivityType -> ActivityType -> Bool)
-> (ActivityType -> ActivityType -> Bool) -> Eq ActivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, ActivityType -> ()
(ActivityType -> ()) -> NFData ActivityType
forall a. (a -> ()) -> NFData a
rnf :: ActivityType -> ()
$crnf :: ActivityType -> ()
NFData)

newtype ResultType = ResultType Word64
  deriving newtype ([ResultType] -> Encoding
[ResultType] -> Value
ResultType -> Encoding
ResultType -> Value
(ResultType -> Value)
-> (ResultType -> Encoding)
-> ([ResultType] -> Value)
-> ([ResultType] -> Encoding)
-> ToJSON ResultType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ResultType] -> Encoding
$ctoEncodingList :: [ResultType] -> Encoding
toJSONList :: [ResultType] -> Value
$ctoJSONList :: [ResultType] -> Value
toEncoding :: ResultType -> Encoding
$ctoEncoding :: ResultType -> Encoding
toJSON :: ResultType -> Value
$ctoJSON :: ResultType -> Value
ToJSON, Value -> Parser [ResultType]
Value -> Parser ResultType
(Value -> Parser ResultType)
-> (Value -> Parser [ResultType]) -> FromJSON ResultType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ResultType]
$cparseJSONList :: Value -> Parser [ResultType]
parseJSON :: Value -> Parser ResultType
$cparseJSON :: Value -> Parser ResultType
FromJSON, Int -> ResultType -> ShowS
[ResultType] -> ShowS
ResultType -> String
(Int -> ResultType -> ShowS)
-> (ResultType -> String)
-> ([ResultType] -> ShowS)
-> Show ResultType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultType] -> ShowS
$cshowList :: [ResultType] -> ShowS
show :: ResultType -> String
$cshow :: ResultType -> String
showsPrec :: Int -> ResultType -> ShowS
$cshowsPrec :: Int -> ResultType -> ShowS
Show, ResultType -> ResultType -> Bool
(ResultType -> ResultType -> Bool)
-> (ResultType -> ResultType -> Bool) -> Eq ResultType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultType -> ResultType -> Bool
$c/= :: ResultType -> ResultType -> Bool
== :: ResultType -> ResultType -> Bool
$c== :: ResultType -> ResultType -> Bool
Eq, ResultType -> ()
(ResultType -> ()) -> NFData ResultType
forall a. (a -> ()) -> NFData a
rnf :: ResultType -> ()
$crnf :: ResultType -> ()
NFData)

pattern ResultTypeProgress :: ResultType
pattern $bResultTypeProgress :: ResultType
$mResultTypeProgress :: forall r. ResultType -> (Void# -> r) -> (Void# -> r) -> r
ResultTypeProgress = ResultType 105

pattern ResultTypeBuildLogLine :: ResultType
pattern $bResultTypeBuildLogLine :: ResultType
$mResultTypeBuildLogLine :: forall r. ResultType -> (Void# -> r) -> (Void# -> r) -> r
ResultTypeBuildLogLine = ResultType 101

data Field = Int !Word64 | String !Text
  deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic, Field -> ()
(Field -> ()) -> NFData Field
forall a. (a -> ()) -> NFData a
rnf :: Field -> ()
$crnf :: Field -> ()
NFData)

instance ToJSON Field where
  toJSON :: Field -> Value
toJSON (Int Word64
int) = Word64 -> Value
forall a. ToJSON a => a -> Value
A.toJSON Word64
int
  toJSON (String Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
s

instance FromJSON Field where
  parseJSON :: Value -> Parser Field
parseJSON Value
v =
    Word64 -> Field
Int (Word64 -> Field) -> Parser Word64 -> Parser Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v
      Parser Field -> Parser Field -> Parser Field
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Field
String (Text -> Field) -> Parser Text -> Parser Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

data LogEntry
  = Msg
      { LogEntry -> Word64
i :: !Word64,
        LogEntry -> Word64
ms :: !Word64,
        LogEntry -> Int
level :: !Int,
        LogEntry -> Text
msg :: !Text
      }
  | Start
      { i :: !Word64,
        ms :: !Word64,
        LogEntry -> ActivityId
act :: !ActivityId,
        level :: !Int,
        LogEntry -> ActivityType
typ :: !ActivityType,
        LogEntry -> Text
text :: !Text,
        LogEntry -> Vector Field
fields :: !(Vector Field),
        LogEntry -> ActivityId
parent :: !ActivityId
      }
  | Stop
      { i :: !Word64,
        ms :: !Word64,
        act :: !ActivityId
      }
  | Result
      { i :: !Word64,
        ms :: !Word64,
        act :: !ActivityId,
        LogEntry -> ResultType
rtype :: !ResultType,
        fields :: !(Vector Field)
      }
  deriving ((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
$cto :: forall x. Rep LogEntry x -> LogEntry
$cfrom :: forall x. LogEntry -> Rep LogEntry x
Generic, 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
showList :: [LogEntry] -> ShowS
$cshowList :: [LogEntry] -> ShowS
show :: LogEntry -> String
$cshow :: LogEntry -> String
showsPrec :: Int -> LogEntry -> ShowS
$cshowsPrec :: Int -> LogEntry -> ShowS
Show, LogEntry -> LogEntry -> Bool
(LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool) -> Eq LogEntry
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, LogEntry -> ()
(LogEntry -> ()) -> NFData LogEntry
forall a. (a -> ()) -> NFData a
rnf :: LogEntry -> ()
$crnf :: LogEntry -> ()
NFData, [LogEntry] -> Encoding
[LogEntry] -> Value
LogEntry -> Encoding
LogEntry -> Value
(LogEntry -> Value)
-> (LogEntry -> Encoding)
-> ([LogEntry] -> Value)
-> ([LogEntry] -> Encoding)
-> ToJSON LogEntry
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, Value -> Parser [LogEntry]
Value -> Parser LogEntry
(Value -> Parser LogEntry)
-> (Value -> Parser [LogEntry]) -> FromJSON 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)