39 lines
1.4 KiB
Haskell
39 lines
1.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE Arrows #-}
|
|
module HomeAssistant.Controller.Hallway where
|
|
|
|
import HomeAssistant.Controller (Presence (..), HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), Light (..))
|
|
import AFRP (Event (..))
|
|
import qualified AFRP
|
|
import Data.Aeson (Value)
|
|
import Control.Arrow ((>>>), Arrow (..), returnA)
|
|
import Data.Time (LocalTime(..), TimeOfDay (..))
|
|
|
|
|
|
|
|
hallwayPresence :: HASS (Event Value) Presence
|
|
hallwayPresence = motion "binary_sensor.hallway_movement_occupancy" >>> motionToPresence 500
|
|
|
|
data Lights = LightsOn | LightsOff
|
|
deriving (Show)
|
|
|
|
eventLights :: HASS Presence (Event Lights)
|
|
eventLights = AFRP.changes >>> arr (fmap presenceLights)
|
|
where
|
|
presenceLights Occupied = LightsOn
|
|
presenceLights Unoccupied = LightsOff
|
|
|
|
hallwayLightsController :: HASS (Event Value) ()
|
|
hallwayLightsController = proc x -> do
|
|
now <- AFRP.currentTime -< ()
|
|
p <- hallwayPresence -< x
|
|
ev <- eventLights -< p
|
|
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 LightsOff -> callServiceDyn (light [EntityId "light.hallway_lights"]) -< Off
|
|
_ -> returnA -< ()
|
|
where
|
|
lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)
|