Merge pull request 'Plant lights' (#3) from plant-light into main

Reviewed-on: #3

src/HomeAssistant/Controller/Livingroom.hs

@@ -2,12 +2,13 @@
 {-# LANGUAGE Arrows #-}
 module HomeAssistant.Controller.Livingroom where
 
-import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, Light (..), traceEvent)
+import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, Light (..), traceEvent, callService, activateScene)
 import qualified AFRP
 import Control.Arrow ((>>>), Arrow (..), returnA)
 import Data.Aeson (Value)
 import Prelude hiding ((.))
 import Control.Category ((.))
+import Data.Time (LocalTime(..), toGregorian, TimeOfDay (..))
 
 data Lights = LightsOn | LightsOff
   deriving (Show)
@@ -49,3 +50,51 @@ livingroomPresenceController = proc x -> do
        AFRP.Event LightsOff -> callServiceDyn (light lights) -< Off
        _ -> returnA -< ()
   returnA -< ()
+
+data Season = Summer | Fall | Winter | Spring
+            deriving Show
+
+
+season :: HASS a Season
+season = AFRP.currentTime >>> arr toSeason
+  where
+    toSeason t =
+      case toGregorian (localDay t) of
+         (_, m, _)
+            | m >= 12 || m <= 2 -> Winter
+            | m <= 5             -> Spring
+            | m <= 8             -> Summer
+            | otherwise          -> Fall
+
+tod :: HASS a TimeOfDay
+tod = AFRP.currentTime >>> arr localTimeOfDay
+
+data PlantLightMode = Growth | Ambience
+                    deriving Show
+
+plantLightMode :: HASS (Season, TimeOfDay) (AFRP.Event PlantLightMode)
+plantLightMode =
+  (lightMode &&& ambienceMode) >>> arr (uncurry AFRP.lMerge)
+  where
+    lightMode = arr (uncurry lightWanted) >>> AFRP.edge >>> arr (AFRP.tag Growth)
+    ambienceMode = arr (uncurry ambienceWanted) >>> AFRP.edge >>> arr (AFRP.tag Ambience)
+    -- Full brightness during daytime only non-summer
+    lightWanted :: Season -> TimeOfDay -> Bool
+    lightWanted Summer _ = False
+    lightWanted _ TimeOfDay{todHour=10,todMin=00} = True
+    lightWanted _ _ = False
+    -- Ambience mode is always
+    ambienceWanted :: Season -> TimeOfDay -> Bool
+    ambienceWanted _ TimeOfDay{todHour=20,todMin=0} = True
+    ambienceWanted _ _ = False
+
+livingroomPlantLights :: HASS (AFRP.Event a) ()
+livingroomPlantLights = (season &&& tod)
+  >>> plantLightMode
+  >>> setLights
+  where
+    setLights = proc mode -> do
+      case mode of
+           AFRP.Event Growth -> callService (activateScene "scene.olohuoneen_kasvivalo") -< ()
+           AFRP.Event Ambience -> callService (activateScene "scene.makuuhuone_lepotila") -< ()
+           _ -> returnA -< ()

src/HomeAssistant/Runtime.hs

@@ -36,7 +36,7 @@ import qualified HomeAssistant.Runtime.Metrics
 import System.FilePath ((</>))
 import Text.Read (readMaybe)
 import HomeAssistant.Controller.Kitchen (kitchenMotionController)
-import HomeAssistant.Controller.Livingroom (livingroomPresenceController)
+import HomeAssistant.Controller.Livingroom (livingroomPresenceController, livingroomPlantLights)
 import HomeAssistant.Runtime.RateLimit (slidingWindowLimiter, registerRateLimitMetrics)
 import UnliftIO.Async
 import HomeAssistant.Runtime.Supervisor (supervised)
@@ -63,6 +63,7 @@ controllers =
   , Controller True "livingroom-presence" livingroomPresenceController
   , Controller True "hallway-motion-controller" hallwayLightsController
   , Controller True "children-button" childrenBedroomButtonController
+  , Controller True "livingroom-plants" livingroomPlantLights
   ]
 
 -- | Steps the machine for every inbound message; service calls go to the