module Rattletrap.Type.I8 where

import qualified Data.Int as Int
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 I8
  = I8 Int.Int8
  deriving (I8 -> I8 -> Bool
(I8 -> I8 -> Bool) -> (I8 -> I8 -> Bool) -> Eq I8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: I8 -> I8 -> Bool
== :: I8 -> I8 -> Bool
$c/= :: I8 -> I8 -> Bool
/= :: I8 -> I8 -> Bool
Eq, Int -> I8 -> ShowS
[I8] -> ShowS
I8 -> String
(Int -> I8 -> ShowS)
-> (I8 -> String) -> ([I8] -> ShowS) -> Show I8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> I8 -> ShowS
showsPrec :: Int -> I8 -> ShowS
$cshow :: I8 -> String
show :: I8 -> String
$cshowList :: [I8] -> ShowS
showList :: [I8] -> ShowS
Show)

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

instance Json.ToJSON I8 where
  toJSON :: I8 -> Value
toJSON = Int8 -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Int8 -> Value) -> (I8 -> Int8) -> I8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I8 -> Int8
toInt8

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

fromInt8 :: Int.Int8 -> I8
fromInt8 :: Int8 -> I8
fromInt8 = Int8 -> I8
I8

toInt8 :: I8 -> Int.Int8
toInt8 :: I8 -> Int8
toInt8 (I8 Int8
x) = Int8
x

bytePut :: I8 -> BytePut.BytePut
bytePut :: I8 -> BytePut
bytePut = Int8 -> BytePut
BytePut.int8 (Int8 -> BytePut) -> (I8 -> Int8) -> I8 -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I8 -> Int8
toInt8

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

byteGet :: ByteGet.ByteGet I8
byteGet :: ByteGet I8
byteGet = String -> ByteGet I8 -> ByteGet I8
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"I8" (ByteGet I8 -> ByteGet I8) -> ByteGet I8 -> ByteGet I8
forall a b. (a -> b) -> a -> b
$ (Int8 -> I8) -> Get ByteString Identity Int8 -> ByteGet I8
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 Int8 -> I8
fromInt8 Get ByteString Identity Int8
ByteGet.int8

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