{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.PropertyValue
  ( PropertyValue(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.Dictionary
import Rattletrap.Type.Float32le
import Rattletrap.Type.Int32le
import Rattletrap.Type.List
import Rattletrap.Type.Str
import Rattletrap.Type.Word64le
import Rattletrap.Type.Word8le

data PropertyValue a
  = PropertyValueArray (List (Dictionary a))
  -- ^ Yes, a list of dictionaries. No, it doesn't make sense. These usually
  -- only have one element.
  | PropertyValueBool Word8le
  | PropertyValueByte Str (Maybe Str)
  -- ^ This is a strange name for essentially a key-value pair.
  | PropertyValueFloat Float32le
  | PropertyValueInt Int32le
  | PropertyValueName Str
  -- ^ It's unclear how exactly this is different than a 'StrProperty'.
  | PropertyValueQWord Word64le
  | PropertyValueStr 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, Eq (PropertyValue a)
Eq (PropertyValue a)
-> (PropertyValue a -> PropertyValue a -> Ordering)
-> (PropertyValue a -> PropertyValue a -> Bool)
-> (PropertyValue a -> PropertyValue a -> Bool)
-> (PropertyValue a -> PropertyValue a -> Bool)
-> (PropertyValue a -> PropertyValue a -> Bool)
-> (PropertyValue a -> PropertyValue a -> PropertyValue a)
-> (PropertyValue a -> PropertyValue a -> PropertyValue a)
-> Ord (PropertyValue a)
PropertyValue a -> PropertyValue a -> Bool
PropertyValue a -> PropertyValue a -> Ordering
PropertyValue a -> PropertyValue a -> PropertyValue a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PropertyValue a)
forall a. Ord a => PropertyValue a -> PropertyValue a -> Bool
forall a. Ord a => PropertyValue a -> PropertyValue a -> Ordering
forall a.
Ord a =>
PropertyValue a -> PropertyValue a -> PropertyValue a
min :: PropertyValue a -> PropertyValue a -> PropertyValue a
$cmin :: forall a.
Ord a =>
PropertyValue a -> PropertyValue a -> PropertyValue a
max :: PropertyValue a -> PropertyValue a -> PropertyValue a
$cmax :: forall a.
Ord a =>
PropertyValue a -> PropertyValue a -> PropertyValue a
>= :: PropertyValue a -> PropertyValue a -> Bool
$c>= :: forall a. Ord a => PropertyValue a -> PropertyValue a -> Bool
> :: PropertyValue a -> PropertyValue a -> Bool
$c> :: forall a. Ord a => PropertyValue a -> PropertyValue a -> Bool
<= :: PropertyValue a -> PropertyValue a -> Bool
$c<= :: forall a. Ord a => PropertyValue a -> PropertyValue a -> Bool
< :: PropertyValue a -> PropertyValue a -> Bool
$c< :: forall a. Ord a => PropertyValue a -> PropertyValue a -> Bool
compare :: PropertyValue a -> PropertyValue a -> Ordering
$ccompare :: forall a. Ord a => PropertyValue a -> PropertyValue a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PropertyValue a)
Ord, 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)

$(deriveJson ''PropertyValue)