module Lifx.Internal.ProductInfoMap where

import Control.Applicative
import Data.Either.Extra
import Data.Foldable hiding (product)
import Data.Function
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

--TODO RecordDotSyntax can make this and other hiding unnecessary (we could also use "id" instead of "productId"...)
import Prelude hiding (product)

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
$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
                , [(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
$ (ProductInfo -> Word32
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
productId :: 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
/= :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> 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
$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
(ProductLookupError -> ProductLookupError -> Bool)
-> (ProductLookupError -> ProductLookupError -> Bool)
-> Eq ProductLookupError
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
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
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
$cp1Ord :: Eq 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
showList :: [ProductLookupError] -> ShowS
$cshowList :: [ProductLookupError] -> ShowS
show :: ProductLookupError -> String
$cshow :: ProductLookupError -> String
showsPrec :: Int -> ProductLookupError -> ShowS
$cshowsPrec :: Int -> 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
$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
product 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
product 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
product
            Just ProductInfo{$sel:features:ProductInfo :: ProductInfo -> PartialFeatures
features = PartialFeatures
originalFeatures, [Upgrade]
Word32
Text
$sel:upgrades:ProductInfo :: ProductInfo -> [Upgrade]
$sel:name:ProductInfo :: ProductInfo -> Text
upgrades :: [Upgrade]
name :: Text
pid :: Word32
$sel:pid:ProductInfo :: ProductInfo -> Word32
..} ->
                Product -> Either ProductLookupError Product
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    Product :: Text -> Word32 -> Features -> Product
Product
                        { Text
name :: Text
$sel:name:Product :: Text
name
                        , $sel:productId:Product :: Word32
productId = Word32
product
                        , $sel:features:Product :: Features
features =
                            Features -> PartialFeatures -> Features
completeFeatures Features
defaults (PartialFeatures -> Features) -> PartialFeatures -> Features
forall a b. (a -> b) -> a -> b
$
                                (PartialFeatures -> Upgrade -> PartialFeatures)
-> PartialFeatures -> [Upgrade] -> PartialFeatures
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) (Word16, Word16) -> (Word16, Word16) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Word16
major, Word16
minor)
                                            then PartialFeatures -> PartialFeatures -> PartialFeatures
addFeatures PartialFeatures
features PartialFeatures
old
                                            else PartialFeatures
old
                                    )
                                    PartialFeatures
originalFeatures
                                    [Upgrade]
upgrades
                        }
  where
    --TODO RecordDotSyntax
    completeFeatures :: Features -> PartialFeatures -> Features
completeFeatures
        Features
            { Bool
Maybe (Word16, Word16)
$sel:extendedMultizone:Features :: Features -> Bool
$sel:temperatureRange:Features :: Features -> Maybe (Word16, Word16)
$sel:multizone:Features :: Features -> Bool
$sel:infrared:Features :: Features -> Bool
$sel:buttons:Features :: Features -> Bool
$sel:relays:Features :: Features -> Bool
$sel:matrix:Features :: Features -> Bool
$sel:chain:Features :: Features -> Bool
$sel:color:Features :: Features -> Bool
$sel:hev:Features :: Features -> Bool
extendedMultizone :: Bool
temperatureRange :: Maybe (Word16, Word16)
multizone :: Bool
infrared :: Bool
buttons :: Bool
relays :: Bool
matrix :: Bool
chain :: Bool
color :: Bool
hev :: Bool
..
            }
        PartialFeatures
            { $sel:hev:PartialFeatures :: PartialFeatures -> Maybe Bool
hev = Maybe Bool
maybe_hev
            , $sel:color:PartialFeatures :: PartialFeatures -> Maybe Bool
color = Maybe Bool
maybe_color
            , $sel:chain:PartialFeatures :: PartialFeatures -> Maybe Bool
chain = Maybe Bool
maybe_chain
            , $sel:matrix:PartialFeatures :: PartialFeatures -> Maybe Bool
matrix = Maybe Bool
maybe_matrix
            , $sel:relays:PartialFeatures :: PartialFeatures -> Maybe Bool
relays = Maybe Bool
maybe_relays
            , $sel:buttons:PartialFeatures :: PartialFeatures -> Maybe Bool
buttons = Maybe Bool
maybe_buttons
            , $sel:infrared:PartialFeatures :: PartialFeatures -> Maybe Bool
infrared = Maybe Bool
maybe_infrared
            , $sel:multizone:PartialFeatures :: PartialFeatures -> Maybe Bool
multizone = Maybe Bool
maybe_multizone
            , $sel:temperatureRange:PartialFeatures :: PartialFeatures -> Maybe (Word16, Word16)
temperatureRange = Maybe (Word16, Word16)
maybe_temperatureRange
            , $sel:extendedMultizone:PartialFeatures :: PartialFeatures -> Maybe Bool
extendedMultizone = Maybe Bool
maybe_extendedMultizone
            } =
            Features :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe (Word16, Word16)
