module Rattletrap.Type.RemoteId where

import qualified Data.Foldable as Foldable
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Exception.UnknownSystemId as UnknownSystemId
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.RemoteId.Epic as Epic
import qualified Rattletrap.Type.RemoteId.PlayStation as PlayStation
import qualified Rattletrap.Type.RemoteId.PsyNet as PsyNet
import qualified Rattletrap.Type.RemoteId.QQ as QQ
import qualified Rattletrap.Type.RemoteId.Splitscreen as Splitscreen
import qualified Rattletrap.Type.RemoteId.Steam as Steam
import qualified Rattletrap.Type.RemoteId.Switch as Switch
import qualified Rattletrap.Type.RemoteId.Xbox as Xbox
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data RemoteId
  = PlayStation PlayStation.PlayStation
  | PsyNet PsyNet.PsyNet
  | QQ QQ.QQ
  | -- | Really only 24 bits.
    Splitscreen Splitscreen.Splitscreen
  | Steam Steam.Steam
  | Switch Switch.Switch
  | Xbox Xbox.Xbox
  | Epic Epic.Epic
  deriving (RemoteId -> RemoteId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteId -> RemoteId -> Bool
$c/= :: RemoteId -> RemoteId -> Bool
== :: RemoteId -> RemoteId -> Bool
$c== :: RemoteId -> RemoteId -> Bool
Eq, Int -> RemoteId -> ShowS
[RemoteId] -> ShowS
RemoteId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteId] -> ShowS
$cshowList :: [RemoteId] -> ShowS
show :: RemoteId -> String
$cshow :: RemoteId -> String
showsPrec :: Int -> RemoteId -> ShowS
$cshowsPrec :: Int -> RemoteId -> ShowS
Show)

instance Json.FromJSON RemoteId where
  parseJSON :: Value -> Parser RemoteId
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"RemoteId" forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayStation -> RemoteId
PlayStation forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"play_station",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PsyNet -> RemoteId
PsyNet forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"psy_net",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QQ -> RemoteId
QQ forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"qq",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Splitscreen -> RemoteId
Splitscreen forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"splitscreen",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Steam -> RemoteId
Steam forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"steam",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Switch -> RemoteId
Switch forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"switch",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Xbox -> RemoteId
Xbox forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"xbox",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Epic -> RemoteId
Epic forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"epic"
      ]

instance Json.ToJSON RemoteId where
  toJSON :: RemoteId -> Value
toJSON RemoteId
x = case RemoteId
x of
    PlayStation PlayStation
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"play_station" PlayStation
y]
    PsyNet PsyNet
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"psy_net" PsyNet
y]
    QQ QQ
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"qq" QQ
y]
    Splitscreen Splitscreen
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"splitscreen" Splitscreen
y]
    Steam Steam
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"steam" Steam
y]
    Switch Switch
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"switch" Switch
y]
    Xbox Xbox
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"xbox" Xbox
y]
    Epic Epic
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"epic" Epic
y]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"remote-id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Value
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k Value
v, Bool
True)])
      [ (String
"play_station", Schema -> Value
Schema.ref Schema
PlayStation.schema),
        (String
"psy_net", Schema -> Value
Schema.ref Schema
PsyNet.schema),
        (String
"qq", Schema -> Value
Schema.ref Schema
QQ.schema),
        (String
"splitscreen", Schema -> Value
Schema.ref Schema
Splitscreen.schema),
        (String
"steam", Schema -> Value
Schema.ref Schema
Steam.schema),
        (String
"switch", Schema -> Value
Schema.ref Schema
Switch.schema),
        (String
"xbox", Schema -> Value
Schema.ref Schema
Xbox.schema),
        (String
"epic", Schema -> Value
Schema.ref Schema
Epic.schema)
      ]

bitPut :: RemoteId -> BitPut.BitPut
bitPut :: RemoteId -> BitPut
bitPut RemoteId
remoteId = case RemoteId
remoteId of
  PlayStation PlayStation
x -> PlayStation -> BitPut
PlayStation.bitPut PlayStation
x
  PsyNet PsyNet
x -> PsyNet -> BitPut
PsyNet.bitPut PsyNet
x
  QQ QQ
x -> QQ -> BitPut
QQ.bitPut QQ
x
  Splitscreen Splitscreen
x -> Splitscreen -> BitPut
Splitscreen.bitPut Splitscreen
x
  Steam Steam
x -> Steam -> BitPut
Steam.bitPut Steam
x
  Switch Switch
x -> Switch -> BitPut
Switch.bitPut Switch
x
  Xbox Xbox
x -> Xbox -> BitPut
Xbox.bitPut Xbox
x
  Epic Epic
x -> Epic -> BitPut
Epic.bitPut Epic
x

bitGet :: Version.Version -> U8.U8 -> BitGet.BitGet RemoteId
bitGet :: Version -> U8 -> BitGet RemoteId
bitGet Version
version U8
systemId = case U8 -> Word8
U8.toWord8 U8
systemId of
  Word8
0 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Splitscreen -> RemoteId
Splitscreen BitGet Splitscreen
Splitscreen.bitGet
  Word8
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Steam -> RemoteId
Steam BitGet Steam
Steam.bitGet
  Word8
2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayStation -> RemoteId
PlayStation forall a b. (a -> b) -> a -> b
$ Version -> BitGet PlayStation
PlayStation.bitGet Version
version
  Word8
4 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Xbox -> RemoteId
Xbox BitGet Xbox
Xbox.bitGet
  Word8
5 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QQ -> RemoteId
QQ BitGet QQ
QQ.bitGet
  Word8
6 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Switch -> RemoteId
Switch BitGet Switch
Switch.bitGet
  Word8
7 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PsyNet -> RemoteId
PsyNet forall a b. (a -> b) -> a -> b
$ Version -> BitGet PsyNet
PsyNet.bitGet Version
version
  Word8
11 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Epic -> RemoteId
Epic BitGet Epic
Epic.bitGet
  Word8
x -> forall e a. Exception e => e -> BitGet a
BitGet.throw forall a b. (a -> b) -> a -> b
$ Word8 -> UnknownSystemId
UnknownSystemId.UnknownSystemId Word8
x