module Rattletrap.Type.Property.Bool where

import Prelude hiding (Bool)
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

newtype Bool
  = Bool U8.U8
  deriving (Bool -> Bool -> Bool
(Bool -> Bool -> Bool) -> (Bool -> Bool -> Bool) -> Eq 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
(Int -> Bool -> ShowS)
-> (Bool -> String) -> ([Bool] -> ShowS) -> Show Bool
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 = (U8 -> Bool) -> Parser U8 -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U8 -> Bool
fromU8 (Parser U8 -> Parser Bool)
-> (Value -> Parser U8) -> Value -> Parser Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser U8
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

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

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