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
  = Array (Property.Array.Array a)
  -- ^ Yes, a list of dictionaries. No, it doesn't make sense. These usually
  -- only have one element.
  | Bool Property.Bool.Bool
  | Byte Property.Byte.Byte
  -- ^ This is a strange name for essentially a key-value pair.
  | Float Property.Float.Float
  | Int Property.Int.Int
  | Name Property.Name.Name
  -- ^ It's unclear how exactly this is different than a 'StrProperty'.
  | QWord Property.QWord.QWord
  | Str Property.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
    [ (Array a -> PropertyValue a)
-> Parser (Array a) -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> PropertyValue a
forall a. Array a -> PropertyValue a
Array (Parser (Array a) -> Parser (PropertyValue a))
-> Parser (Array a) -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser (Array a)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"array"
    , (Bool -> PropertyValue a)
-> Parser Bool -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> PropertyValue a
forall a. Bool -> PropertyValue a
Bool (Parser Bool -> Parser (PropertyValue a))
-> Parser Bool -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"bool"
    , (Byte -> PropertyValue a)
-> Parser Byte -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Byte -> PropertyValue a
forall a. Byte -> PropertyValue a
Byte (Parser Byte -> Parser (PropertyValue a))
-> Parser Byte -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Byte
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"byte"
    , (Float -> PropertyValue a)
-> Parser Float -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> PropertyValue a
forall a. Float -> PropertyValue a
Float (Parser Float -> Parser (PropertyValue a))
-> Parser Float -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Float
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"float"
    , (Int -> PropertyValue a) -> Parser Int -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PropertyValue a
forall a. Int -> PropertyValue a
Int (Parser Int -> Parser (PropertyValue a))
-> Parser Int -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"int"
    , (Name -> PropertyValue a)
-> Parser Name -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> PropertyValue a
forall a. Name -> PropertyValue a
Name (Parser Name -> Parser (PropertyValue a))
-> Parser Name -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Name
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"name"
    , (QWord -> PropertyValue a)
-> Parser QWord -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> PropertyValue a
forall a. QWord -> PropertyValue a
QWord (Parser QWord -> Parser (PropertyValue a))
-> Parser QWord -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser QWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"q_word"
    , (Str -> PropertyValue a) -> Parser Str -> Parser (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> PropertyValue a
forall a. Str -> PropertyValue a
Str (Parser Str -> Parser (PropertyValue a))
-> Parser Str -> Parser (PropertyValue a)
forall a b. (a -> b) -> a -> 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 Array a
y -> [Pair] -> Value
Json.object [String -> Array a -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"array" Array a
y]
    Bool Bool
y -> [Pair] -> Value
Json.object [String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bool" Bool
y]
    Byte Byte
y -> [Pair] -> Value
Json.object [String -> Byte -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"byte" Byte
y]
    Float Float
y -> [Pair] -> Value
Json.object [String -> Float -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"float" Float
y]
    Int Int
y -> [Pair] -> Value
Json.object [String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"int" Int
y]
    Name Name
y -> [Pair] -> Value
Json.object [String -> Name -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" Name
y]
    QWord QWord
y -> [Pair] -> Value
Json.object [String -> QWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"q_word" QWord
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" (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.ref (Schema -> Value) -> Schema -> Value
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 :: (a -> BytePut) -> PropertyValue a -> BytePut
bytePut a -> BytePut
putProperty PropertyValue a
value = case PropertyValue a
value of
  Array Array a
x -> (a -> BytePut) -> Array a -> BytePut
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 :: ByteGet a -> Str -> ByteGet (PropertyValue a)
byteGet ByteGet a
getProperty Str
kind =
  String -> ByteGet (PropertyValue a) -> ByteGet (PropertyValue a)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"PropertyValue" (ByteGet (PropertyValue a) -> ByteGet (PropertyValue a))
-> ByteGet (PropertyValue a) -> ByteGet (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ case Str -> String
Str.toString Str
kind of
    String
"ArrayProperty" -> (Array a -> PropertyValue a)
-> Get ByteString Identity (Array a) -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> PropertyValue a
forall a. Array a -> PropertyValue a
Array (Get ByteString Identity (Array a) -> ByteGet (PropertyValue a))
-> Get ByteString Identity (Array a) -> ByteGet (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ ByteGet a -> Get ByteString Identity (Array a)
forall a. ByteGet a -> ByteGet (Array a)
Property.Array.byteGet ByteGet a
getProperty
    String
"BoolProperty" -> (Bool -> PropertyValue a)
-> Get ByteString Identity Bool -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> PropertyValue a
forall a. Bool -> PropertyValue a
Bool Get ByteString Identity Bool
Property.Bool.byteGet
    String
"ByteProperty" -> (Byte -> PropertyValue a)
-> Get ByteString Identity Byte -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Byte -> PropertyValue a
forall a. Byte -> PropertyValue a
Byte Get ByteString Identity Byte
Property.Byte.byteGet
    String
"FloatProperty" -> (Float -> PropertyValue a)
-> Get ByteString Identity Float -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> PropertyValue a
forall a. Float -> PropertyValue a
Float Get ByteString Identity Float
Property.Float.byteGet
    String
"IntProperty" -> (Int -> PropertyValue a)
-> Get ByteString Identity Int -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PropertyValue a
forall a. Int -> PropertyValue a
Int Get ByteString Identity Int
Property.Int.byteGet
    String
"NameProperty" -> (Name -> PropertyValue a)
-> Get ByteString Identity Name -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> PropertyValue a
forall a. Name -> PropertyValue a
Name Get ByteString Identity Name
Property.Name.byteGet
    String
"QWordProperty" -> (QWord -> PropertyValue a)
-> Get ByteString Identity QWord -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> PropertyValue a
forall a. QWord -> PropertyValue a
QWord Get ByteString Identity QWord
Property.QWord.byteGet
    String
"StrProperty" -> (Str -> PropertyValue a)
-> Get ByteString Identity Str -> ByteGet (PropertyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> PropertyValue a
forall a. Str -> PropertyValue a
Str Get ByteString Identity Str
Property.Str.byteGet
    String
x -> UnknownProperty -> ByteGet (PropertyValue a)
forall e a. Exception e => e -> ByteGet a
ByteGet.throw (UnknownProperty -> ByteGet (PropertyValue a))
-> UnknownProperty -> ByteGet (PropertyValue a)
forall a b. (a -> b) -> a -> b
$ String -> UnknownProperty
UnknownProperty.UnknownProperty String
x