module Rattletrap.Type.F32 where

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

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

instance Json.FromJSON F32 where
  parseJSON :: Value -> Parser F32
parseJSON = (Float -> F32) -> Parser Float -> Parser F32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> F32
fromFloat (Parser Float -> Parser F32)
-> (Value -> Parser Float) -> Value -> Parser F32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Float
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON F32 where
  toJSON :: F32 -> Value
toJSON = Float -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Float -> Value) -> (F32 -> Float) -> F32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F32 -> Float
toFloat

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"f32" (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
"number"]

fromFloat :: Float -> F32
fromFloat :: Float -> F32
fromFloat = Float -> F32
F32

toFloat :: F32 -> Float
toFloat :: F32 -> Float
toFloat (F32 Float
x) = Float
x

bytePut :: F32 -> BytePut.BytePut
bytePut :: F32 -> BytePut
bytePut = Float -> BytePut
BytePut.float (Float -> BytePut) -> (F32 -> Float) -> F32 -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F32 -> Float
toFloat

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

byteGet :: ByteGet.ByteGet F32
byteGet :: ByteGet F32
byteGet = String -> ByteGet F32 -> ByteGet F32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"F32" (ByteGet F32 -> ByteGet F32) -> ByteGet F32 -> ByteGet F32
forall a b. (a -> b) -> a -> b
$ (Float -> F32) -> Get ByteString Identity Float -> ByteGet F32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> F32
fromFloat Get ByteString Identity Float
ByteGet.float

bitGet :: BitGet.BitGet F32
bitGet :: BitGet F32
bitGet = ByteGet F32 -> Int -> BitGet F32
forall a. ByteGet a -> Int -> BitGet a
BitGet.fromByteGet ByteGet F32
byteGet Int
4