module Rattletrap.Type.Attribute.Byte where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Utility.Json as Json

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

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

instance Json.ToJSON Byte where
  toJSON :: Byte -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Byte -> U8
value

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

bitPut :: Byte -> BitPut.BitPut
bitPut :: Byte -> BitPut
bitPut Byte
byteAttribute = U8 -> BitPut
U8.bitPut (Byte -> U8
value Byte
byteAttribute)

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