module Rattletrap.Type.Property.Name 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 Name
  = Name Str.Str
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

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

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

instance Json.FromJSON Name where
  parseJSON :: Value -> Parser Name
parseJSON = (Str -> Name) -> Parser Str -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Name
fromStr (Parser Str -> Parser Name)
-> (Value -> Parser Str) -> Value -> Parser Name
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 Name where
  toJSON :: Name -> Value
toJSON = Str -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Str -> Value) -> (Name -> Str) -> Name -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Str
toStr

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

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

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