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
)
)
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
}
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
}