module Rattletrap.Type.Attribute.Int where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
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
  { Int -> I32
value :: 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)

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
Int 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
value

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-int" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
I32.schema

bitPut :: Int -> BitPut.BitPut
bitPut :: Int -> BitPut
bitPut Int
intAttribute = I32 -> BitPut
I32.bitPut (Int -> I32
value Int
intAttribute)

bitGet :: BitGet.BitGet Int
bitGet :: BitGet Int
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Int" forall a b. (a -> b) -> a -> b
$ do
  I32
value <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet I32
I32.bitGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Int {I32
value :: I32
value :: I32
value}