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
(PartyLeader -> PartyLeader -> Bool)
-> (PartyLeader -> PartyLeader -> Bool) -> Eq PartyLeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PartyLeader -> PartyLeader -> Bool
== :: PartyLeader -> PartyLeader -> Bool
$c/= :: PartyLeader -> PartyLeader -> Bool
/= :: PartyLeader -> PartyLeader -> Bool
Eq, Int -> PartyLeader -> ShowS
[PartyLeader] -> ShowS
PartyLeader -> String
(Int -> PartyLeader -> ShowS)
-> (PartyLeader -> String)
-> ([PartyLeader] -> ShowS)
-> Show PartyLeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartyLeader -> ShowS
showsPrec :: Int -> PartyLeader -> ShowS
$cshow :: PartyLeader -> String
show :: PartyLeader -> String
$cshowList :: [PartyLeader] -> ShowS
showList :: [PartyLeader] -> ShowS
Show)

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

instance Json.ToJSON PartyLeader where
  toJSON :: PartyLeader -> Value
toJSON PartyLeader
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> U8 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"system_id" (U8 -> (Key, Value)) -> U8 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PartyLeader -> U8
systemId PartyLeader
x,
        String -> Maybe (RemoteId, U8) -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"id" (Maybe (RemoteId, U8) -> (Key, Value))
-> Maybe (RemoteId, U8) -> (Key, Value)
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) -> (RemoteId, U8) -> Maybe (RemoteId, U8)
forall a. a -> Maybe a
Just (RemoteId
r, U8
l)
          (Maybe RemoteId, Maybe U8)
_ -> Maybe (RemoteId, U8)
forall a. Maybe a
Nothing
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-party-leader" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"system_id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True),
        ( String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"id" (Value -> (Key, Value)) -> Value -> (Key, Value)
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)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (RemoteId -> BitPut) -> Maybe RemoteId -> BitPut
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RemoteId -> BitPut
RemoteId.bitPut (PartyLeader -> Maybe RemoteId
remoteId PartyLeader
x)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (U8 -> BitPut) -> Maybe U8 -> BitPut
forall m a. Monoid m => (a -> m) -> Maybe a -> m
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 = String -> BitGet PartyLeader -> BitGet PartyLeader
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PartyLeader" (BitGet PartyLeader -> BitGet PartyLeader)
-> BitGet PartyLeader -> BitGet PartyLeader
forall a b. (a -> b) -> a -> b
$ do
  systemId <- String -> BitGet U8 -> BitGet U8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"systemId" BitGet U8
U8.bitGet
  (remoteId, localId) <-
    if systemId == U8.fromWord8 0
      then pure (Nothing, Nothing)
      else do
        remoteId <- BitGet.label "remoteId" $ RemoteId.bitGet version systemId
        localId <- BitGet.label "localId" U8.bitGet
        pure (Just remoteId, Just localId)
  pure PartyLeader {systemId, remoteId, localId}