module Rattletrap.Type.RemoteId.PsyNet where

import qualified Control.Applicative as Applicative
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data PsyNet
  = New U64.U64
  | Old U64.U64 U64.U64 U64.U64 U64.U64
  deriving (PsyNet -> PsyNet -> Bool
(PsyNet -> PsyNet -> Bool)
-> (PsyNet -> PsyNet -> Bool) -> Eq PsyNet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PsyNet -> PsyNet -> Bool
== :: PsyNet -> PsyNet -> Bool
$c/= :: PsyNet -> PsyNet -> Bool
/= :: PsyNet -> PsyNet -> Bool
Eq, Int -> PsyNet -> ShowS
[PsyNet] -> ShowS
PsyNet -> String
(Int -> PsyNet -> ShowS)
-> (PsyNet -> String) -> ([PsyNet] -> ShowS) -> Show PsyNet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PsyNet -> ShowS
showsPrec :: Int -> PsyNet -> ShowS
$cshow :: PsyNet -> String
show :: PsyNet -> String
$cshowList :: [PsyNet] -> ShowS
showList :: [PsyNet] -> ShowS
Show)

instance Json.FromJSON PsyNet where
  parseJSON :: Value -> Parser PsyNet
parseJSON = String -> (Object -> Parser PsyNet) -> Value -> Parser PsyNet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PsyNet" ((Object -> Parser PsyNet) -> Value -> Parser PsyNet)
-> (Object -> Parser PsyNet) -> Value -> Parser PsyNet
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    let new :: Parser PsyNet
new = (U64 -> PsyNet) -> Parser U64 -> Parser PsyNet
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U64 -> PsyNet
New (Parser U64 -> Parser PsyNet) -> Parser U64 -> Parser PsyNet
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser U64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"Left"
        old :: Parser PsyNet
old = do
          (U64
a, U64
b, U64
c, U64
d) <- Object -> String -> Parser (U64, U64, U64, U64)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"Right"
          PsyNet -> Parser PsyNet
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PsyNet -> Parser PsyNet) -> PsyNet -> Parser PsyNet
forall a b. (a -> b) -> a -> b
$ U64 -> U64 -> U64 -> U64 -> PsyNet
Old U64
a U64
b U64
c U64
d
    Parser PsyNet
new Parser PsyNet -> Parser PsyNet -> Parser PsyNet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> Parser PsyNet
old

instance Json.ToJSON PsyNet where
  toJSON :: PsyNet -> Value
toJSON PsyNet
x = case PsyNet
x of
    New U64
a -> [(Key, Value)] -> Value
Json.object [String -> U64 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"Left" U64
a]
    Old U64
a U64
b U64
c U64
d -> [(Key, Value)] -> Value
Json.object [String -> (U64, U64, U64, U64) -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"Right" (U64
a, U64
b, U64
c, U64
d)]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"remote-id-psy-net" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [Value] -> Value
Schema.oneOf
      [ [((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
"Left" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema, Bool
True)],
        [((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
"Right" (Value -> (Key, Value))
-> (Value -> Value) -> Value -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.tuple ([Value] -> Value) -> (Value -> [Value]) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
4 (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema,
              Bool
True
            )
          ]
      ]

bitPut :: PsyNet -> BitPut.BitPut
bitPut :: PsyNet -> BitPut
bitPut PsyNet
x = case PsyNet
x of
  New U64
l -> U64 -> BitPut
U64.bitPut U64
l
  Old U64
a U64
b U64
c U64
d -> U64 -> BitPut
U64.bitPut U64
a BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
b BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
c BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
d

bitGet :: Version.Version -> BitGet.BitGet PsyNet
bitGet :: Version -> BitGet PsyNet
bitGet Version
version =
  String -> BitGet PsyNet -> BitGet PsyNet
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PsyNet" (BitGet PsyNet -> BitGet PsyNet) -> BitGet PsyNet -> BitGet PsyNet
forall a b. (a -> b) -> a -> b
$
    if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
24 Int
10 Version
version
      then String -> BitGet PsyNet -> BitGet PsyNet
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"New" (BitGet PsyNet -> BitGet PsyNet) -> BitGet PsyNet -> BitGet PsyNet
forall a b. (a -> b) -> a -> b
$ (U64 -> PsyNet) -> Get BitString Identity U64 -> BitGet PsyNet
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 U64 -> PsyNet
New Get BitString Identity U64
U64.bitGet
      else String -> BitGet PsyNet -> BitGet PsyNet
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Old" (BitGet PsyNet -> BitGet PsyNet) -> BitGet PsyNet -> BitGet PsyNet
forall a b. (a -> b) -> a -> b
$ do
        U64
a <- Get BitString Identity U64
U64.bitGet
        U64
b <- Get BitString Identity U64
U64.bitGet
        U64
c <- Get BitString Identity U64
U64.bitGet
        U64
d <- Get BitString Identity U64
U64.bitGet
        PsyNet -> BitGet PsyNet
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PsyNet -> BitGet PsyNet) -> PsyNet -> BitGet PsyNet
forall a b. (a -> b) -> a -> b
$ U64 -> U64 -> U64 -> U64 -> PsyNet
Old U64
a U64
b U64
c U64
d