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

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

instance Json.ToJSON U32 where
  toJSON :: U32 -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" forall a b. (a -> b) -> a -> b
$
    [Pair] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"integer",
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"minimum" (forall a. Bounded a => a
minBound :: Word.Word32),
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maximum" (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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> BytePut
bytePut

byteGet :: ByteGet.ByteGet U32
byteGet :: ByteGet U32
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"U32" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> U32
fromWord32 ByteGet Word32
ByteGet.word32

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