module Rattletrap.Type.Property.Int where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Utility.Json as Json
import Prelude hiding (Int)

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

fromI32 :: I32.I32 -> Int
fromI32 :: I32 -> Int
fromI32 = I32 -> Int
Int

toI32 :: Int -> I32.I32
toI32 :: Int -> I32
toI32 (Int I32
x) = I32
x

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

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

schema :: Schema.Schema
schema :: Schema
schema = Schema
I32.schema

bytePut :: Int -> BytePut.BytePut
bytePut :: Int -> BytePut
bytePut = I32 -> BytePut
I32.bytePut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> I32
toI32

byteGet :: ByteGet.ByteGet Int
byteGet :: ByteGet Int
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 I32 -> Int
fromI32 ByteGet I32
I32.byteGet