module Rattletrap.Type.PropertyValue where

import qualified Data.Foldable as Foldable
import qualified Data.Text as Text
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Dictionary as Dictionary
import qualified Rattletrap.Type.F32 as F32
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.List as List
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Utility.Json as Json
import Rattletrap.Utility.Monad

data PropertyValue a
  = Array (List.List (Dictionary.Dictionary a))
  -- ^ Yes, a list of dictionaries. No, it doesn't make sense. These usually
  -- only have one element.
  | Bool U8.U8
  | Byte Str.Str (Maybe Str.Str)
  -- ^ This is a strange name for essentially a key-value pair.
  | Float F32.F32
  | Int I32.I32
  | Name Str.Str
  -- ^ It's unclear how exactly this is different than a 'StrProperty'.
  | QWord U64.U64
  | Str Str.Str
  deriving (PropertyValue a -> PropertyValue a -> Bool
(PropertyValue a -> PropertyValue a -> Bool)
-> (PropertyValue a -> PropertyValue a -> Bool)
-> Eq (PropertyValue a)
forall a. Eq a => PropertyValue a -> PropertyValue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyValue a -> PropertyValue a -> Bool
$c/= :: forall a. Eq a => PropertyValue a -> PropertyValue a -> Bool
== :: PropertyValue a -> PropertyValue a -> Bool
$c== :: forall a. Eq a => PropertyValue a -> PropertyValue a -> Bool
Eq, Int -> PropertyValue a -> ShowS
[PropertyValue a] -> ShowS
PropertyValue a -> String
(Int -> PropertyValue a -> ShowS)
-> (PropertyValue a -> String)
-> ([PropertyValue a] -> ShowS)
-> Show (PropertyValue a)
forall a. Show a => Int -> PropertyValue a -> ShowS
forall a. Show a => [PropertyValue a] -> ShowS
forall a. Show a => PropertyValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyValue a] -> ShowS
$cshowList :: forall a. Show a => [PropertyValue a] -> ShowS
show :: PropertyValue a -> String
$cshow :: forall a. Show a => PropertyValue a -> String
showsPrec :: Int -> PropertyValue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PropertyValue a -> ShowS
Show)

instance Json.FromJSON a => Json.FromJSON (PropertyValue a) where
  parseJSON :: Value -> Parser (PropertyValue a)
parseJSON = String
-> (Object -> Parser (PropertyValue a))
-> Value
-> Parser (PropertyValue a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PropertyValue" ((Object -> Parser (PropertyValue a))
 -> Value -> Parser (PropertyValue a))
-> (Object -> Parser (PropertyValue a))
-> Value
-> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ \Object
object -> [Parser (PropertyValue a)] -> Parser (PropertyValue a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ List (Dictionary a) -> PropertyValue a
forall a. List (Dictionary a) -> PropertyValue a
Array (List (Dictionary a) -> PropertyValue a)
-> Parser (List (Dictionary a)) -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (List (Dictionary a))
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"array"
    , U8 -> PropertyValue a
forall a. U8 -> PropertyValue a
Bool (U8 -> PropertyValue a) -> Parser U8 -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser U8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"bool"
    , (Str -> Maybe Str -> PropertyValue a)
-> (Str, Maybe Str) -> PropertyValue a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Str -> Maybe Str -> PropertyValue a
forall a. Str -> Maybe Str -> PropertyValue a
Byte ((Str, Maybe Str) -> PropertyValue a)
-> Parser (Str, Maybe Str) -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (Str, Maybe Str)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"byte"
    , F32 -> PropertyValue a
forall a. F32 -> PropertyValue a
Float (F32 -> PropertyValue a) -> Parser F32 -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"float"
    , I32 -> PropertyValue a
forall a. I32 -> PropertyValue a
Int (I32 -> PropertyValue a) -> Parser I32 -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser I32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int"
    , Str -> PropertyValue a
forall a. Str -> PropertyValue a
Name (Str -> PropertyValue a) -> Parser Str -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name"
    , U64 -> PropertyValue a
forall a. U64 -> PropertyValue a
QWord (U64 -> PropertyValue a) -> Parser U64 -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser U64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"q_word"
    , Str -> PropertyValue a
forall a. Str -> PropertyValue a
Str (Str -> PropertyValue a) -> Parser Str -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"str"
    ]

instance Json.ToJSON a => Json.ToJSON (PropertyValue a) where
  toJSON :: PropertyValue a -> Value
toJSON PropertyValue a
x = case PropertyValue a
x of
    Array List (Dictionary a)
y -> [Pair] -> Value
Json.object [String -> List (Dictionary a) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"array" List (Dictionary a)
y]
    Bool U8
y -> [Pair] -> Value
Json.object [String -> U8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bool" U8
y]
    Byte Str
y Maybe Str
z -> [Pair] -> Value
Json.object [String -> (Str, Maybe Str) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"byte" (Str
y, Maybe Str
z)]
    Float F32
y -> [Pair] -> Value
Json.object [String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"float" F32
y]
    Int I32
y -> [Pair] -> Value
Json.object [String -> I32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int" I32
y]
    Name Str
y -> [Pair] -> Value
Json.object [String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" Str
y]
    QWord U64
y -> [Pair] -> Value
Json.object [String -> U64 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"q_word" U64
y]
    Str Str
y -> [Pair] -> Value
Json.object [String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"str" Str
y]

schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema Schema
s =
  String -> Value -> Schema
Schema.named (String
"property-value-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Schema -> Text
Schema.name Schema
s))
    (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf
    ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> Value) -> [(String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\(String
k, Value
v) -> [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k Value
v, Bool
True)])
        [ (String
"array", Schema -> Value
Schema.json (Schema -> Value) -> (Schema -> Schema) -> Schema -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
List.schema (Schema -> Value) -> Schema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Dictionary.schema Schema
s)
        , (String
"bool", Schema -> Value
Schema.ref Schema
U8.schema)
        , ( String
"byte"
          , [Value] -> Value
Schema.tuple
            [Schema -> Value
Schema.ref Schema
Str.schema, Schema -> Value
Schema.json (Schema -> Value) -> Schema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema]
          )
        , (String
"float", Schema -> Value
Schema.ref Schema
F32.schema)
        , (String
"int", Schema -> Value
Schema.ref Schema
I32.schema)
        , (String
"name", Schema -> Value
Schema.ref Schema
Str.schema)
        , (String
"q_word", Schema -> Value
Schema.ref Schema
U64.schema)
        , (String
"str", Schema -> Value
Schema.ref Schema
Str.schema)
        ]

bytePut :: (a -> BytePut.BytePut) -> PropertyValue a -> BytePut.BytePut
bytePut :: (a -> BytePut) -> PropertyValue a -> BytePut
bytePut a -> BytePut
putProperty PropertyValue a
value = case PropertyValue a
value of
  Array List (Dictionary a)
x -> (Dictionary a -> BytePut) -> List (Dictionary a) -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut ((a -> BytePut) -> Dictionary a -> BytePut
forall a. (a -> BytePut) -> Dictionary a -> BytePut
Dictionary.bytePut a -> BytePut
putProperty) List (Dictionary a)
x
  Bool U8
x -> U8 -> BytePut
U8.bytePut U8
x
  Byte Str
k Maybe Str
mv -> Str -> BytePut
Str.bytePut Str
k BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Str -> BytePut) -> Maybe Str -> BytePut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Str -> BytePut
Str.bytePut Maybe Str
mv
  Float F32
x -> F32 -> BytePut
F32.bytePut F32
x
  Int I32
x -> I32 -> BytePut
I32.bytePut I32
x
  Name Str
x -> Str -> BytePut
Str.bytePut Str
x
  QWord U64
x -> U64 -> BytePut
U64.bytePut U64
x
  Str Str
x -> Str -> BytePut
Str.bytePut Str
x

byteGet :: ByteGet.ByteGet a -> Str.Str -> ByteGet.ByteGet (PropertyValue a)
byteGet :: ByteGet a -> Str -> ByteGet (PropertyValue a)
byteGet ByteGet a
getProperty Str
kind = case Str -> String
Str.toString Str
kind of
  String
"ArrayProperty" -> List (Dictionary a) -> PropertyValue a
forall a. List (Dictionary a) -> PropertyValue a
Array (List (Dictionary a) -> PropertyValue a)
-> Get ByteString Identity (List (Dictionary a))
-> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteGet (Dictionary a)
-> Get ByteString Identity (List (Dictionary a))
forall a. ByteGet a -> ByteGet (List a)
List.byteGet (ByteGet a -> ByteGet (Dictionary a)
forall a. ByteGet a -> ByteGet (Dictionary a)
Dictionary.byteGet ByteGet a
getProperty)
  String
"BoolProperty" -> U8 -> PropertyValue a
forall a. U8 -> PropertyValue a
Bool (U8 -> PropertyValue a)
-> Get ByteString Identity U8 -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity U8
U8.byteGet
  String
"ByteProperty" -> do
    Str
k <- ByteGet Str
Str.byteGet
    Str -> Maybe Str -> PropertyValue a
forall a. Str -> Maybe Str -> PropertyValue a
Byte Str
k (Maybe Str -> PropertyValue a)
-> Get ByteString Identity (Maybe Str) -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ByteGet Str -> Get ByteString Identity (Maybe Str)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe (Str -> String
Str.toString Str
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"OnlinePlatform_Steam") ByteGet Str
Str.byteGet
  String
"FloatProperty" -> F32 -> PropertyValue a
forall a. F32 -> PropertyValue a
Float (F32 -> PropertyValue a)
-> Get ByteString Identity F32 -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity F32
F32.byteGet
  String
"IntProperty" -> I32 -> PropertyValue a
forall a. I32 -> PropertyValue a
Int (I32 -> PropertyValue a)
-> Get ByteString Identity I32 -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity I32
I32.byteGet
  String
"NameProperty" -> Str -> PropertyValue a
forall a. Str -> PropertyValue a
Name (Str -> PropertyValue a)
-> ByteGet Str -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteGet Str
Str.byteGet
  String
"QWordProperty" -> U64 -> PropertyValue a
forall a. U64 -> PropertyValue a
QWord (U64 -> PropertyValue a)
-> Get ByteString Identity U64 -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity U64
U64.byteGet
  String
"StrProperty" -> Str -> PropertyValue a
forall a. Str -> PropertyValue a
Str (Str -> PropertyValue a)
-> ByteGet Str -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteGet Str
Str.byteGet
  String
_ -> String -> ByteGet (PropertyValue a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT07] don't know how to read property value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Str -> String
forall a. Show a => a -> String
show Str
kind)