module Lifx.Internal.ProductInfoMap where

import Control.Applicative
import Data.Functor
import Data.Maybe
import Data.Tuple.Extra
import Data.Word

import Data.Map (Map, (!?))
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import GHC.Generics (Generic)

import Lifx.Internal.Product
import Lifx.Internal.ProductInfo

productInfoMap :: Map Word32 (Features, Map Word32 ProductInfo)
productInfoMap :: Map Word32 (Features, Map Word32 ProductInfo)
productInfoMap =
    [(Word32, (Features, Map Word32 ProductInfo))]
-> Map Word32 (Features, Map Word32 ProductInfo)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word32, (Features, Map Word32 ProductInfo))]
 -> Map Word32 (Features, Map Word32 ProductInfo))
-> [(Word32, (Features, Map Word32 ProductInfo))]
-> Map Word32 (Features, Map Word32 ProductInfo)
forall a b. (a -> b) -> a -> b
$
        [VendorInfo]
productInfo [VendorInfo]
-> (VendorInfo -> (Word32, (Features, Map Word32 ProductInfo)))
-> [(Word32, (Features, Map Word32 ProductInfo))]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VendorInfo{[ProductInfo]
Word32
Text
Features
vid :: Word32
name :: Text
defaults :: Features
products :: [ProductInfo]
$sel:vid:VendorInfo :: VendorInfo -> Word32
$sel:name:VendorInfo :: VendorInfo -> Text
$sel:defaults:VendorInfo :: VendorInfo -> Features
$sel:products:VendorInfo :: VendorInfo -> [ProductInfo]
..} ->
            ( Word32
vid
            ,
                ( Features
defaults
                , [(Word32, ProductInfo)] -> Map Word32 ProductInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word32, ProductInfo)] -> Map Word32 ProductInfo)
-> [(Word32, ProductInfo)] -> Map Word32 ProductInfo
forall a b. (a -> b) -> a -> b
$ ((.pid) (ProductInfo -> Word32)
-> (ProductInfo -> ProductInfo)
-> ProductInfo
-> (Word32, ProductInfo)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& ProductInfo -> ProductInfo
forall a. a -> a
id) (ProductInfo -> (Word32, ProductInfo))
-> [ProductInfo] -> [(Word32, ProductInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProductInfo]
products
                )
            )

-- | Information about a particular LIFX product.
data Product = Product
    { Product -> Text
name :: Text
    , Product -> Word32
id :: Word32
    , Product -> Features
features :: Features
    }
    deriving (Product -> Product -> Bool
(Product -> Product -> Bool)
-> (Product -> Product -> Bool) -> Eq Product
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
/= :: Product -> Product -> Bool
Eq, Eq Product
Eq Product =>
(Product -> Product -> Ordering)
-> (Product -> Product -> Bool)
-> (Product -> Product -> Bool)
-> (Product -> Product -> Bool)
-> (Product -> Product -> Bool)
-> (Product -> Product -> Product)
-> (Product -> Product -> Product)
-> Ord Product
Product -> Product -> Bool
Product -> Product -> Ordering
Product -> Product -> Product
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
$ccompare :: Product -> Product -> Ordering
compare :: Product -> Product -> Ordering
$c< :: Product -> Product -> Bool
< :: Product -> Product -> Bool
$c<= :: Product -> Product -> Bool
<= :: Product -> Product -> Bool
$c> :: Product -> Product -> Bool
> :: Product -> Product -> Bool
$c>= :: Product -> Product -> Bool
>= :: Product -> Product -> Bool
$cmax :: Product -> Product -> Product
max :: Product -> Product -> Product
$cmin :: Product -> Product -> Product
min :: Product -> Product -> Product
Ord, Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
(Int -> Product -> ShowS)
-> (Product -> String) -> ([Product] -> ShowS) -> Show Product
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Product -> ShowS
showsPrec :: Int -> Product -> ShowS
$cshow :: Product -> String
show :: Product -> String
$cshowList :: [Product] -> ShowS
showList :: [Product] -> ShowS
Show, (forall x. Product -> Rep Product x)
-> (forall x. Rep Product x -> Product) -> Generic Product
forall x. Rep Product x -> Product
forall x. Product -> Rep Product x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Product -> Rep Product x
from :: forall x. Product -> Rep Product x
$cto :: forall x. Rep Product x -> Product
to :: forall x. Rep Product x -> Product
Generic)

