module Rattletrap.Type.Property.QWord where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Utility.Json as Json

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

fromU64 :: U64.U64 -> QWord
fromU64 :: U64 -> QWord
fromU64 = U64 -> QWord
QWord

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

instance Json.FromJSON QWord where
  parseJSON :: Value -> Parser QWord
parseJSON = (U64 -> QWord) -> Parser U64 -> Parser QWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U64 -> QWord
fromU64 (Parser U64 -> Parser QWord)
-> (Value -> Parser U64) -> Value -> Parser QWord
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 QWord where
  toJSON :: QWord -> Value
toJSON = U64 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (U64 -> Value) -> (QWord -> U64) -> QWord -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QWord -> U64
toU64

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

bytePut :: QWord -> BytePut.BytePut
bytePut :: QWord -> BytePut
bytePut = U64 -> BytePut
U64.bytePut (U64 -> BytePut) -> (QWord -> U64) -> QWord -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QWord -> U64
toU64

byteGet :: ByteGet.ByteGet QWord
byteGet :: ByteGet QWord
byteGet = String -> ByteGet QWord -> ByteGet QWord
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"QWord" (ByteGet QWord -> ByteGet QWord) -> ByteGet QWord -> ByteGet QWord
forall a b. (a -> b) -> a -> b
$ (U64 -> QWord) -> Get ByteString Identity U64 -> ByteGet QWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U64 -> QWord
fromU64 Get ByteString Identity U64
U64.byteGet