Unify per-room Lights enums into shared LightingMode

src/HomeAssistant/Controller/Kitchen.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE Arrows #-}
 module HomeAssistant.Controller.Kitchen where
 import HomeAssistant.Controller
+import HomeAssistant.Controller.Light.Mode (LightingMode (..), lightingModeEvents)
 import AFRP (Event (..))
 import qualified AFRP
 import Data.Aeson (Value)
@@ -13,27 +14,18 @@ import Data.Default (def)
 
 -- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor
 
-data Lights = LightsOn | LightsOff | LightsSleep
-  deriving (Show)
-
 kitchenPresence :: HASS (Event Value) Presence
 kitchenPresence = motion "binary_sensor.kitchen_movement_occupancy" >>> motionToPresence 500
 
-eventLights :: HASS Presence (Event Lights)
-eventLights = AFRP.changes >>> arr (fmap presenceLights)
-  where
-    presenceLights Occupied = LightsOn
-    presenceLights Unoccupied = LightsOff
-
 kitchenCeilingController :: HASS (Event Value) ()
 kitchenCeilingController = proc x -> do
   now <- AFRP.currentTime -< ()
   p <- kitchenPresence -< x
-  ev <- eventLights -< p
+  ev <- lightingModeEvents -< p
   traceEvent -< ev
   case ev of
-       Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On def
-       Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off
+       Event LightingOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On def
+       Event LightingOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off
        _ -> returnA -< ()
   where
     lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)
@@ -45,7 +37,7 @@ dinnerLightLevel = entityRead "sensor.sijainti_keittio_light_level" >>> AFRP.hol
 dinnerPresence :: HASS (Event Value) Presence
 dinnerPresence = presence "binary_sensor.sijainti_keittio_occupancy" >>> AFRP.hold Unoccupied
 
-dinnerLightEvents :: HASS (Event Value) (Event Lights)
+dinnerLightEvents :: HASS (Event Value) (Event LightingMode)
 dinnerLightEvents =
   ((,) <$> dinnerLightLevel <*> dinnerPresence)
   >>> arr lightWanted
@@ -56,29 +48,29 @@ dinnerLightEvents =
 
     onEvent =
       AFRP.edge
-      >>> arr (fmap (const LightsOn))
+      >>> arr (fmap (const LightingOn))
 
     sleepEvent =
       arr not
       >>> AFRP.edge
-      >>> arr (fmap (const LightsSleep))
+      >>> arr (fmap (const LightingSleep))
 
     offEvent =
       arr not
       >>> AFRP.waitFor 300
-      >>> arr (fmap (const LightsOff))
+      >>> arr (fmap (const LightingOff))
 
 dinnerTableController :: HASS (Event Value) ()
 dinnerTableController = proc x -> do
   ev <- dinnerLightEvents -< x
   case ev of
-       Event LightsOn -> do
+       Event LightingOn -> do
          sleep -< False
          callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< On def
-       Event LightsOff -> do
+       Event LightingOff -> do
          sleep -< False
          callServiceDyn (light [EntityId "light.kitchen_dining_large"]) -< Off
-       Event LightsSleep -> do
+       Event LightingSleep -> do
          sleep -< True
        _ -> returnA -< ()
   where