From 7ce994e814199aa3cacba3ac8ca35328a3f53414 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 29 Sep 2026 23:14:07 +0300 Subject: [PATCH] Rename light command layer (Light, LightSettings, BrightnessSettings) --- src/HomeAssistant/Controller.hs | 46 +++++++++++----------- src/HomeAssistant/Controller/Bedroom.hs | 4 +- src/HomeAssistant/Controller/Children.hs | 4 +- src/HomeAssistant/Controller/Hallway.hs | 2 +- src/HomeAssistant/Controller/Livingroom.hs | 2 +- test/ControllerSpec.hs | 14 +++---- 6 files changed, 36 insertions(+), 36 deletions(-) diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs index 6257fc3..fbd82e4 100644 --- a/src/HomeAssistant/Controller.hs +++ b/src/HomeAssistant/Controller.hs @@ -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 diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs index 69008ed..d337206 100644 --- a/src/HomeAssistant/Controller/Bedroom.hs +++ b/src/HomeAssistant/Controller/Bedroom.hs @@ -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) diff --git a/src/HomeAssistant/Controller/Children.hs b/src/HomeAssistant/Controller/Children.hs index 828fd78..513ea30 100644 --- a/src/HomeAssistant/Controller/Children.hs +++ b/src/HomeAssistant/Controller/Children.hs @@ -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 diff --git a/src/HomeAssistant/Controller/Hallway.hs b/src/HomeAssistant/Controller/Hallway.hs index 91dd010..3d84f6d 100644 --- a/src/HomeAssistant/Controller/Hallway.hs +++ b/src/HomeAssistant/Controller/Hallway.hs @@ -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) diff --git a/src/HomeAssistant/Controller/Livingroom.hs b/src/HomeAssistant/Controller/Livingroom.hs index b9ceb17..786ff5c 100644 --- a/src/HomeAssistant/Controller/Livingroom.hs +++ b/src/HomeAssistant/Controller/Livingroom.hs @@ -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) diff --git a/test/ControllerSpec.hs b/test/ControllerSpec.hs index 0abc474..aa9ec80 100644 --- a/test/ControllerSpec.hs +++ b/test/ControllerSpec.hs @@ -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)])