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
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
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> I32
fromInt32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON I32 where
  toJSON :: I32 -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" forall a b. (a -> b) -> a -> b
$
    [Pair] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"integer",
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"minimum" (forall a. Bounded a => a
minBound :: Int.Int32),
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maximum" (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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. I32 -> BytePut
bytePut

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

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