module Rattletrap.Type.I32 where

import qualified Data.Int as Int
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Utility.Json as Json

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

instance Json.FromJSON I32 where
  parseJSON :: Value -> Parser I32
parseJSON = (Int32 -> I32) -> Parser Int32 -> Parser I32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> I32
fromInt32 (Parser Int32 -> Parser I32)
-> (Value -> Parser Int32) -> Value -> Parser I32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int32
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON I32 where
  toJSON :: I32 -> Value
toJSON = Int32 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Int32 -> Value) -> (I32 -> Int32) -> I32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I32 -> Int32
toInt32

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"i32" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object
  [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"integer"
  , String -> Int32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"minimum" (Int32
forall a. Bounded a => a
minBound :: Int.Int32)
  , String -> Int32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maximum" (Int32
forall a. Bounded a => a
maxBound :: Int.Int32)
  ]

fromInt32 :: Int.Int32 -> I32
fromInt32 :: Int32 -> I32
fromInt32 = Int32 -> I32
I32

toInt32 :: I32 -> Int.Int32
toInt32 :: I32 -> Int32
toInt32 (I32 Int32
x) = Int32
x

bytePut :: I32 -> BytePut.BytePut
bytePut :: I32 -> BytePut
bytePut = Int32 -> BytePut
BytePut.int32 (Int32 -> BytePut) -> (I32 -> Int32) -> I32 -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I32 -> Int32
toInt32

bitPut :: I32 -> BitPut.BitPut
bitPut :: I32 -> BitPut
bitPut = BytePut -> BitPut
BitPut.fromBytePut (BytePut -> BitPut) -> (I32 -> BytePut) -> I32 -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I32 -> BytePut
bytePut

byteGet :: ByteGet.ByteGet I32
byteGet :: ByteGet I32
byteGet = String -> ByteGet I32 -> ByteGet I32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"I32" (ByteGet I32 -> ByteGet I32) -> ByteGet I32 -> ByteGet I32
forall a b. (a -> b) -> a -> b
$ (Int32 -> I32) -> Get ByteString Identity Int32 -> ByteGet I32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> I32
fromInt32 Get ByteString Identity Int32
ByteGet.int32

bitGet :: BitGet.BitGet I32
bitGet :: BitGet I32
bitGet = ByteGet I32 -> Int -> BitGet I32
forall a. ByteGet a -> Int -> BitGet a
BitGet.fromByteGet ByteGet I32
byteGet Int
4