module Rattletrap.Type.PropertyValue where

import qualified Data.Foldable as Foldable
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Exception.UnknownProperty as UnknownProperty
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Property.Array as Property.Array
import qualified Rattletrap.Type.Property.Bool as Property.Bool
import qualified Rattletrap.Type.Property.Byte as Property.Byte
import qualified Rattletrap.Type.Property.Float as Property.Float
import qualified Rattletrap.Type.Property.Int as Property.Int
import qualified Rattletrap.Type.Property.Name as Property.Name
import qualified Rattletrap.Type.Property.QWord as Property.QWord
import qualified Rattletrap.Type.Property.Str as Property.Str
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

data PropertyValue a
  = -- | Yes, a list of dictionaries. No, it doesn't make sense. These usually
    -- only have one element.
    Array (Property.Array.Array a)
  | Bool Property.Bool.Bool
  | -- | This is a strange name for essentially a key-value pair.
    Byte Property.Byte.Byte
  | Float Property.Float.Float
  | Int Property.Int.Int
  | -- | It's unclear how exactly this is different than a 'StrProperty'.
    Name Property.Name.Name
  | QWord Property.QWord.QWord
  | Str Property.Str.Str
  deriving (PropertyValue a -> PropertyValue a -> Bool
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PropertyValue" forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Array a -> PropertyValue a
Array forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"array",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Bool -> PropertyValue a
Bool forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"bool",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Byte -> PropertyValue a
Byte forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"byte",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Float -> PropertyValue a
Float forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"float",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Int -> PropertyValue a
Int forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Name -> PropertyValue a
Name forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. QWord -> PropertyValue a
QWord forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"q_word",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Str -> PropertyValue a
Str forall a b. (a -> b) -> a -> b
$ 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 Array a
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"array" Array a
y]
    Bool Bool
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bool" Bool
y]
    Byte Byte
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"byte" Byte
y]
    Float Float
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"float" Float
y]
    Int Int
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int" Int
y]
    Name Name
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" Name
y]
    QWord QWord
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"q_word" QWord
y]
    Str Str
y -> [(Key, Value)] -> Value
Json.object [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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Value
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k Value
v, Bool
True)])
      [ (String
"array", Schema -> Value
Schema.ref forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Property.Array.schema Schema
s),
        (String
"bool", Schema -> Value
Schema.ref Schema
Property.Bool.schema),
        (String
"byte", Schema -> Value
Schema.ref Schema
Property.Byte.schema),
        (String
"float", Schema -> Value
Schema.ref Schema
Property.Float.schema),
        (String
"int", Schema -> Value
Schema.ref Schema
Property.Int.schema),
        (String
"name", Schema -> Value
Schema.ref Schema
Property.Name.schema),
        (String
"q_word", Schema -> Value
Schema.ref Schema
Property.QWord.schema),
        (String
"str", Schema -> Value
Schema.ref Schema
Property.Str.schema)
      ]

bytePut :: (a -> BytePut.BytePut) -> PropertyValue a -> BytePut.BytePut
bytePut :: forall a. (a -> BytePut) -> PropertyValue a -> BytePut
bytePut a -> BytePut
putProperty PropertyValue a
value = case PropertyValue a
value of
  Array Array a
x -> forall a. (a -> BytePut) -> Array a -> BytePut
Property.Array.bytePut a -> BytePut
putProperty Array a
x
  Bool Bool
x -> Bool -> BytePut
Property.Bool.bytePut Bool
x
  Byte Byte
x -> Byte -> BytePut
Property.Byte.bytePut Byte
x
  Float Float
x -> Float -> BytePut
Property.Float.bytePut Float
x
  Int Int
x -> Int -> BytePut
Property.Int.bytePut Int
x
  Name Name
x -> Name -> BytePut
Property.Name.bytePut Name
x
  QWord QWord
x -> QWord -> BytePut
Property.QWord.bytePut QWord
x
  Str Str
x -> Str -> BytePut
Property.Str.bytePut Str
x

byteGet :: ByteGet.ByteGet a -> Str.Str -> ByteGet.ByteGet (PropertyValue a)
byteGet :: forall a. ByteGet a -> Str -> ByteGet (PropertyValue a)
byteGet ByteGet a
getProperty Str
kind =
  forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"PropertyValue" forall a b. (a -> b) -> a -> b
$ case Str -> String
Str.toString Str
kind of
    String
"ArrayProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Array a -> PropertyValue a
Array forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (Array a)
Property.Array.byteGet ByteGet a
getProperty
    String
"BoolProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Bool -> PropertyValue a
Bool ByteGet Bool
Property.Bool.byteGet
    String
"ByteProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Byte -> PropertyValue a
Byte ByteGet Byte
Property.Byte.byteGet
    String
"FloatProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Float -> PropertyValue a
Float ByteGet Float
Property.Float.byteGet
    String
"IntProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Int -> PropertyValue a
Int ByteGet Int
Property.Int.byteGet
    String
"NameProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Name -> PropertyValue a
Name ByteGet Name
Property.Name.byteGet
    String
"QWordProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. QWord -> PropertyValue a
QWord ByteGet QWord
Property.QWord.byteGet
    String
"StrProperty" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Str -> PropertyValue a
Str ByteGet Str
Property.Str.byteGet
    String
x -> forall e a. Exception e => e -> ByteGet a
ByteGet.throw forall a b. (a -> b) -> a -> b
$ String -> UnknownProperty
UnknownProperty.UnknownProperty String
x