data ProductLookupError
    = UnknownVendorId Word32
    | UnknownProductId Word32
    deriving (ProductLookupError -> ProductLookupError -> Bool
(ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> Eq ProductLookupError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProductLookupError -> ProductLookupError -> Bool
== :: ProductLookupError -> ProductLookupError -> Bool
$c/= :: ProductLookupError -> ProductLookupError -> Bool
/= :: ProductLookupError -> ProductLookupError -> Bool
Eq, Eq ProductLookupError
Eq ProductLookupError =>
(ProductLookupError -> ProductLookupError -> Ordering)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> ProductLookupError)
-> (ProductLookupError -> ProductLookupError -> ProductLookupError)
-> Ord ProductLookupError
ProductLookupError -> ProductLookupError -> Bool
ProductLookupError -> ProductLookupError -> Ordering
ProductLookupError -> ProductLookupError -> ProductLookupError
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
$ccompare :: ProductLookupError -> ProductLookupError -> Ordering
compare :: ProductLookupError -> ProductLookupError -> Ordering
$c< :: ProductLookupError -> ProductLookupError -> Bool
< :: ProductLookupError -> ProductLookupError -> Bool
$c<= :: ProductLookupError -> ProductLookupError -> Bool
<= :: ProductLookupError -> ProductLookupError -> Bool
$c> :: ProductLookupError -> ProductLookupError -> Bool
> :: ProductLookupError -> ProductLookupError -> Bool
$c>= :: ProductLookupError -> ProductLookupError -> Bool
>= :: ProductLookupError -> ProductLookupError -> Bool
$cmax :: ProductLookupError -> ProductLookupError -> ProductLookupError
max :: ProductLookupError -> ProductLookupError -> ProductLookupError
$cmin :: ProductLookupError -> ProductLookupError -> ProductLookupError
min :: ProductLookupError -> ProductLookupError -> ProductLookupError
Ord, Int -> ProductLookupError -> ShowS
[ProductLookupError] -> ShowS
ProductLookupError -> String
(Int -> ProductLookupError -> ShowS)
-> (ProductLookupError -> String)
-> ([ProductLookupError] -> ShowS)
-> Show ProductLookupError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProductLookupError -> ShowS
showsPrec :: Int -> ProductLookupError -> ShowS
$cshow :: ProductLookupError -> String
show :: ProductLookupError -> String
$cshowList :: [ProductLookupError] -> ShowS
showList :: [ProductLookupError] -> ShowS
Show, (forall x. ProductLookupError -> Rep ProductLookupError x)
-> (forall x. Rep ProductLookupError x -> ProductLookupError)
-> Generic ProductLookupError
forall x. Rep ProductLookupError x -> ProductLookupError
forall x. ProductLookupError -> Rep ProductLookupError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProductLookupError -> Rep ProductLookupError x
from :: forall x. ProductLookupError -> Rep ProductLookupError x
$cto :: forall x. Rep ProductLookupError x -> ProductLookupError
to :: forall x. Rep ProductLookupError x -> ProductLookupError
Generic)

productLookup :: Word32 -> Word32 -> Word16 -> Word16 -> Either ProductLookupError Product
productLookup :: Word32
-> Word32 -> Word16 -> Word16 -> Either ProductLookupError Product
productLookup Word32
vendor Word32
prod Word16
versionMinor Word16
versionMajor =
    case Map Word32 (Features, Map Word32 ProductInfo)
