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
/= :: PartyLeader -> PartyLeader -> Bool
$c/= :: PartyLeader -> PartyLeader -> Bool
== :: PartyLeader -> PartyLeader -> Bool
$c== :: 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
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 = 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
    U8
systemId <- Object -> String -> Parser U8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"system_id"
    Maybe (RemoteId, U8)
maybeId <- Object -> String -> Parser (Maybe (RemoteId, U8))
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"id"
    PartyLeader -> Parser PartyLeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartyLeader :: U8 -> Maybe RemoteId -> Maybe U8 -> PartyLeader
PartyLeader
      { U8
systemId :: U8
systemId :: U8
systemId
      , remoteId :: Maybe RemoteId
remoteId = ((RemoteId, U8) -> RemoteId)
-> Maybe (RemoteId, U8) -> Maybe RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteId, U8) -> RemoteId
forall a b. (a, b) -> a
fst Maybe (RemoteId, U8)
maybeId
      , localId :: Maybe U8
localId = ((RemoteId, U8) -> U8) -> Maybe (RemoteId, U8) -> Maybe U8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteId, U8) -> U8
forall a b. (a, b) -> b
snd Maybe (RemoteId, U8)
maybeId
      }

instance Json.ToJSON PartyLeader where
  toJSON :: PartyLeader -> Value
toJSON PartyLeader
x = [Pair] -> Value
Json.object
    [ String -> U8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"system_id" (U8 -> Pair) -> U8 -> Pair
forall a b. (a -> b) -> a -> b
$ PartyLeader -> U8
systemId PartyLeader
x
    , String -> Maybe (RemoteId, U8) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" (Maybe (RemoteId, U8) -> Pair) -> Maybe (RemoteId, U8) -> Pair
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
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"system_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True)
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"id" (Value -> Pair) -> Value -> Pair
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 (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 (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
  U8
systemId <- String -> BitGet U8 -> BitGet U8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"systemId" BitGet U8
U8.bitGet
  (Maybe RemoteId
remoteId, Maybe U8
localId) <- if U8
systemId U8 -> U8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> U8
U8.fromWord8 Word8
0
    then (Maybe RemoteId, Maybe U8)
-> Get BitString Identity (Maybe RemoteId, Maybe U8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RemoteId
forall a. Maybe a
Nothing, Maybe U8
forall a. Maybe a
Nothing)
    else do
      RemoteId
remoteId <- String -> BitGet RemoteId -> BitGet RemoteId
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"remoteId" (BitGet RemoteId -> BitGet RemoteId)
-> BitGet RemoteId -> BitGet RemoteId
forall a b. (a -> b) -> a -> b
$ Version -> U8 -> BitGet RemoteId
RemoteId.bitGet Version
version U8
systemId
      U8
localId <- String -> BitGet U8 -> BitGet U8
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"localId" BitGet U8
U8.bitGet
      (Maybe RemoteId, Maybe U8)
-> Get BitString Identity (Maybe RemoteId, Maybe U8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteId -> Maybe RemoteId
forall a. a -> Maybe a
Just RemoteId
remoteId, U8 -> Maybe U8
forall a. a -> Maybe a
Just U8
localId)
  PartyLeader -> BitGet PartyLeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartyLeader :: U8 -> Maybe RemoteId -> Maybe U8 -> PartyLeader
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 }