{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.ByteAttribute
  ( ByteAttribute(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.Word8le

newtype ByteAttribute = ByteAttribute
  { ByteAttribute -> Word8le
byteAttributeValue :: Word8le
  } deriving (ByteAttribute -> ByteAttribute -> Bool
(ByteAttribute -> ByteAttribute -> Bool)
-> (ByteAttribute -> ByteAttribute -> Bool) -> Eq ByteAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteAttribute -> ByteAttribute -> Bool
$c/= :: ByteAttribute -> ByteAttribute -> Bool
== :: ByteAttribute -> ByteAttribute -> Bool
$c== :: ByteAttribute -> ByteAttribute -> Bool
Eq, Eq ByteAttribute
Eq ByteAttribute
-> (ByteAttribute -> ByteAttribute -> Ordering)
-> (ByteAttribute -> ByteAttribute -> Bool)
-> (ByteAttribute -> ByteAttribute -> Bool)
-> (ByteAttribute -> ByteAttribute -> Bool)
-> (ByteAttribute -> ByteAttribute -> Bool)
-> (ByteAttribute -> ByteAttribute -> ByteAttribute)
-> (ByteAttribute -> ByteAttribute -> ByteAttribute)
-> Ord ByteAttribute
ByteAttribute -> ByteAttribute -> Bool
ByteAttribute -> ByteAttribute -> Ordering
ByteAttribute -> ByteAttribute -> ByteAttribute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ByteAttribute -> ByteAttribute -> ByteAttribute
$cmin :: ByteAttribute -> ByteAttribute -> ByteAttribute
max :: ByteAttribute -> ByteAttribute -> ByteAttribute
$cmax :: ByteAttribute -> ByteAttribute -> ByteAttribute
>= :: ByteAttribute -> ByteAttribute -> Bool
$c>= :: ByteAttribute -> ByteAttribute -> Bool
> :: ByteAttribute -> ByteAttribute -> Bool
$c> :: ByteAttribute -> ByteAttribute -> Bool
<= :: ByteAttribute -> ByteAttribute -> Bool
$c<= :: ByteAttribute -> ByteAttribute -> Bool
< :: ByteAttribute -> ByteAttribute -> Bool
$c< :: ByteAttribute -> ByteAttribute -> Bool
compare :: ByteAttribute -> ByteAttribute -> Ordering
$ccompare :: ByteAttribute -> ByteAttribute -> Ordering
$cp1Ord :: Eq ByteAttribute
Ord, Int -> ByteAttribute -> ShowS
[ByteAttribute] -> ShowS
ByteAttribute -> String
(Int -> ByteAttribute -> ShowS)
-> (ByteAttribute -> String)
-> ([ByteAttribute] -> ShowS)
-> Show ByteAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteAttribute] -> ShowS
$cshowList :: [ByteAttribute] -> ShowS
show :: ByteAttribute -> String
$cshow :: ByteAttribute -> String
showsPrec :: Int -> ByteAttribute -> ShowS
$cshowsPrec :: Int -> ByteAttribute -> ShowS
Show)

$(deriveJson ''ByteAttribute)