module Rattletrap.Type.RemoteId.Xbox where

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.Utility.Json as Json

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

instance Json.FromJSON Xbox where
  parseJSON :: Value -> Parser Xbox
parseJSON = (U64 -> Xbox) -> Parser U64 -> Parser Xbox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U64 -> Xbox
fromU64 (Parser U64 -> Parser Xbox)
-> (Value -> Parser U64) -> Value -> Parser Xbox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser U64
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Xbox where
  toJSON :: Xbox -> Value
toJSON = U64 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (U64 -> Value) -> (Xbox -> U64) -> Xbox -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Xbox -> U64
toU64

fromU64 :: U64.U64 -> Xbox
fromU64 :: U64 -> Xbox
fromU64 = U64 -> Xbox
Xbox

toU64 :: Xbox -> U64.U64
toU64 :: Xbox -> U64
toU64 (Xbox U64
x) = U64
x

schema :: Schema.Schema
schema :: Schema
schema = Schema
U64.schema

bitPut :: Xbox -> BitPut.BitPut
bitPut :: Xbox -> BitPut
bitPut = U64 -> BitPut
U64.bitPut (U64 -> BitPut) -> (Xbox -> U64) -> Xbox -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Xbox -> U64
toU64

bitGet :: BitGet.BitGet Xbox
bitGet :: BitGet Xbox
bitGet = (U64 -> Xbox) -> Get BitString Identity U64 -> BitGet Xbox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U64 -> Xbox
fromU64 Get BitString Identity U64
U64.bitGet