Control the kitchen lights

src/HomeAssistant/Controller/Kitchen.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Arrows #-}
+module HomeAssistant.Controller.Kitchen where
+import HomeAssistant.Controller
+import AFRP (Event (..))
+import qualified AFRP
+import Data.Aeson (Value)
+import Control.Arrow ((>>>), Arrow (..), returnA)
+import Data.Bool (bool)
+import GHC.Generics (Generic)
+import Data.Serialize (Serialize)
+import Prelude hiding (id)
+import Data.Time (LocalTime(..), TimeOfDay (..))
+
+
+-- Kitchen has two "presence" sensors. One IKEA motion sensor and one SwitchBot presence sensor
+data Motion = MotionDetected | MotionNotDetected | MotionUnknown
+  deriving (Show, Eq, Generic)
+
+instance Serialize Motion
+
+data Lights = LightsOn | LightsOff
+  deriving (Show)
+
+kitchenMotion :: HASS (Event Value) Motion
+kitchenMotion = entityBool "binary_sensor.kitchen_movement_occupancy"
+  >>> arr (fmap (bool MotionNotDetected MotionDetected))
+  >>> traceEvent
+  >>> AFRP.hold MotionUnknown
+
+
+kitchenPresence :: HASS Motion Presence
+kitchenPresence = (eventOccupied &&& eventUnoccupied)
+  >>> arr (uncurry AFRP.lMerge) >>> traceEvent
+  >>> AFRP.hold Unoccupied
+  where
+    eventOccupied :: HASS Motion (Event Presence)
+    eventOccupied = arr (== MotionDetected) >>> AFRP.edge >>> arr (fmap (const Occupied))
+    eventUnoccupied :: HASS Motion (Event Presence)
+    eventUnoccupied = arr (== MotionNotDetected) >>> AFRP.waitFor 300 >>> arr (AFRP.tag Unoccupied)
+
+eventLights :: HASS Presence (Event Lights)
+eventLights = AFRP.changes >>> arr (fmap presenceLights)
+  where
+    presenceLights Occupied = LightsOn
+    presenceLights Unoccupied = LightsOff
+
+kitchenMotionController :: HASS (Event Value) ()
+kitchenMotionController = proc x -> do
+  now <- AFRP.currentTime -< ()
+  p <- kitchenMotion >>> kitchenPresence -< x
+  ev <- eventLights -< p
+  traceEvent -< ev
+  case ev of
+       Event LightsOn | lightsAllowed now -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< On Nothing
+       Event LightsOff -> callServiceDyn (light [EntityId "light.kitchen_ceiling"]) -< Off
+       _ -> returnA -< ()
+  where
+    lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)