From fefeae6301e31068a6f065096d15423dc351c09c Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 29 Sep 2026 22:51:37 +0300 Subject: [PATCH] Store a custom snapshot of lights --- default.nix | 17 ++--- home-assistant-controller.cabal | 4 ++ src/AFRP.hs | 6 ++ src/HomeAssistant/Controller.hs | 79 ++++++++++++++++++++-- src/HomeAssistant/Controller/Bedroom.hs | 26 ++++++- src/HomeAssistant/Controller/Children.hs | 5 +- src/HomeAssistant/Controller/Hallway.hs | 3 +- src/HomeAssistant/Controller/Kitchen.hs | 5 +- src/HomeAssistant/Controller/Livingroom.hs | 3 +- src/HomeAssistant/Runtime.hs | 4 ++ src/HomeAssistant/Runtime/Bus.hs | 5 ++ test/BedroomSpec.hs | 4 +- test/ControllerSpec.hs | 29 ++++++++ test/KitchenSpec.hs | 5 +- test/Main.hs | 2 + 15 files changed, 173 insertions(+), 24 deletions(-) create mode 100644 test/ControllerSpec.hs diff --git a/default.nix b/default.nix index 672ab13..f7bf0d6 100644 --- a/default.nix +++ b/default.nix @@ -1,9 +1,10 @@ { mkDerivation, aeson, annotated-exception, async, base, bytestring -, cereal, cereal-conduit, conduit, containers, directory, ekg-core -, exceptions, filepath, hedgehog, hspec, hspec-hedgehog, http-media -, http-types, katip, lens, lens-aeson, lib, network, process, retry -, servant, servant-server, stm, temporary, text, time, unliftio -, unordered-containers, uuid, wai, warp, websockets +, cereal, cereal-conduit, cereal-text, conduit, containers +, directory, ekg-core, exceptions, filepath, hedgehog, hspec +, hspec-hedgehog, http-media, http-types, katip, lens, lens-aeson +, lib, network, process, retry, servant, servant-server, stm +, temporary, text, time, unliftio, unordered-containers, uuid, wai +, warp, websockets }: mkDerivation { pname = "home-assistant-controller"; @@ -13,9 +14,9 @@ mkDerivation { isExecutable = true; libraryHaskellDepends = [ aeson annotated-exception async base bytestring cereal - cereal-conduit conduit containers directory ekg-core exceptions - filepath http-media http-types katip lens lens-aeson network - process retry servant servant-server stm text time unliftio + cereal-conduit cereal-text conduit containers directory ekg-core + exceptions filepath http-media http-types katip lens lens-aeson + network process retry servant servant-server stm text time unliftio unordered-containers uuid wai warp websockets ]; executableHaskellDepends = [ base ]; diff --git a/home-assistant-controller.cabal b/home-assistant-controller.cabal index f933dd1..19879a7 100644 --- a/home-assistant-controller.cabal +++ b/home-assistant-controller.cabal @@ -107,7 +107,9 @@ library , process , directory , cereal + , cereal-text , containers + , data-default , filepath , conduit , cereal-conduit @@ -169,6 +171,7 @@ test-suite home-assistant-controller-test , MetricsSpec , RuntimeSpec , Support + , ControllerSpec -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -187,6 +190,7 @@ test-suite home-assistant-controller-test base ^>=4.20.2.0, home-assistant-controller, bytestring, + data-default, hspec, stm, servant, diff --git a/src/AFRP.hs b/src/AFRP.hs index 3a0bbba..e6f9323 100644 --- a/src/AFRP.hs +++ b/src/AFRP.hs @@ -42,6 +42,7 @@ module AFRP , load , stepAuto , stepAutoSerializing + , snapshot ) where import Control.Category (Category(..), (>>>)) @@ -325,6 +326,11 @@ hold def = mapAccum step def id Tick -> prev Event new -> new +snapshot :: (Serialize a, Eq a) => a -> Mealy m (Event (), a) a +snapshot def = mapAccum step def id + where + step prev (Tick, _) = prev + step _prev (Event _, a) = a events :: Mealy eff (Event a) (Either () a) events = arr $ \case diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs index afccba9..6257fc3 100644 --- a/src/HomeAssistant/Controller.hs +++ b/src/HomeAssistant/Controller.hs @@ -2,13 +2,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE MonadComprehensions #-} module HomeAssistant.Controller ( Service(..) , HASSEff(..) , HASS , callService + , callServices , callServiceDyn + , callServicesDyn , entityChangeEvent , entityChangeEvent' , entityRead @@ -28,6 +31,8 @@ module HomeAssistant.Controller , Target(..) , brightness , Light(..) + , lightSignal + , LightStatus(..) , ikeaQuickButton , IkeaButton(..) , IkeaGesture(..) @@ -35,11 +40,15 @@ module HomeAssistant.Controller , activateSceneWith , ikeaBoxRemote , IkeaController(..) + , LightSettings(..) + , BrightnessSettings(..) + , formatLightSettings ) where import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge) import Control.Arrow (Arrow(..), returnA) -import Control.Category ((>>>)) +import Control.Category ((>>>), (.)) +import Prelude hiding ((.)) import Data.Aeson (Value, object, (.=)) import qualified Data.Text as T import qualified Data.Set as S @@ -50,6 +59,9 @@ import Data.Bool (bool) import Data.Serialize (Serialize) import GHC.Generics (Generic) import Data.Time (NominalDiffTime) +import Data.Default (Default) +import Data.Aeson.Types (Pair) +import Data.Maybe (catMaybes) data Target = EntityId !T.Text | AreaId !T.Text deriving (Show,Eq,Ord) @@ -64,6 +76,7 @@ data Service = Service data HASSEff a where CallService :: Request -> Service -> HASSEff () + CallServices :: Request -> [Service] -> HASSEff () Debug :: Show a => a -> HASSEff () Trace :: Show a => Request -> a -> HASSEff () @@ -72,9 +85,15 @@ type HASS a b = Mealy HASSEff a b callService :: Service -> HASS a () callService service = eff (\req _ -> CallService req service) +callServices :: [Service] -> HASS a () +callServices service = eff (\req _ -> CallServices req service) + callServiceDyn :: (a -> Service) -> HASS a () callServiceDyn mkService = eff (\req a -> CallService req (mkService a)) +callServicesDyn :: (a -> [Service]) -> HASS a () +callServicesDyn mkService = eff (\req a -> CallServices req (mkService a)) + debug :: Show a => HASS a a debug = proc x -> do eff (const Debug) -< x @@ -133,16 +152,44 @@ motionToPresence delay = (eventOccupied &&& eventUnoccupied) instance Serialize Motion +data BrightnessSettings = BrightnessPercentage Double | Brightness Int + deriving (Show, Generic) +instance Default BrightnessSettings where + +data LightSettings = LightSettings + { lightSettingsBrightness :: Maybe BrightnessSettings + , lightSettingsTemperature :: Maybe Int + , lightSettingsTransition :: Maybe Double + } + deriving (Show, Generic) + + +instance Default LightSettings 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] + ] + where + toObject :: [Pair] -> Maybe Value + toObject [] = Nothing + toObject xs = Just $ object xs + data Light = Off - | On { brightnessPercentage :: Maybe Double } + | On LightSettings -- Turn off lights when door is closed light :: [Target] -> Light -> Service -light targets (On {brightnessPercentage}) = Service +light targets (On settings) = Service { serviceDomain="light" , serviceName= "turn_on" - , serviceData=fmap (\pct -> object ["brightness_pct" .= pct]) brightnessPercentage + -- , serviceData= fmap (\pct -> object ["brightness_pct" .= pct]) brightnessPercentage + , serviceData= formatLightSettings settings , serviceTarget=targets } light targets Off = Service @@ -199,6 +246,30 @@ brightness entityId = where eventBrightness v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "brightness" . _Integral +temperature :: T.Text -> HASS (Event Value) (Event Int) +temperature entityId = + entityChangeEvent' entityId + >>| arr (maybe (Left ()) Right . eventTemperature) + >>> AFRP.toEvent + where + eventTemperature v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "color_temp_kelvin" . _Integral + +-- XXX: Needs better name +data LightStatus = LightStatus + { lightEnabled :: Bool + , lightBrightness :: Int + , lightTemperature :: Int + } + deriving (Show, Generic, Eq) +instance Serialize LightStatus + +lightSignal :: T.Text -> HASS (Event Value) LightStatus +lightSignal entityId = proc ev -> do + e <- hold False . entityBool entityId -< ev + b <- hold 0 . brightness entityId -< ev + t <- hold 0 . temperature entityId -< ev + returnA -< LightStatus e b t + data IkeaGesture = ShortClick | ShortRelease diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs index 2cd76a5..69008ed 100644 --- a/src/HomeAssistant/Controller/Bedroom.hs +++ b/src/HomeAssistant/Controller/Bedroom.hs @@ -10,6 +10,11 @@ import Control.Arrow ((>>>), returnA, arr, Arrow (..)) import Data.Bool (bool) import Data.Time (NominalDiffTime) import qualified AFRP +import Data.Map (Map) +import qualified Data.Map.Strict as M +import Data.Serialize.Text () +import Data.Foldable (traverse_) +import Data.Default (def) @@ -31,7 +36,7 @@ data PresenceLights = LightsOn -- Restore lights | LightsOff -- Timer expired, darkness | LightsSleep -- No presence detected, sleep mode - deriving Show + deriving (Eq, Show) -- Bedroom presence bedroomPresence :: HASS (Event Value) (Event Presence) @@ -49,19 +54,36 @@ presenceLightEvents = onEvent = AFRP.edge >>> arr (AFRP.tag LightsOn) offEvent = arr not >>> AFRP.waitFor 300 >>> arr (AFRP.tag LightsOff) + +bedroomLightsSignal :: HASS (Event Value) (Map T.Text LightStatus) +bedroomLightsSignal = M.fromList <$> traverse (\e -> (e,) <$> lightSignal e) [e | EntityId e <- bedroomLights] + bedroomPresenceController :: HASS (Event Value) () bedroomPresenceController = proc x -> do p <- presenceLightEvents >>> traceEvent -< x + snap <- (doSnapshot &&& bedroomLightsSignal) >>> AFRP.snapshot M.empty >>> traceValue -< x case p of Event LightsOff -> do callService (light bedroomLights Off) -< () Event LightsOn -> do - callService (activateSceneWith "scene.makuuhuone_lights_snapshot" transition) -< () + -- callService (activateSceneWith "scene.makuuhuone_lights_snapshot" transition) -< () + callServicesDyn (concatMap (uncurry toLight)) -< M.toList snap + returnA -< () Event LightsSleep -> do callService createBedroomScene -< () callService (activateSceneWith "scene.makuuhuone_lepotila" transition) -< () _ -> returnA -< () where + -- This is the meat of this change. To support transitioning the brightness, exactly, + -- we need to do the brightness call separately and last + 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)}) + ] + doSnapshot = presenceLightEvents + >>> arr (\ev -> if ev == Event LightsSleep then Event () else Tick) transition = Just $ object ["transition" .= (1:: Int)] diff --git a/src/HomeAssistant/Controller/Children.hs b/src/HomeAssistant/Controller/Children.hs index 42f4dd7..828fd78 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) +import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightSettings (..), BrightnessSettings (..)) import AFRP (Event (..)) import qualified AFRP import Control.Arrow (Arrow(..), (>>>), returnA) @@ -9,6 +9,7 @@ import Data.Time (Day, TimeOfDay (..), localDay, LocalTime (..)) import Data.Time.Calendar.OrdinalDate (WeekOfYear, mondayStartWeek) import Data.Functor.Contravariant (Predicate (..), (>$<)) import Data.Aeson (Value) +import Data.Default (Default(..)) -- Let's see building some reasonable interface for utctime dow :: Day -> (WeekOfYear, Int) @@ -74,7 +75,7 @@ schoolLightController = lightsOn <> lightsOff lightsOn :: HASS a () lightsOn = foldMap atTime timersOn - >>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] On{brightnessPercentage = Just 100})) + >>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] (On def{lightSettingsBrightness=Just $ BrightnessPercentage 100} ))) lightsOff :: HASS a () lightsOff = foldMap atTime timersOff diff --git a/src/HomeAssistant/Controller/Hallway.hs b/src/HomeAssistant/Controller/Hallway.hs index 8b63acc..91dd010 100644 --- a/src/HomeAssistant/Controller/Hallway.hs +++ b/src/HomeAssistant/Controller/Hallway.hs @@ -8,6 +8,7 @@ import qualified AFRP import Data.Aeson (Value) import Control.Arrow ((>>>), Arrow (..), returnA) import Data.Time (LocalTime(..), TimeOfDay (..)) +import Data.Default (def) @@ -31,7 +32,7 @@ hallwayLightsController = proc x -> do traceEvent -< ev case ev of -- The lights entity is a "group of lights" in hass - Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.hallway_lights"]) -< On Nothing + Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.hallway_lights"]) -< On def Event LightsOff -> callServiceDyn (light [EntityId "light.hallway_lights"]) -< Off _ -> returnA -< () where diff --git a/src/HomeAssistant/Controller/Kitchen.hs b/src/HomeAssistant/Controller/Kitchen.hs index 3882823..e08a985 100644 --- a/src/HomeAssistant/Controller/Kitchen.hs +++ b/src/HomeAssistant/Controller/Kitchen.hs @@ -8,6 +8,7 @@ import Data.Aeson (Value) import Control.Arrow ((>>>), Arrow (..), returnA) import Prelude hiding (id) import Data.Time (LocalTime(..), TimeOfDay (..)) +import Data.Default (def) -- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor @@ -31,7 +32,7 @@ kitchenCeilingController = proc x -> do ev <- eventLights -< p traceEvent -< ev case ev of - Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On Nothing + Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On def Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off _ -> returnA -< () where @@ -73,7 +74,7 @@ dinnerTableController = proc x -> do case ev of Event LightsOn -> do sleep -< False - callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On Nothing + callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On def Event LightsOff -> do sleep -< False callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off diff --git a/src/HomeAssistant/Controller/Livingroom.hs b/src/HomeAssistant/Controller/Livingroom.hs index cfa7264..b9ceb17 100644 --- a/src/HomeAssistant/Controller/Livingroom.hs +++ b/src/HomeAssistant/Controller/Livingroom.hs @@ -9,6 +9,7 @@ import Data.Aeson (Value) import Prelude hiding ((.)) import Control.Category ((.)) import Data.Time (LocalTime(..), toGregorian, TimeOfDay (..)) +import Data.Default (def) data Lights = LightsOn | LightsOff deriving (Show) @@ -46,7 +47,7 @@ livingroomPresenceController = proc x -> do ev <- eventLights . livingroomPresence -< x traceEvent -< ev case ev of - AFRP.Event LightsOn -> callServiceDyn (light lights) -< On Nothing + AFRP.Event LightsOn -> callServiceDyn (light lights) -< On def AFRP.Event LightsOff -> callServiceDyn (light lights) -< Off _ -> returnA -< () returnA -< () diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index c8a191c..b6fbba9 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/src/HomeAssistant/Runtime.hs @@ -43,6 +43,7 @@ import UnliftIO.Async import HomeAssistant.Runtime.Supervisor (supervised) import HomeAssistant.Controller.Hallway (hallwayLightsController) import qualified HttpServer +import Data.Foldable (forM_) step :: (MonadIO m) => FilePath -> T.Text -> UUID -> Auto m a b -> a -> m (b, Auto m a b) step path name trace st a = do @@ -128,6 +129,9 @@ dryRunHassEval ns bus = \case CallService req x -> runKatipT (busLogEnv bus) $ do callId <- liftIO $ generateCallId (busGen bus) logF (sl "traceId" (toText (requestTraceId req))) ns DebugS (ls $ show (callId, x)) + CallServices req xs -> runKatipT (busLogEnv bus) $ forM_ xs $ \x -> do + callId <- liftIO $ generateCallId (busGen bus) + logF (sl "traceId" (toText (requestTraceId req))) ns DebugS (ls $ show (callId, x)) Debug x -> runKatipT (busLogEnv bus) $ do logF () ns DebugS (ls $ show x) Trace req x -> runKatipT (busLogEnv bus) $ do diff --git a/src/HomeAssistant/Runtime/Bus.hs b/src/HomeAssistant/Runtime/Bus.hs index 74bcb61..df8450c 100644 --- a/src/HomeAssistant/Runtime/Bus.hs +++ b/src/HomeAssistant/Runtime/Bus.hs @@ -34,6 +34,7 @@ import AFRP (Request(..), Event(..)) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) import HomeAssistant.Runtime.Flags (Flags, isEnabled) +import Data.Foldable (forM_) -- | Shared runtime state: inbound is a broadcast channel (controllers -- read from 'dupTChan' copies), outbound queues service calls for the @@ -76,6 +77,10 @@ channelHassEval bus = \case logFM DebugS (ls $ show svc) enabled <- isEnabled (busFlags bus) (requestHandler req) when enabled $ liftIO $ atomically $ writeTChan (busOutbound bus) (req, svc) + CallServices req svcs -> katipAddContext (sl "traceId" (toText (requestTraceId req))) $ forM_ svcs $ \svc -> do + logFM DebugS (ls $ show svc) + enabled <- isEnabled (busFlags bus) (requestHandler req) + when enabled $ liftIO $ atomically $ writeTChan (busOutbound bus) (req, svc) Debug x -> logFM DebugS (ls $ show x) Trace req x -> katipAddContext (sl "traceId" (toText (requestTraceId req))) $ logFM InfoS (ls $ show x) diff --git a/test/BedroomSpec.hs b/test/BedroomSpec.hs index 66d0a3a..e9a9126 100644 --- a/test/BedroomSpec.hs +++ b/test/BedroomSpec.hs @@ -49,8 +49,8 @@ entitySpec = describe "entities" $ do ] it "bedroomPresenceController subscribes to the presence sensor" $ - entities bedroomPresenceController - `shouldBe` S.singleton "binary_sensor.presence_sensor_bedroom_occupancy" + S.toList (entities bedroomPresenceController) + `shouldContain` [ "binary_sensor.presence_sensor_bedroom_occupancy" ] it "humidifierController subscribes to the door sensor" $ entities humidifierController diff --git a/test/ControllerSpec.hs b/test/ControllerSpec.hs new file mode 100644 index 0000000..0abc474 --- /dev/null +++ b/test/ControllerSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module ControllerSpec where +import Test.Hspec +import Data.Default (def) +import HomeAssistant.Controller (BrightnessSettings(..), formatLightSettings, LightSettings(..)) +import Data.Aeson (object, (.=)) +import HomeAssistant.Controller () + + +spec :: Spec +spec = describe "Generic controller" $ + describe "Light settings" $ do + it "formats the default as empty" $ + formatLightSettings def `shouldBe` Nothing + it "formats the transition" $ + formatLightSettings def{lightSettingsTransition=Just 5} `shouldBe` + Just (object ["transition" .= (5 :: Int)]) + it "formats the temperature" $ + formatLightSettings def{lightSettingsTemperature=Just 5} `shouldBe` + Just (object ["color_temp_kelvin" .= (5 :: Int)]) + it "formats the brightness as percentage" $ + formatLightSettings def{lightSettingsBrightness=Just (BrightnessPercentage 100)} `shouldBe` + Just (object ["brightness_pct" .= (100 :: Int)]) + it "formats the brightness as absolute" $ + formatLightSettings def{lightSettingsBrightness=Just (Brightness 200)} `shouldBe` + Just (object ["brightness" .= (200 :: Int)]) + it "formats multiple values" $ + formatLightSettings def{lightSettingsTransition = Just 5, lightSettingsBrightness=Just (Brightness 200)} `shouldBe` + Just (object ["brightness" .= (200 :: Int), "transition" .= (5 :: Int)]) diff --git a/test/KitchenSpec.hs b/test/KitchenSpec.hs index d2d0dfa..c6e4333 100644 --- a/test/KitchenSpec.hs +++ b/test/KitchenSpec.hs @@ -10,6 +10,7 @@ import HomeAssistant.Controller import HomeAssistant.Controller.Kitchen import Support import Test.Hspec +import Data.Default (def) -- Helper functions for creating test events testDinnerLightLevel :: Int -> Event Value @@ -34,7 +35,7 @@ dinnerTableSpec = describe "dinnerTableController" $ do it "turns lights on when presence is occupied and light level is low" $ do services (runHASS dinnerTableController [testDinnerLightLevel 10, testDinnerPresence "on"]) - `shouldBe` [[switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] True], [switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] False, light [EntityId "light.kitchen_dining_large"] (On Nothing)]] + `shouldBe` [[switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] True], [switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] False, light [EntityId "light.kitchen_dining_large"] (On def)]] it "turns lights off when presence is unoccupied" $ do services (runHASS dinnerTableController [testDinnerLightLevel 10, testDinnerPresence "off"]) @@ -42,4 +43,4 @@ dinnerTableSpec = describe "dinnerTableController" $ do it "does nothing on Tick" $ do services (runHASS dinnerTableController [Tick]) - `shouldBe` [[switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] True]] \ No newline at end of file + `shouldBe` [[switch [EntityId "switch.adaptive_lighting_ruokapoydan_valot_sleep_mode"] True]] diff --git a/test/Main.hs b/test/Main.hs index d2a018a..d3e2db1 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -12,6 +12,7 @@ import qualified KitchenSpec import qualified LivingroomSpec import qualified MetricsSpec import qualified RuntimeSpec +import qualified ControllerSpec main :: IO () main = hspec $ do @@ -26,3 +27,4 @@ main = hspec $ do LivingroomSpec.spec MetricsSpec.spec RuntimeSpec.spec + ControllerSpec.spec