-> Bool
-> Features
Features
                { $sel:hev:Features :: Bool
hev = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
hev Maybe Bool
maybe_hev
                , $sel:color:Features :: Bool
color = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
color Maybe Bool
maybe_color
                , $sel:chain:Features :: Bool
chain = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
chain Maybe Bool
maybe_chain
                , $sel:matrix:Features :: Bool
matrix = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
matrix Maybe Bool
maybe_matrix
                , $sel:relays:Features :: Bool
relays = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
relays Maybe Bool
maybe_relays
                , $sel:buttons:Features :: Bool
buttons = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
buttons Maybe Bool
maybe_buttons
                , $sel:infrared:Features :: Bool
infrared = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
infrared Maybe Bool
maybe_infrared
                , $sel:multizone:Features :: Bool
multizone = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
multizone Maybe Bool
maybe_multizone
                , $sel:temperatureRange:Features :: Maybe (Word16, Word16)
temperatureRange = Maybe (Word16, Word16)
maybe_temperatureRange Maybe (Word16, Word16)
-> Maybe (Word16, Word16) -> Maybe (Word16, Word16)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Word16, Word16)
temperatureRange
                , $sel:extendedMultizone:Features :: Bool
extendedMultizone = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
extendedMultizone Maybe Bool
maybe_extendedMultizone
                }
    -- left-biased
    addFeatures :: PartialFeatures -> PartialFeatures -> PartialFeatures
addFeatures
        PartialFeatures
            { Maybe Bool
Maybe (Word16, Word16)
extendedMultizone :: Maybe Bool
temperatureRange :: Maybe (Word16, Word16)
multizone :: Maybe Bool
infrared :: Maybe Bool
buttons :: Maybe Bool
relays :: Maybe Bool
matrix :: Maybe Bool
chain :: Maybe Bool
color :: Maybe Bool
hev :: Maybe Bool
$sel:extendedMultizone:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:temperatureRange:PartialFeatures :: PartialFeatures -> Maybe (Word16, Word16)
$sel:multizone:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:infrared:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:buttons:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:relays:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:matrix:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:chain:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:color:PartialFeatures :: PartialFeatures -> Maybe Bool
$sel:hev:PartialFeatures :: PartialFeatures -> Maybe Bool
..
            }
        PartialFeatures
            { $sel:hev:PartialFeatures :: PartialFeatures -> Maybe Bool
hev = Maybe Bool
old_hev
            , $sel:color:PartialFeatures :: PartialFeatures -> Maybe Bool
color = Maybe Bool
old_color
            , $sel:chain:PartialFeatures :: PartialFeatures -> Maybe Bool
chain = Maybe Bool
old_chain
            , $sel:matrix:PartialFeatures :: PartialFeatures -> Maybe Bool
matrix = Maybe Bool
old_matrix
            , $sel:relays:PartialFeatures :: PartialFeatures -> Maybe Bool
relays = Maybe Bool
old_relays
            , $sel:buttons:PartialFeatures :: PartialFeatures -> Maybe Bool
buttons = Maybe Bool
old_buttons
            , $sel:infrared:PartialFeatures :: PartialFeatures -> Maybe Bool
infrared = Maybe Bool
old_infrared
            , $sel:multizone:PartialFeatures :: PartialFeatures -> Maybe Bool
multizone = Maybe Bool
old_multizone
            , $sel:temperatureRange:PartialFeatures :: PartialFeatures -> Maybe (Word16, Word16)
temperatureRange = Maybe (Word16, Word16)
old_temperatureRange
            , $sel:extendedMultizone:PartialFeatures :: PartialFeatures -> Maybe Bool
extendedMultizone = Maybe Bool
old_extendedMultizone
            } =
            PartialFeatures :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe (Word16, Word16)
-> Maybe Bool
-> PartialFeatures
PartialFeatures
                { $sel:hev:PartialFeatures :: Maybe Bool
hev = Maybe Bool
hev Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_hev
                , $sel:color:PartialFeatures :: Maybe Bool
color = Maybe Bool
color Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_color
                , $sel:chain:PartialFeatures :: Maybe Bool
chain = Maybe Bool
chain Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_chain
                , $sel:matrix:PartialFeatures :: Maybe Bool
matrix = Maybe Bool
matrix Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_matrix
                , $sel:relays:PartialFeatures :: Maybe Bool
relays = Maybe Bool
relays Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_relays
                , $sel:buttons:PartialFeatures :: Maybe Bool
buttons = Maybe Bool
buttons Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_buttons
                , $sel:infrared:PartialFeatures :: Maybe Bool
infrared = Maybe Bool
infrared Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_infrared
                , $sel:multizone:PartialFeatures :: Maybe Bool
multizone = Maybe Bool
multizone Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_multizone
                , $sel:temperatureRange:PartialFeatures :: Maybe (Word16, Word16)
temperatureRange = Maybe (Word16, Word16)
temperatureRange Maybe (Word16, Word16)
-> Maybe (Word16, Word16) -> Maybe (Word16, Word16)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Word16, Word16)
old_temperatureRange
                , $sel:extendedMultizone:PartialFeatures :: Maybe Bool
extendedMultizone = Maybe Bool
extendedMultizone Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
old_extendedMultizone
                }