module Rattletrap.Type.Attribute.PartyLeader where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.RemoteId as RemoteId
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data PartyLeader = PartyLeader
  { PartyLeader -> U8
systemId :: U8.U8,
    PartyLeader -> Maybe RemoteId
remoteId :: Maybe RemoteId.RemoteId,
    PartyLeader -> Maybe U8
localId :: Maybe U8.U8
  }
  deriving (PartyLeader -> PartyLeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartyLeader -> PartyLeader -> Bool
$c/= :: PartyLeader -> PartyLeader -> Bool
== :: PartyLeader -> PartyLeader -> Bool
$c== :: PartyLeader -> PartyLeader -> Bool
Eq, Int -> PartyLeader -> ShowS
[PartyLeader] -> ShowS
PartyLeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartyLeader] -> ShowS
$cshowList :: [PartyLeader] -> ShowS
show :: PartyLeader -> String
$cshow :: PartyLeader -> String
showsPrec :: Int -> PartyLeader -> ShowS
$cshowsPrec :: Int -> PartyLeader -> ShowS
Show)

instance Json.FromJSON PartyLeader where
  parseJSON :: Value -> Parser PartyLeader
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PartyLeader" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    U8
systemId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"system_id"
    Maybe (RemoteId, U8)
maybeId <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"id"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PartyLeader
        { U8
systemId :: U8
systemId :: U8
systemId,
          remoteId :: Maybe RemoteId
remoteId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Maybe (RemoteId, U8)
maybeId,
          localId :: Maybe U8
localId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Maybe (RemoteId, U8)
maybeId
        }

instance Json.ToJSON PartyLeader where
  toJSON :: PartyLeader -> Value
toJSON PartyLeader
x =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"system_id" forall a b. (a -> b) -> a -> b
$ PartyLeader -> U8
systemId PartyLeader
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" forall a b. (a -> b) -> a -> b
$ case (PartyLeader -> Maybe RemoteId
remoteId PartyLeader
x, PartyLeader -> Maybe U8
localId PartyLeader
x) of
          (Just RemoteId
r, Just U8
l) -> forall a. a -> Maybe a
Just (RemoteId
r, U8
l)
          (Maybe RemoteId, Maybe U8)
_ -> forall a. Maybe a
Nothing
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-party-leader" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"system_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" forall a b. (a -> b) -> a -> b
$
            [Value] -> Value
Schema.oneOf
              [ [Value] -> Value
Schema.tuple [Schema -> Value
Schema.ref Schema
RemoteId.schema, Schema -> Value
Schema.ref Schema
U8.schema],
                Schema -> Value
Schema.ref Schema
Schema.null
              ],
          Bool
False
        )
      ]

bitPut :: PartyLeader -> BitPut.BitPut
bitPut :: PartyLeader -> BitPut
bitPut PartyLeader
x =
  U8 -> BitPut
U8.bitPut (PartyLeader -> U8
systemId PartyLeader
x)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RemoteId -> BitPut
RemoteId.bitPut (PartyLeader -> Maybe RemoteId
remoteId PartyLeader
x)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      U8 -> BitPut
U8.bitPut
      (PartyLeader -> Maybe U8
localId PartyLeader
x)

bitGet :: Version.Version -> BitGet.BitGet PartyLeader
bitGet :: Version -> BitGet PartyLeader
bitGet Version
version = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PartyLeader" forall a b. (a -> b) -> a -> b
$ do
  U8
systemId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"systemId" BitGet U8
U8.bitGet
  (Maybe RemoteId
remoteId, Maybe U8
localId) <-
    if U8
systemId forall a. Eq a => a -> a -> Bool
== Word8 -> U8
U8.fromWord8 Word8
0
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
      else do
        RemoteId
remoteId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"remoteId" forall a b. (a -> b) -> a -> b
$ Version -> U8 -> BitGet RemoteId
RemoteId.bitGet Version
version U8
systemId
        U8
localId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"localId" BitGet U8
U8.bitGet
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just RemoteId
remoteId, forall a. a -> Maybe a
Just U8
localId)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure PartyLeader {U8
systemId :: U8
systemId :: U8
systemId, Maybe RemoteId
remoteId :: Maybe RemoteId
remoteId :: Maybe RemoteId
remoteId, Maybe U8
localId :: Maybe U8
localId :: Maybe U8
localId}