{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.ProductAttribute
  ( ProductAttribute(..)
  , ProductAttributeValue(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.CompressedWord
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

data ProductAttributeValue
  = ProductAttributeValuePaintedOld CompressedWord
  | ProductAttributeValuePaintedNew Word32
  | ProductAttributeValueTeamEditionOld CompressedWord
  | ProductAttributeValueTeamEditionNew Word32
  | ProductAttributeValueSpecialEdition Word32
  | ProductAttributeValueUserColorOld (Maybe Word32)
  | ProductAttributeValueUserColorNew Word32le
  | ProductAttributeValueTitleId Str
  deriving (ProductAttributeValue -> ProductAttributeValue -> Bool
(ProductAttributeValue -> ProductAttributeValue -> Bool)
-> (ProductAttributeValue -> ProductAttributeValue -> Bool)
-> Eq ProductAttributeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c/= :: ProductAttributeValue -> ProductAttributeValue -> Bool
== :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c== :: ProductAttributeValue -> ProductAttributeValue -> Bool
Eq, Eq ProductAttributeValue
Eq ProductAttributeValue
-> (ProductAttributeValue -> ProductAttributeValue -> Ordering)
-> (ProductAttributeValue -> ProductAttributeValue -> Bool)
-> (ProductAttributeValue -> ProductAttributeValue -> Bool)
-> (ProductAttributeValue -> ProductAttributeValue -> Bool)
-> (ProductAttributeValue -> ProductAttributeValue -> Bool)
-> (ProductAttributeValue
    -> ProductAttributeValue -> ProductAttributeValue)
-> (ProductAttributeValue
    -> ProductAttributeValue -> ProductAttributeValue)
-> Ord ProductAttributeValue
ProductAttributeValue -> ProductAttributeValue -> Bool
ProductAttributeValue -> ProductAttributeValue -> Ordering
ProductAttributeValue
-> ProductAttributeValue -> ProductAttributeValue
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
min :: ProductAttributeValue
-> ProductAttributeValue -> ProductAttributeValue
$cmin :: ProductAttributeValue
-> ProductAttributeValue -> ProductAttributeValue
max :: ProductAttributeValue
-> ProductAttributeValue -> ProductAttributeValue
$cmax :: ProductAttributeValue
-> ProductAttributeValue -> ProductAttributeValue
>= :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c>= :: ProductAttributeValue -> ProductAttributeValue -> Bool
> :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c> :: ProductAttributeValue -> ProductAttributeValue -> Bool
<= :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c<= :: ProductAttributeValue -> ProductAttributeValue -> Bool
< :: ProductAttributeValue -> ProductAttributeValue -> Bool
$c< :: ProductAttributeValue -> ProductAttributeValue -> Bool
compare :: ProductAttributeValue -> ProductAttributeValue -> Ordering
$ccompare :: ProductAttributeValue -> ProductAttributeValue -> Ordering
$cp1Ord :: Eq ProductAttributeValue
Ord, Int -> ProductAttributeValue -> ShowS
[ProductAttributeValue] -> ShowS
ProductAttributeValue -> String
(Int -> ProductAttributeValue -> ShowS)
-> (ProductAttributeValue -> String)
-> ([ProductAttributeValue] -> ShowS)
-> Show ProductAttributeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductAttributeValue] -> ShowS
$cshowList :: [ProductAttributeValue] -> ShowS
show :: ProductAttributeValue -> String
$cshow :: ProductAttributeValue -> String
showsPrec :: Int -> ProductAttributeValue -> ShowS
$cshowsPrec :: Int -> ProductAttributeValue -> ShowS
Show)

$(deriveJson ''ProductAttributeValue)

data ProductAttribute = ProductAttribute
  { ProductAttribute -> Bool
productAttributeUnknown :: Bool
  , ProductAttribute -> Word32le
productAttributeObjectId :: Word32le
  , ProductAttribute -> Maybe Str
productAttributeObjectName :: Maybe Str
  -- ^ read-only
  , ProductAttribute -> ProductAttributeValue
productAttributeValue :: ProductAttributeValue
  } deriving (ProductAttribute -> ProductAttribute -> Bool
(ProductAttribute -> ProductAttribute -> Bool)
-> (ProductAttribute -> ProductAttribute -> Bool)
-> Eq ProductAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductAttribute -> ProductAttribute -> Bool
$c/= :: ProductAttribute -> ProductAttribute -> Bool
== :: ProductAttribute -> ProductAttribute -> Bool
$c== :: ProductAttribute -> ProductAttribute -> Bool
Eq, Eq ProductAttribute
Eq ProductAttribute
-> (ProductAttribute -> ProductAttribute -> Ordering)
-> (ProductAttribute -> ProductAttribute -> Bool)
-> (ProductAttribute -> ProductAttribute -> Bool)
-> (ProductAttribute -> ProductAttribute -> Bool)
-> (ProductAttribute -> ProductAttribute -> Bool)
-> (ProductAttribute -> ProductAttribute -> ProductAttribute)
-> (ProductAttribute -> ProductAttribute -> ProductAttribute)
-> Ord ProductAttribute
ProductAttribute -> ProductAttribute -> Bool
ProductAttribute -> ProductAttribute -> Ordering
ProductAttribute -> ProductAttribute -> ProductAttribute
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
min :: ProductAttribute -> ProductAttribute -> ProductAttribute
$cmin :: ProductAttribute -> ProductAttribute -> ProductAttribute
max :: ProductAttribute -> ProductAttribute -> ProductAttribute
$cmax :: ProductAttribute -> ProductAttribute -> ProductAttribute
>= :: ProductAttribute -> ProductAttribute -> Bool
$c>= :: ProductAttribute -> ProductAttribute -> Bool
> :: ProductAttribute -> ProductAttribute -> Bool
$c> :: ProductAttribute -> ProductAttribute -> Bool
<= :: ProductAttribute -> ProductAttribute -> Bool
$c<= :: ProductAttribute -> ProductAttribute -> Bool
< :: ProductAttribute -> ProductAttribute -> Bool
$c< :: ProductAttribute -> ProductAttribute -> Bool
compare :: ProductAttribute -> ProductAttribute -> Ordering
$ccompare :: ProductAttribute -> ProductAttribute -> Ordering
$cp1Ord :: Eq ProductAttribute
Ord, Int -> ProductAttribute -> ShowS
[ProductAttribute] -> ShowS
ProductAttribute -> String
(Int -> ProductAttribute -> ShowS)
-> (ProductAttribute -> String)
-> ([ProductAttribute] -> ShowS)
-> Show ProductAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductAttribute] -> ShowS
$cshowList :: [ProductAttribute] -> ShowS
show :: ProductAttribute -> String
$cshow :: ProductAttribute -> String
showsPrec :: Int -> ProductAttribute -> ShowS
$cshowsPrec :: Int -> ProductAttribute -> ShowS
Show)

$(deriveJson ''ProductAttribute)