module Rattletrap.Type.Attribute.String where

import Prelude hiding (String)
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

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

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

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-string" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema

bitPut :: String -> BitPut.BitPut
bitPut :: String -> BitPut
bitPut String
stringAttribute = Str -> BitPut
Str.bitPut (String -> Str
value String
stringAttribute)

bitGet :: BitGet.BitGet String
bitGet :: BitGet String
bitGet = String -> BitGet String -> BitGet String
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"String" (BitGet String -> BitGet String) -> BitGet String -> BitGet String
forall a b. (a -> b) -> a -> b
$ do
  Str
value <- String -> BitGet Str -> BitGet Str
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet Str
Str.bitGet
  String -> BitGet String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String :: Str -> String
String { Str
value :: Str
value :: Str
value }