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
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
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> F32
fromFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON F32 where
  toJSON :: F32 -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" 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
"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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. F32 -> BytePut
bytePut

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

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