module Rattletrap.Type.I64 where

import qualified Data.Int as Int
import qualified Data.Text as Text
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
import qualified Text.Read as Read

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

instance Json.FromJSON I64 where
  parseJSON :: Value -> Parser I64
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"I64" forall a b. (a -> b) -> a -> b
$
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> I64
fromInt64)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Either String a
Read.readEither
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance Json.ToJSON I64 where
  toJSON :: I64 -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. I64 -> Int64
toInt64

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"i64" 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
"string", forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"pattern" String
"^-?[0-9]+$"]

fromInt64 :: Int.Int64 -> I64
fromInt64 :: Int64 -> I64
fromInt64 = Int64 -> I64
I64

toInt64 :: I64 -> Int.Int64
toInt64 :: I64 -> Int64
toInt64 (I64 Int64
x) = Int64
x

bytePut :: I64 -> BytePut.BytePut
bytePut :: I64 -> BytePut
bytePut = Int64 -> BytePut
BytePut.int64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. I64 -> Int64
toInt64

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

byteGet :: ByteGet.ByteGet I64
byteGet :: ByteGet I64
byteGet = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> I64
fromInt64 ByteGet Int64
ByteGet.int64

bitGet :: BitGet.BitGet I64
bitGet :: BitGet I64
bitGet = forall a. ByteGet a -> Int -> BitGet a
BitGet.fromByteGet ByteGet I64
byteGet Int
8