module Rattletrap.Type.Attribute.String where

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

newtype String = String
  { String -> Str
value :: Str.Str
  }
  deriving (String -> String -> Bool
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
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> String
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON String where
  toJSON :: String -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON 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" 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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"String" forall a b. (a -> b) -> a -> b
$ do
  Str
value <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" BitGet Str
Str.bitGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure String {Str
value :: Str
value :: Str
value}