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

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

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"remote-id" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$
    ((String, Value) -> Value) -> [(String, Value)] -> [Value]
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 [(String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 -> (Splitscreen -> RemoteId)
-> Get BitString Identity Splitscreen -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Splitscreen -> RemoteId
Splitscreen Get BitString Identity Splitscreen
Splitscreen.bitGet
  Word8
1 -> (Steam -> RemoteId)
-> Get BitString Identity Steam -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Steam -> RemoteId
Steam Get BitString Identity Steam
Steam.bitGet
  Word8
2 -> (PlayStation -> RemoteId)
-> Get BitString Identity PlayStation -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlayStation -> RemoteId
PlayStation (Get BitString Identity PlayStation -> BitGet RemoteId)
-> Get BitString Identity PlayStation -> BitGet RemoteId
forall a b. (a -> b) -> a -> b
$ Version -> Get BitString Identity PlayStation
PlayStation.bitGet Version
version
  Word8
4 -> (Xbox -> RemoteId)
-> Get BitString Identity Xbox -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Xbox -> RemoteId
Xbox Get BitString Identity Xbox
Xbox.bitGet
  Word8
5 -> (QQ -> RemoteId) -> Get BitString Identity QQ -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QQ -> RemoteId
QQ Get BitString Identity QQ
QQ.bitGet
  Word8
6 -> (Switch -> RemoteId)
-> Get BitString Identity Switch -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Switch -> RemoteId
Switch Get BitString Identity Switch
Switch.bitGet
  Word8
7 -> (PsyNet -> RemoteId)
-> Get BitString Identity PsyNet -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PsyNet -> RemoteId
PsyNet (Get BitString Identity PsyNet -> BitGet RemoteId)
-> Get BitString Identity PsyNet -> BitGet RemoteId
forall a b. (a -> b) -> a -> b
$ Version -> Get BitString Identity PsyNet
PsyNet.bitGet Version
version
  Word8
11 -> (Epic -> RemoteId)
-> Get BitString Identity Epic -> BitGet RemoteId
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Epic -> RemoteId
Epic Get BitString Identity Epic
Epic.bitGet
  Word8
x -> UnknownSystemId -> BitGet RemoteId
forall e a. Exception e => e -> BitGet a
BitGet.throw (UnknownSystemId -> BitGet RemoteId)
-> UnknownSystemId -> BitGet RemoteId
forall a b. (a -> b) -> a -> b
$ Word8 -> UnknownSystemId
UnknownSystemId.UnknownSystemId Word8
x