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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c== :: Str -> Str -> Bool
Eq, Int -> Str -> ShowS
[Str] -> ShowS
Str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Str] -> ShowS
$cshowList :: [Str] -> ShowS
show :: Str -> String
$cshow :: Str -> String
showsPrec :: Int -> Str -> ShowS
$cshowsPrec :: Int -> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Str
fromStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Str where
  toJSON :: Str -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str -> Str
toStr

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