Rename light command layer (Light, LightSettings, BrightnessSettings)
This commit is contained in:
@@ -3,6 +3,7 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE MonadComprehensions #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
module HomeAssistant.Controller
|
||||
( Service(..)
|
||||
@@ -30,7 +31,7 @@ module HomeAssistant.Controller
|
||||
, switch
|
||||
, Target(..)
|
||||
, brightness
|
||||
, Light(..)
|
||||
, LightCommand(..)
|
||||
, lightSignal
|
||||
, LightStatus(..)
|
||||
, ikeaQuickButton
|
||||
@@ -40,9 +41,9 @@ module HomeAssistant.Controller
|
||||
, activateSceneWith
|
||||
, ikeaBoxRemote
|
||||
, IkeaController(..)
|
||||
, LightSettings(..)
|
||||
, BrightnessSettings(..)
|
||||
, formatLightSettings
|
||||
, LightAttributes(..)
|
||||
, Brightness(..)
|
||||
, formatLightAttributes
|
||||
) where
|
||||
|
||||
import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge)
|
||||
@@ -152,44 +153,43 @@ motionToPresence delay = (eventOccupied &&& eventUnoccupied)
|
||||
|
||||
instance Serialize Motion
|
||||
|
||||
data BrightnessSettings = BrightnessPercentage Double | Brightness Int
|
||||
deriving (Show, Generic)
|
||||
instance Default BrightnessSettings where
|
||||
data Brightness = BrightnessPercent Double | BrightnessAbsolute Int
|
||||
deriving (Show, Generic)
|
||||
instance Default Brightness where
|
||||
|
||||
data LightSettings = LightSettings
|
||||
{ lightSettingsBrightness :: Maybe BrightnessSettings
|
||||
, lightSettingsTemperature :: Maybe Int
|
||||
, lightSettingsTransition :: Maybe Double
|
||||
data LightAttributes = LightAttributes
|
||||
{ lightBrightness :: Maybe Brightness
|
||||
, lightColorTemperature :: Maybe Int
|
||||
, lightTransition :: Maybe Double
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
|
||||
instance Default LightSettings where
|
||||
instance Default LightAttributes where
|
||||
|
||||
|
||||
formatLightSettings :: LightSettings -> Maybe Value
|
||||
formatLightSettings s = toObject $ catMaybes
|
||||
[ ["transition" .= x | x <- lightSettingsTransition s]
|
||||
, ["color_temp_kelvin" .= k | k <- lightSettingsTemperature s]
|
||||
, ["brightness" .= b | Brightness b <- lightSettingsBrightness s]
|
||||
, ["brightness_pct" .= b | BrightnessPercentage b <- lightSettingsBrightness s]
|
||||
formatLightAttributes :: LightAttributes -> Maybe Value
|
||||
formatLightAttributes LightAttributes{lightBrightness, lightColorTemperature, lightTransition} = toObject $ catMaybes
|
||||
[ ["transition" .= x | x <- lightTransition]
|
||||
, ["color_temp_kelvin" .= k | k <- lightColorTemperature]
|
||||
, ["brightness" .= b | BrightnessAbsolute b <- lightBrightness]
|
||||
, ["brightness_pct" .= b | BrightnessPercent b <- lightBrightness]
|
||||
]
|
||||
where
|
||||
toObject :: [Pair] -> Maybe Value
|
||||
toObject [] = Nothing
|
||||
toObject xs = Just $ object xs
|
||||
|
||||
data Light
|
||||
data LightCommand
|
||||
= Off
|
||||
| On LightSettings
|
||||
| On LightAttributes
|
||||
|
||||
-- Turn off lights when door is closed
|
||||
light :: [Target] -> Light -> Service
|
||||
light :: [Target] -> LightCommand -> Service
|
||||
light targets (On settings) = Service
|
||||
{ serviceDomain="light"
|
||||
, serviceName= "turn_on"
|
||||
-- , serviceData= fmap (\pct -> object ["brightness_pct" .= pct]) brightnessPercentage
|
||||
, serviceData= formatLightSettings settings
|
||||
, serviceData= formatLightAttributes settings
|
||||
, serviceTarget=targets
|
||||
}
|
||||
light targets Off = Service
|
||||
|
||||
@@ -79,8 +79,8 @@ bedroomPresenceController = proc x -> do
|
||||
toLight :: T.Text -> LightStatus -> [Service]
|
||||
toLight entityId LightStatus{lightEnabled=False} = [light [EntityId entityId] Off]
|
||||
toLight entityId LightStatus{lightEnabled=True, lightTemperature=t, lightBrightness=b} =
|
||||
[ light [EntityId entityId] (On def{lightSettingsTemperature=Just t})
|
||||
, light [EntityId entityId] (On def{lightSettingsTransition=Just 5, lightSettingsBrightness=Just (Brightness b)})
|
||||
[ light [EntityId entityId] (On def{lightColorTemperature=Just t})
|
||||
, light [EntityId entityId] (On def{lightTransition=Just 5, lightBrightness=Just (BrightnessAbsolute b)})
|
||||
]
|
||||
doSnapshot = presenceLightEvents
|
||||
>>> arr (\ev -> if ev == Event LightsSleep then Event () else Tick)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE Arrows #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module HomeAssistant.Controller.Children where
|
||||
import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightSettings (..), BrightnessSettings (..))
|
||||
import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, LightCommand(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightAttributes (..), Brightness (..))
|
||||
import AFRP (Event (..))
|
||||
import qualified AFRP
|
||||
import Control.Arrow (Arrow(..), (>>>), returnA)
|
||||
@@ -75,7 +75,7 @@ schoolLightController = lightsOn <> lightsOff
|
||||
|
||||
lightsOn :: HASS a ()
|
||||
lightsOn = foldMap atTime timersOn
|
||||
>>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] (On def{lightSettingsBrightness=Just $ BrightnessPercentage 100} )))
|
||||
>>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] (On def{lightBrightness=Just $ BrightnessPercent 100} )))
|
||||
|
||||
lightsOff :: HASS a ()
|
||||
lightsOff = foldMap atTime timersOff
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE Arrows #-}
|
||||
module HomeAssistant.Controller.Hallway where
|
||||
|
||||
import HomeAssistant.Controller (Presence (..), HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), Light (..))
|
||||
import HomeAssistant.Controller (Presence (..), HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), LightCommand (..))
|
||||
import AFRP (Event (..))
|
||||
import qualified AFRP
|
||||
import Data.Aeson (Value)
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE Arrows #-}
|
||||
module HomeAssistant.Controller.Livingroom where
|
||||
|
||||
import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, Light (..), traceEvent, callService, activateScene)
|
||||
import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, LightCommand (..), traceEvent, callService, activateScene)
|
||||
import qualified AFRP
|
||||
import Control.Arrow ((>>>), Arrow (..), returnA)
|
||||
import Data.Aeson (Value)
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
module ControllerSpec where
|
||||
import Test.Hspec
|
||||
import Data.Default (def)
|
||||
import HomeAssistant.Controller (BrightnessSettings(..), formatLightSettings, LightSettings(..))
|
||||
import HomeAssistant.Controller (Brightness(..), formatLightAttributes, LightAttributes(..))
|
||||
import Data.Aeson (object, (.=))
|
||||
import HomeAssistant.Controller ()
|
||||
|
||||
@@ -11,19 +11,19 @@ spec :: Spec
|
||||
spec = describe "Generic controller" $
|
||||
describe "Light settings" $ do
|
||||
it "formats the default as empty" $
|
||||
formatLightSettings def `shouldBe` Nothing
|
||||
formatLightAttributes def `shouldBe` Nothing
|
||||
it "formats the transition" $
|
||||
formatLightSettings def{lightSettingsTransition=Just 5} `shouldBe`
|
||||
formatLightAttributes def{lightTransition=Just 5} `shouldBe`
|
||||
Just (object ["transition" .= (5 :: Int)])
|
||||
it "formats the temperature" $
|
||||
formatLightSettings def{lightSettingsTemperature=Just 5} `shouldBe`
|
||||
formatLightAttributes def{lightColorTemperature=Just 5} `shouldBe`
|
||||
Just (object ["color_temp_kelvin" .= (5 :: Int)])
|
||||
it "formats the brightness as percentage" $
|
||||
formatLightSettings def{lightSettingsBrightness=Just (BrightnessPercentage 100)} `shouldBe`
|
||||
formatLightAttributes def{lightBrightness=Just (BrightnessPercent 100)} `shouldBe`
|
||||
Just (object ["brightness_pct" .= (100 :: Int)])
|
||||
it "formats the brightness as absolute" $
|
||||
formatLightSettings def{lightSettingsBrightness=Just (Brightness 200)} `shouldBe`
|
||||
formatLightAttributes def{lightBrightness=Just (BrightnessAbsolute 200)} `shouldBe`
|
||||
Just (object ["brightness" .= (200 :: Int)])
|
||||
it "formats multiple values" $
|
||||
formatLightSettings def{lightSettingsTransition = Just 5, lightSettingsBrightness=Just (Brightness 200)} `shouldBe`
|
||||
formatLightAttributes def{lightTransition = Just 5, lightBrightness=Just (BrightnessAbsolute 200)} `shouldBe`
|
||||
Just (object ["brightness" .= (200 :: Int), "transition" .= (5 :: Int)])
|
||||
|
||||
Reference in New Issue
Block a user