module Rattletrap.Type.U32 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 U32
  = U32 Word.Word32
  deriving (U32 -> U32 -> Bool
(U32 -> U32 -> Bool) -> (U32 -> U32 -> Bool) -> Eq U32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: U32 -> U32 -> Bool
== :: U32 -> U32 -> Bool
$c/= :: U32 -> U32 -> Bool
/= :: U32 -> U32 -> Bool
Eq, Eq U32
Eq U32 =>
(U32 -> U32 -> Ordering)
-> (U32 -> U32 -> Bool)
-> (U32 -> U32 -> Bool)
-> (U32 -> U32 -> Bool)
-> (U32 -> U32 -> Bool)
-> (U32 -> U32 -> U32)
-> (U32 -> U32 -> U32)
-> Ord U32
U32 -> U32 -> Bool
U32 -> U32 -> Ordering
U32 -> U32 -> U32
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
$ccompare :: U32 -> U32 -> Ordering
compare :: U32 -> U32 -> Ordering
$c< :: U32 -> U32 -> Bool
< :: U32 -> U32 -> Bool
$c<= :: U32 -> U32 -> Bool
<= :: U32 -> U32 -> Bool
$c> :: U32 -> U32 -> Bool
> :: U32 -> U32 -> Bool
$c>= :: U32 -> U32 -> Bool
>= :: U32 -> U32 -> Bool
$cmax :: U32 -> U32 -> U32
max :: U32 -> U32 -> U32
$cmin :: U32 -> U32 -> U32
min :: U32 -> U32 -> U32
Ord, Int -> U32 -> ShowS
[U32] -> ShowS
U32 -> String
(Int -> U32 -> ShowS)
-> (U32 -> String) -> ([U32] -> ShowS) -> Show U32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> U32 -> ShowS
showsPrec :: Int -> U32 -> ShowS
$cshow :: U32 -> String
show :: U32 -> String
$cshowList :: [U32] -> ShowS
showList :: [U32] -> ShowS
Show)

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

instance Json.ToJSON U32 where
  toJSON :: U32 -> Value
toJSON = Word32 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Word32 -> Value) -> (U32 -> Word32) -> U32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
toWord32

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"u32" (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 -> Word32 -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"minimum" (Word32
forall a. Bounded a => a
minBound :: Word.Word32),
        String -> Word32 -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"maximum" (Word32
forall a. Bounded a => a
maxBound :: Word.Word32)
      ]

fromWord32 :: Word.Word32 -> U32
fromWord32 :: Word32 -> U32
fromWord32 = Word32 -> U32
U32

toWord32 :: U32 -> Word.Word32
toWord32 :: U32 -> Word32
toWord32 (U32 Word32
x) = Word32
x

bytePut :: U32 -> BytePut.BytePut
bytePut :: U32 -> BytePut
bytePut = Word32 -> BytePut
BytePut.word32 (Word32 -> BytePut) -> (U32 -> Word32) -> U32 -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
toWord32

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

byteGet :: ByteGet.ByteGet U32
byteGet :: ByteGet U32
byteGet = String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"U32" (ByteGet U32 -> ByteGet U32) -> ByteGet U32 -> ByteGet U32
forall a b. (a -> b) -> a -> b
$ (Word32 -> U32) -> Get ByteString Identity Word32 -> ByteGet U32
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 Word32 -> U32
fromWord32 Get ByteString Identity Word32
ByteGet.word32

bitGet :: BitGet.BitGet U32
bitGet :: BitGet U32
bitGet = ByteGet U32 -> Int -> BitGet U32
forall a. ByteGet a -> Int -> BitGet a
BitGet.fromByteGet ByteGet U32
byteGet Int
4