module Rattletrap.Type.U8 where

import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Utility.Json as Json

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

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

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

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"u8" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [Pair] -> Value
Json.object
      [ String -> String -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"integer",
        String -> Word8 -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"minimum" (Word8
forall a. Bounded a => a
minBound :: Word.Word8),
        String -> Word8 -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"maximum" (Word8
forall a. Bounded a => a
maxBound :: Word.Word8)
      ]

fromWord8 :: Word.Word8 -> U8
fromWord8 :: Word8 -> U8
fromWord8 = Word8 -> U8
U8

toWord8 :: U8 -> Word.Word8
toWord8 :: U8 -> Word8
toWord8 (U8 Word8
x) = Word8
x

bytePut :: U8 -> BytePut.BytePut
bytePut :: U8 -> BytePut
bytePut = Word8 -> BytePut
BytePut.word8 (Word8 -> BytePut) -> (U8 -> Word8) -> U8 -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U8 -> Word8
toWord8

bitPut :: U8 -> BitPut.BitPut
bitPut :: U8 -> BitPut
bitPut = BytePut -> BitPut
BitPut.fromBytePut (BytePut -> BitPut) -> (U8 -> BytePut) -> U8 -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U8 -> BytePut
bytePut

byteGet :: ByteGet.ByteGet U8
byteGet :: ByteGet U8
byteGet = String -> ByteGet U8 -> ByteGet U8
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"U8" (ByteGet U8 -> ByteGet U8) -> ByteGet U8 -> ByteGet U8
forall a b. (a -> b) -> a -> b
$ (Word8 -> U8) -> Get ByteString Identity Word8 -> ByteGet U8
forall a b.
(a -> b) -> Get ByteString Identity a -> Get ByteString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> U8
fromWord8 Get ByteString Identity Word8
ByteGet.word8

bitGet :: BitGet.BitGet U8
bitGet :: BitGet U8
bitGet = ByteGet U8 -> Int -> BitGet U8
forall a. ByteGet a -> Int -> BitGet a
BitGet.fromByteGet ByteGet U8
byteGet Int
1