module Rattletrap.Type.Attribute.Int where

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

newtype Int = Int
  { Int -> I32
value :: 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)

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

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-int" (Value -> Schema) -> Value -> Schema
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 = String -> BitGet Int -> BitGet Int
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Int" (BitGet Int -> BitGet Int) -> BitGet Int -> BitGet Int
forall a b. (a -> b) -> a -> b
$ do
  I32
value <- String -> BitGet I32 -> BitGet I32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet I32
I32.bitGet
  Int -> BitGet Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int :: I32 -> Int
Int { I32
value :: I32
value :: I32
value }