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
(I64 -> I64 -> Bool) -> (I64 -> I64 -> Bool) -> Eq I64
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
(Int -> I64 -> ShowS)
-> (I64 -> String) -> ([I64] -> ShowS) -> Show I64
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 =
    String -> (Text -> Parser I64) -> Value -> Parser I64
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"I64"
      ((Text -> Parser I64) -> Value -> Parser I64)
-> (Text -> Parser I64) -> Value -> Parser I64
forall a b. (a -> b) -> a -> b
$ (String -> Parser I64)
-> (Int64 -> Parser I64) -> Either String Int64 -> Parser I64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser I64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (I64 -> Parser I64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (I64 -> Parser I64) -> (Int64 -> I64) -> Int64 -> Parser I64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> I64
fromInt64)
      (Either String Int64 -> Parser I64)
-> (Text -> Either String Int64) -> Text -> Parser I64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Int64
forall a. Read a => String -> Either String a
Read.readEither
      (String -> Either String Int64)
-> (Text -> String) -> Text -> Either String Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance Json.ToJSON I64 where
  toJSON :: I64 -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (String -> Value) -> (I64 -> String) -> I64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> (I64 -> Int64) -> I64 -> String
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"
  (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"string", String -> String -> Pair
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 (Int64 -> BytePut) -> (I64 -> Int64) -> I64 -> BytePut
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 (BytePut -> BitPut) -> (I64 -> BytePut) -> I64 -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I64 -> BytePut
bytePut

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

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