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 =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
        [VendorInfo]
productInfo forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VendorInfo{[ProductInfo]
Word32
Text
Features
$sel:products:VendorInfo :: VendorInfo -> [ProductInfo]
$sel:defaults:VendorInfo :: VendorInfo -> Features
$sel:name:VendorInfo :: VendorInfo -> Text
$sel:vid:VendorInfo :: VendorInfo -> Word32
products :: [ProductInfo]
defaults :: Features
name :: Text
vid :: Word32
..} ->
            ( Word32
vid
            ,
              ( Features
defaults
              , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ ((.pid) forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall a. a -> a
id) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c== :: Product -> Product -> Bool
Eq, Eq 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
min :: Product -> Product -> Product
$cmin :: Product -> Product -> Product
max :: Product -> Product -> Product
$cmax :: Product -> Product -> Product
>= :: Product -> Product -> Bool
$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
compare :: Product -> Product -> Ordering
$ccompare :: Product -> Product -> Ordering
Ord, Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> Product -> ShowS
Show, 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
$cto :: forall x. Rep Product x -> Product
$cfrom :: forall x. Product -> Rep Product x
Generic)

data ProductLookupError
    = UnknownVendorId Word32
    | UnknownProductId Word32
    deriving (ProductLookupError -> ProductLookupError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductLookupError -> ProductLookupError -> Bool
$c/= :: ProductLookupError -> ProductLookupError -> Bool
== :: ProductLookupError -> ProductLookupError -> Bool
$c== :: ProductLookupError -> ProductLookupError -> Bool
Eq, Eq 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
min :: ProductLookupError -> ProductLookupError -> ProductLookupError
$cmin :: ProductLookupError -> ProductLookupError -> ProductLookupError
max :: ProductLookupError -> ProductLookupError -> ProductLookupError
$cmax :: ProductLookupError -> ProductLookupError -> ProductLookupError
>= :: ProductLookupError -> ProductLookupError -> Bool
$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
compare :: ProductLookupError -> ProductLookupError -> Ordering
$ccompare :: ProductLookupError -> ProductLookupError -> Ordering
Ord, Int -> ProductLookupError -> ShowS
[ProductLookupError] -> ShowS
ProductLookupError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductLookupError] -> ShowS
$cshowList :: [ProductLookupError] -> ShowS
show :: ProductLookupError -> String
$cshow :: ProductLookupError -> String
showsPrec :: Int -> ProductLookupError -> ShowS
$cshowsPrec :: Int -> ProductLookupError -> ShowS
Show, 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
$cto :: forall x. Rep ProductLookupError x -> ProductLookupError
$cfrom :: forall x. ProductLookupError -> Rep ProductLookupError x
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 forall k a. Ord k => Map k a -> k -> Maybe a
!? Word32
vendor of
        Maybe (Features, Map Word32 ProductInfo)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Word32 -> ProductLookupError
UnknownVendorId Word32
vendor
        Just (Features
defaults, Map Word32 ProductInfo
products) -> case Map Word32 ProductInfo
products forall k a. Ord k => Map k a -> k -> Maybe a
!? Word32
prod of
            Maybe ProductInfo
Nothing -> forall a b. a -> Either a b
Left 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
$sel:upgrades:ProductInfo :: ProductInfo -> [Upgrade]
$sel:name:ProductInfo :: ProductInfo -> Text
$sel:pid:ProductInfo :: ProductInfo -> Word32
upgrades :: [Upgrade]
name :: Text
pid :: Word32
..} ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    Product
                        { Text
name :: Text
$sel:name:Product :: Text
name
                        , $sel:id:Product :: Word32
id = Word32
prod
                        , $sel:features:Product :: Features
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 forall a b. (a -> b) -> a -> b
$
                                forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                                    ( \PartialFeatures
old Upgrade{Word16
PartialFeatures
$sel:features:Upgrade :: Upgrade -> PartialFeatures
$sel:minor:Upgrade :: Upgrade -> Word16
$sel:major:Upgrade :: Upgrade -> Word16
features :: PartialFeatures
minor :: Word16
major :: Word16
..} ->
                                        if (Word16
versionMajor, Word16
versionMinor) forall a. Ord a => a -> a -> Bool
>= (Word16
major, Word16
minor)
                                            then 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 = forall a. a -> Maybe a -> a
fromMaybe p
f.hev p
pf.hev
            , $sel:color:Features :: Bool
color = forall a. a -> Maybe a -> a
fromMaybe p
f.color p
pf.color
            , $sel:chain:Features :: Bool
chain = forall a. a -> Maybe a -> a
fromMaybe p
f.chain p
pf.chain
            , $sel:matrix:Features :: Bool
matrix = forall a. a -> Maybe a -> a
fromMaybe p
f.matrix p
pf.matrix
            , $sel:relays:Features :: Bool
relays = forall a. a -> Maybe a -> a
fromMaybe p
f.relays p
pf.relays
            , $sel:buttons:Features :: Bool
buttons = forall a. a -> Maybe a -> a
fromMaybe p
f.buttons p
pf.buttons
            , $sel:infrared:Features :: Bool
infrared = forall a. a -> Maybe a -> a
fromMaybe p
f.infrared p
pf.infrared
            , $sel:multizone:Features :: Bool
multizone = forall a. a -> Maybe a -> a
fromMaybe p
f.multizone p
pf.multizone
            , $sel:temperatureRange:Features :: Maybe (Word16, Word16)
temperatureRange = p
pf.temperatureRange forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
f.temperatureRange
            , $sel:extendedMultizone:Features :: Bool
extendedMultizone = 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.hev
            , $sel:color:PartialFeatures :: Maybe Bool
color = p
new.color forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.color
            , $sel:chain:PartialFeatures :: Maybe Bool
chain = p
new.chain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.chain
            , $sel:matrix:PartialFeatures :: Maybe Bool
matrix = p
new.matrix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.matrix
            , $sel:relays:PartialFeatures :: Maybe Bool
relays = p
new.relays forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.relays
            , $sel:buttons:PartialFeatures :: Maybe Bool
buttons = p
new.buttons forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.buttons
            , $sel:infrared:PartialFeatures :: Maybe Bool
infrared = p
new.infrared forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.infrared
            , $sel:multizone:PartialFeatures :: Maybe Bool
multizone = p
new.multizone forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.multizone
            , $sel:temperatureRange:PartialFeatures :: Maybe (Word16, Word16)
temperatureRange = p
new.temperatureRange forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.temperatureRange
            , $sel:extendedMultizone:PartialFeatures :: Maybe Bool
extendedMultizone = p
new.extendedMultizone forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> p
old.extendedMultizone
            }