module Rattletrap.Type.Int64le
  ( Int64le(..)
  )
where

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

newtype Int64le = Int64le
  { Int64le -> Int64
int64leValue :: Int.Int64
  } deriving (Int64le -> Int64le -> Bool
(Int64le -> Int64le -> Bool)
-> (Int64le -> Int64le -> Bool) -> Eq Int64le
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int64le -> Int64le -> Bool
$c/= :: Int64le -> Int64le -> Bool
== :: Int64le -> Int64le -> Bool
$c== :: Int64le -> Int64le -> Bool
Eq, Eq Int64le
Eq Int64le
-> (Int64le -> Int64le -> Ordering)
-> (Int64le -> Int64le -> Bool)
-> (Int64le -> Int64le -> Bool)
-> (Int64le -> Int64le -> Bool)
-> (Int64le -> Int64le -> Bool)
-> (Int64le -> Int64le -> Int64le)
-> (Int64le -> Int64le -> Int64le)
-> Ord Int64le
Int64le -> Int64le -> Bool
Int64le -> Int64le -> Ordering
Int64le -> Int64le -> Int64le
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 :: Int64le -> Int64le -> Int64le
$cmin :: Int64le -> Int64le -> Int64le
max :: Int64le -> Int64le -> Int64le
$cmax :: Int64le -> Int64le -> Int64le
>= :: Int64le -> Int64le -> Bool
$c>= :: Int64le -> Int64le -> Bool
> :: Int64le -> Int64le -> Bool
$c> :: Int64le -> Int64le -> Bool
<= :: Int64le -> Int64le -> Bool
$c<= :: Int64le -> Int64le -> Bool
< :: Int64le -> Int64le -> Bool
$c< :: Int64le -> Int64le -> Bool
compare :: Int64le -> Int64le -> Ordering
$ccompare :: Int64le -> Int64le -> Ordering
$cp1Ord :: Eq Int64le
Ord, Int -> Int64le -> ShowS
[Int64le] -> ShowS
Int64le -> String
(Int -> Int64le -> ShowS)
-> (Int64le -> String) -> ([Int64le] -> ShowS) -> Show Int64le
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Int64le] -> ShowS
$cshowList :: [Int64le] -> ShowS
show :: Int64le -> String
$cshow :: Int64le -> String
showsPrec :: Int -> Int64le -> ShowS
$cshowsPrec :: Int -> Int64le -> ShowS
Show)

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

instance Aeson.ToJSON Int64le where
  toJSON :: Int64le -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (String -> Value) -> (Int64le -> String) -> Int64le -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> (Int64le -> Int64) -> Int64le -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64le -> Int64
int64leValue