module Rattletrap.Type.U64 where

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

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

instance Json.FromJSON U64 where
  parseJSON :: Value -> Parser U64
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"U64" 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
. Word64 -> U64
fromWord64)
        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 U64 where
  toJSON :: U64 -> 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
. U64 -> Word64
toWord64

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"u64" 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]+$"]

fromWord64 :: Word.Word64 -> U64
fromWord64 :: Word64 -> U64
fromWord64 = Word64 -> U64
U64

toWord64 :: U64 -> Word.Word64
toWord64 :: U64 -> Word64
toWord64 (U64 Word64
x) = Word64
x

bytePut :: U64 -> BytePut.BytePut
bytePut :: U64 -> BytePut
bytePut = Word64 -> BytePut
BytePut.word64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. U64 -> Word64
toWord64

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

byteGet :: ByteGet.ByteGet U64
byteGet :: ByteGet U64
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"U64" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> U64
fromWord64 ByteGet Word64
ByteGet.word64

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