productInfoMap Map Word32 (Features, Map Word32 ProductInfo)
-> Word32 -> Maybe (Features, Map Word32 ProductInfo)
forall k a. Ord k => Map k a -> k -> Maybe a
!? Word32
vendor of
        Maybe (Features, Map Word32 ProductInfo)
Nothing -> ProductLookupError -> Either ProductLookupError Product
forall a b. a -> Either a b
Left (ProductLookupError -> Either ProductLookupError Product)
-> ProductLookupError -> Either ProductLookupError Product
forall a b. (a -> b) -> a -> b
$ Word32 -> ProductLookupError
UnknownVendorId Word32
vendor
        Just (Features
defaults, Map Word32 ProductInfo
products) -> case Map Word32 ProductInfo
products Map Word32 ProductInfo -> Word32 -> Maybe ProductInfo
forall k a. Ord k => Map k a -> k -> Maybe a
!? Word32
prod of
            Maybe ProductInfo
Nothing -> ProductLookupError -> Either ProductLookupError Product
forall a b. a -> Either a b
Left (ProductLookupError -> Either ProductLookupError Product)
-> ProductLookupError -> Either ProductLookupError Product
forall a b. (a -> b) -> a -> b
$ Word32 -> ProductLookupError
UnknownProductId Word32
prod
            Just ProductInfo{$sel:features:ProductInfo :: ProductInfo -> PartialFeatures
features = PartialFeatures
originalFeatures, [Upgrade]
Word32
Text
pid :: Word32
name :: Text
upgrades :: [Upgrade]
$sel:pid:ProductInfo :: ProductInfo -> Word32
$sel:name:ProductInfo :: ProductInfo -> Text
$sel:upgrades:ProductInfo :: ProductInfo -> [Upgrade]
..} ->
                Product -> Either ProductLookupError Product
forall a. a -> Either ProductLookupError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    Product
                        { Text
$sel:name:Product :: Text
name :: Text
name
                        , $sel:id:Product :: Word32
id = Word32
prod
                        , $sel:features:Product :: Features
features =
                            Features -> PartialFeatures -> Features
forall {p} {p}.
(HasField "hev" p (Maybe Bool), HasField "hev" p Bool,
 HasField "color" p (Maybe Bool), HasField "color" p Bool,
 HasField "chain" p (Maybe Bool), HasField "chain" p Bool,
 HasField "matrix" p (Maybe Bool), HasField "matrix" p Bool,
 HasField "relays" p (Maybe Bool), HasField "relays" p Bool,
 HasField "buttons" p (Maybe Bool), HasField "buttons" p Bool,
 HasField "infrared" p (Maybe Bool), HasField "infrared" p Bool,
 HasField "multizone" p (Maybe Bool), HasField "multizone" p Bool,
 HasField "temperatureRange" p (Maybe (Word16, Word16)),
 HasField "temperatureRange" p (Maybe (Word16, Word16)),
 HasField "extendedMultizone" p (Maybe Bool),
 HasField "extendedMultizone" p Bool) =>
p -> p -> Features
completeFeatures Features
defaults (PartialFeatures -> Features) -> PartialFeatures -> Features
forall a b. (a -> b) -> a -> b
$
                                (PartialFeatures -> Upgrade -> PartialFeatures)
-> PartialFeatures -> [Upgrade] -> PartialFeatures
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                                    ( \PartialFeatures
old Upgrade{Word16
PartialFeatures
major :: Word16
minor :: Word16
features :: PartialFeatures
$sel:major:Upgrade :: Upgrade -> Word16
$sel:minor:Upgrade :: Upgrade -> Word16
$sel:features:Upgrade :: Upgrade -> PartialFeatures
..} ->
                                        if (Word16
versionMajor, Word16
versionMinor) (Word16, Word16) -> (Word16, Word16) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Word16
major, Word16
minor)
                                            then PartialFeatures -> PartialFeatures -> PartialFeatures
forall {p} {p}.
(HasField "hev" p (Maybe Bool), HasField "hev" p (Maybe Bool),
 HasField "color" p (Maybe Bool), HasField "color" p (Maybe Bool),
 HasField "chain" p (Maybe Bool), HasField "chain" p (Maybe Bool),
 HasField "matrix" p (Maybe Bool), HasField "matrix" p (Maybe Bool),
 HasField "relays" p (Maybe Bool), HasField "relays" p (Maybe Bool),
 HasField "buttons" p (Maybe Bool),
 HasField "buttons" p (Maybe Bool),
 HasField "infrared" p (Maybe Bool),
 HasField "infrared" p (Maybe Bool),
 HasField "multizone" p (Maybe Bool),
 HasField "multizone" p (Maybe Bool),
 HasField "temperatureRange" p (Maybe (Word16, Word16)),
 HasField "temperatureRange" p (Maybe (Word16, Word16)),
 HasField "extendedMultizone" p (Maybe Bool),
 HasField "extendedMultizone" p (Maybe Bool)) =>
p -> p -> PartialFeatures
addFeatures PartialFeatures
features PartialFeatures
old
                                            else PartialFeatures
old
                                    )
                                    PartialFeatures
