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

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

instance Json.ToJSON I8 where
  toJSON :: I8 -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" 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 :: Int.Int8),
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maximum" (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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. I8 -> BytePut
bytePut

byteGet :: ByteGet.ByteGet I8
byteGet :: ByteGet I8
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"I8" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> I8
fromInt8 ByteGet Int8
ByteGet.int8

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