module Rattletrap.Type.Property.Str where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

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

fromStr :: Str.Str -> Str
fromStr :: Str -> Str
fromStr = Str -> Str
Str

toStr :: Str -> Str.Str
toStr :: Str -> Str
toStr (Str Str
x) = Str
x

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

instance Json.ToJSON Str where
  toJSON :: Str -> Value
toJSON = Str -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Str -> Value) -> (Str -> Str) -> Str -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Str
toStr

schema :: Schema.Schema
schema :: Schema
schema = Schema
Str.schema

bytePut :: Str -> BytePut.BytePut
bytePut :: Str -> BytePut
bytePut = Str -> BytePut
Str.bytePut (Str -> BytePut) -> (Str -> Str) -> Str -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Str
toStr

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