-- | An exact mapping of the types in LIFX's `products.json`. It's easier to just use 'Lifx.Lan.getProductInfo'.
module Lifx.Internal.Product where

import Data.Text (Text)
import Data.Word (Word16, Word32)

data VendorInfo = VendorInfo
    { VendorInfo -> Word32
vid :: Word32
    , VendorInfo -> Text
name :: Text
    , VendorInfo -> Features
defaults :: Features
    , VendorInfo -> [ProductInfo]
products :: [ProductInfo]
    }
    deriving (Int -> VendorInfo -> ShowS
[VendorInfo] -> ShowS
VendorInfo -> String
(Int -> VendorInfo -> ShowS)
-> (VendorInfo -> String)
-> ([VendorInfo] -> ShowS)
-> Show VendorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VendorInfo] -> ShowS
$cshowList :: [VendorInfo] -> ShowS
show :: VendorInfo -> String
$cshow :: VendorInfo -> String
showsPrec :: Int -> VendorInfo -> ShowS
$cshowsPrec :: Int -> VendorInfo -> ShowS
Show)

data ProductInfo = ProductInfo
    { ProductInfo -> Word32
pid :: Word32
    , ProductInfo -> Text
name :: Text
    , ProductInfo -> PartialFeatures
features :: PartialFeatures
    , ProductInfo -> [Upgrade]
upgrades :: [Upgrade]
    }
    deriving (Int -> ProductInfo -> ShowS
[ProductInfo] -> ShowS
ProductInfo -> String
(Int -> ProductInfo -> ShowS)
-> (ProductInfo -> String)
-> ([ProductInfo] -> ShowS)
-> Show ProductInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductInfo] -> ShowS
$cshowList :: [ProductInfo] -> ShowS
show :: ProductInfo -> String
$cshow :: ProductInfo -> String
showsPrec :: Int -> ProductInfo -> ShowS
$cshowsPrec :: Int -> ProductInfo -> ShowS
Show)

data PartialFeatures = PartialFeatures
    { PartialFeatures -> Maybe Bool
hev :: Maybe Bool
    , PartialFeatures -> Maybe Bool
color :: Maybe Bool
    , PartialFeatures -> Maybe Bool
chain :: Maybe Bool
    , PartialFeatures -> Maybe Bool
matrix :: Maybe Bool
    , PartialFeatures -> Maybe Bool
relays :: Maybe Bool
    , PartialFeatures -> Maybe Bool
buttons :: Maybe Bool
    , PartialFeatures -> Maybe Bool
infrared :: Maybe Bool
    , PartialFeatures -> Maybe Bool
multizone :: Maybe Bool
    , PartialFeatures -> Maybe (Word16, Word16)
temperatureRange :: Maybe (Word16, Word16)
    , PartialFeatures -> Maybe Bool
extendedMultizone :: Maybe Bool
    }
    deriving (Int -> PartialFeatures -> ShowS
[PartialFeatures] -> ShowS
PartialFeatures -> String
(Int -> PartialFeatures -> ShowS)
-> (PartialFeatures -> String)
-> ([PartialFeatures] -> ShowS)
-> Show PartialFeatures
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialFeatures] -> ShowS
$cshowList :: [PartialFeatures] -> ShowS
show :: PartialFeatures -> String
$cshow :: PartialFeatures -> String
showsPrec :: Int -> PartialFeatures -> ShowS
$cshowsPrec :: Int -> PartialFeatures -> ShowS
Show)

data Features = Features
    { Features -> Bool
hev :: Bool
    , Features -> Bool
color :: Bool
    , Features -> Bool
chain :: Bool
    , Features -> Bool
matrix :: Bool
    , Features -> Bool
relays :: Bool
    , Features -> Bool
buttons :: Bool
    , Features -> Bool
infrared :: Bool
    , Features -> Bool
multizone :: Bool
    , Features -> Maybe (Word16, Word16)
temperatureRange :: Maybe (Word16, Word16)
    , Features -> Bool
extendedMultizone :: Bool
    }
    deriving (Int -> Features -> ShowS
[Features] -> ShowS
Features -> String
(Int -> Features -> ShowS)
-> (Features -> String) -> ([Features] -> ShowS) -> Show Features
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Features] -> ShowS
$cshowList :: [Features] -> ShowS
show :: Features -> String
$cshow :: Features -> String
showsPrec :: Int -> Features -> ShowS
$cshowsPrec :: Int -> Features -> ShowS
Show)

data Upgrade = Upgrade
    { Upgrade -> Word16
major :: Word16
    , Upgrade -> Word16
minor :: Word16
    , Upgrade -> PartialFeatures
features :: PartialFeatures
    }
    deriving (Int -> Upgrade -> ShowS
[Upgrade] -> ShowS
Upgrade -> String
(Int -> Upgrade -> ShowS)
-> (Upgrade -> String) -> ([Upgrade] -> ShowS) -> Show Upgrade
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Upgrade] -> ShowS
$cshowList :: [Upgrade] -> ShowS
show :: Upgrade -> String
$cshow :: Upgrade -> String
showsPrec :: Int -> Upgrade -> ShowS
$cshowsPrec :: Int -> Upgrade -> ShowS
Show)