originalFeatures
                                    [Upgrade]
upgrades
                        }
  where
    completeFeatures :: p -> p -> Features
completeFeatures p
f p
pf =
        Features
            { $sel:hev:Features :: Bool
hev = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.hev p
pf.hev
            , $sel:color:Features :: Bool
color = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.color p
pf.color
            , $sel:chain:Features :: Bool
chain = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.chain p
pf.chain
            , $sel:matrix:Features :: Bool
matrix = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.matrix p
pf.matrix
            , $sel:relays:Features :: Bool
relays = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.relays p
pf.relays
            , $sel:buttons:Features :: Bool
buttons = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.buttons p
pf.buttons
            , $sel:infrared:Features :: Bool
infrared = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.infrared p
pf.infrared
            , $sel:multizone:Features :: Bool
multizone = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.multizone p
pf.multizone
            , $sel:temperatureRange:Features :: Maybe (Word16, Word16)
temperatureRange = p
pf.temperatureRange Maybe (Word16, Word16)
-> Maybe (Word16, Word16) -> Maybe (Word16, Word16)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
f.temperatureRange
            , $sel:extendedMultizone:Features :: Bool
extendedMultizone = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe p
f.extendedMultizone p
pf.extendedMultizone
            }
    -- left-biased
    addFeatures :: p -> p -> PartialFeatures
addFeatures p
new p
old =
        PartialFeatures
            { $sel:hev:PartialFeatures :: Maybe Bool
hev = p
new.hev Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.hev
            , $sel:color:PartialFeatures :: Maybe Bool
color = p
new.color Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.color
            , $sel:chain:PartialFeatures :: Maybe Bool
chain = p
new.chain Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.chain
            , $sel:matrix:PartialFeatures :: Maybe Bool
matrix = p
new.matrix Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.matrix
            , $sel:relays:PartialFeatures :: Maybe Bool
relays = p
new.relays Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.relays
            , $sel:buttons:PartialFeatures :: Maybe Bool
buttons = p
new.buttons Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.buttons
            , $sel:infrared:PartialFeatures :: Maybe Bool
infrared = p
new.infrared Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.infrared
            , $sel:multizone:PartialFeatures :: Maybe Bool
multizone = p
new.multizone Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.multizone
            , $sel:temperatureRange:PartialFeatures :: Maybe (Word16, Word16)
temperatureRange = p
new.temperatureRange Maybe (Word16, Word16)
-> Maybe (Word16, Word16) -> Maybe (Word16, Word16)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.temperatureRange
            , $sel:extendedMultizone:PartialFeatures :: Maybe Bool
extendedMultizone = p
new.extendedMultizone Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.extendedMultizone
            }