module Rattletrap.Type.Property.Bool where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Utility.Json as Json
import Prelude hiding (Bool)

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

fromU8 :: U8.U8 -> Bool
fromU8 :: U8 -> Bool
fromU8 = U8 -> Bool
Bool

toU8 :: Bool -> U8.U8
toU8 :: Bool -> U8
toU8 (Bool U8
x) = U8
x

instance Json.FromJSON Bool where
  parseJSON :: Value -> Parser Bool
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U8 -> Bool
fromU8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Bool where
  toJSON :: Bool -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> U8
toU8

schema :: Schema.Schema
schema :: Schema
schema = Schema
U8.schema

bytePut :: Bool -> BytePut.BytePut
bytePut :: Bool -> BytePut
bytePut = U8 -> BytePut
U8.bytePut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> U8
toU8

byteGet :: ByteGet.ByteGet Bool
byteGet :: ByteGet Bool
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Bool" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U8 -> Bool
fromU8 ByteGet U8
U8.byteGet