module Rattletrap.Type.Property.Int where

import Prelude hiding (Int)
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

newtype Int
  = Int I32.I32
  deriving (Int -> Int -> Bool
(Int -> Int -> Bool) -> (Int -> Int -> Bool) -> Eq Int
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
(Int -> Int -> ShowS)
-> (Int -> String) -> ([Int] -> ShowS) -> Show Int
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 = (I32 -> Int) -> Parser I32 -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap I32 -> Int
fromI32 (Parser I32 -> Parser Int)
-> (Value -> Parser I32) -> Value -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser I32
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Int where
  toJSON :: Int -> Value
toJSON = I32 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (I32 -> Value) -> (Int -> I32) -> Int -> Value
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 (I32 -> BytePut) -> (Int -> I32) -> Int -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> I32
toI32

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