Rename light command layer (Light, LightSettings, BrightnessSettings)

This commit is contained in:
2026-09-29 23:14:07 +03:00
parent fefeae6301
commit 7ce994e814
6 changed files with 36 additions and 36 deletions
+23 -23
View File
@@ -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
+2 -2
View File
@@ -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)
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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)
+1 -1
View File
@@ -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)
+7 -7
View File
@@ -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)])