module Rattletrap.Type.Word64le
  ( Word64le(..)
  )
where

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Data.Word as Word
import qualified Text.Read as Read

newtype Word64le = Word64le
  { Word64le -> Word64
word64leValue :: Word.Word64
  } deriving (Word64le -> Word64le -> Bool
(Word64le -> Word64le -> Bool)
-> (Word64le -> Word64le -> Bool) -> Eq Word64le
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word64le -> Word64le -> Bool
$c/= :: Word64le -> Word64le -> Bool
== :: Word64le -> Word64le -> Bool
$c== :: Word64le -> Word64le -> Bool
Eq, Eq Word64le
Eq Word64le
-> (Word64le -> Word64le -> Ordering)
-> (Word64le -> Word64le -> Bool)
-> (Word64le -> Word64le -> Bool)
-> (Word64le -> Word64le -> Bool)
-> (Word64le -> Word64le -> Bool)
-> (Word64le -> Word64le -> Word64le)
-> (Word64le -> Word64le -> Word64le)
-> Ord Word64le
Word64le -> Word64le -> Bool
Word64le -> Word64le -> Ordering
Word64le -> Word64le -> Word64le
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Word64le -> Word64le -> Word64le
$cmin :: Word64le -> Word64le -> Word64le
max :: Word64le -> Word64le -> Word64le
$cmax :: Word64le -> Word64le -> Word64le
>= :: Word64le -> Word64le -> Bool
$c>= :: Word64le -> Word64le -> Bool
> :: Word64le -> Word64le -> Bool
$c> :: Word64le -> Word64le -> Bool
<= :: Word64le -> Word64le -> Bool
$c<= :: Word64le -> Word64le -> Bool
< :: Word64le -> Word64le -> Bool
$c< :: Word64le -> Word64le -> Bool
compare :: Word64le -> Word64le -> Ordering
$ccompare :: Word64le -> Word64le -> Ordering
$cp1Ord :: Eq Word64le
Ord, Int -> Word64le -> ShowS
[Word64le] -> ShowS
Word64le -> String
(Int -> Word64le -> ShowS)
-> (Word64le -> String) -> ([Word64le] -> ShowS) -> Show Word64le
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word64le] -> ShowS
$cshowList :: [Word64le] -> ShowS
show :: Word64le -> String
$cshow :: Word64le -> String
showsPrec :: Int -> Word64le -> ShowS
$cshowsPrec :: Int -> Word64le -> ShowS
Show)

instance Aeson.FromJSON Word64le where
  parseJSON :: Value -> Parser Word64le
parseJSON Value
value = case Value
value of
    Aeson.String Text
text -> case String -> Either String Word64
forall a. Read a => String -> Either String a
Read.readEither (String -> Either String Word64) -> String -> Either String Word64
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text of
      Left String
_ -> String -> Value -> Parser Word64le
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Word64le" Value
value
      Right Word64
word64 -> Word64le -> Parser Word64le
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64le -> Parser Word64le) -> Word64le -> Parser Word64le
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64le
Word64le Word64
word64
    Aeson.Number Scientific
number -> case Scientific -> Maybe Word64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
number of
      Maybe Word64
Nothing -> String -> Value -> Parser Word64le
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Word64le" Value
value
      Just Word64
word64 -> Word64le -> Parser Word64le
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64le -> Parser Word64le) -> Word64le -> Parser Word64le
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64le
Word64le Word64
word64
    Value
_ -> String -> Value -> Parser Word64le
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Word64le" Value
value

instance Aeson.ToJSON Word64le where
  toJSON :: Word64le -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (String -> Value) -> (Word64le -> String) -> Word64le -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> (Word64le -> Word64) -> Word64le -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64le -> Word64
word64leValue