32 lines
1.3 KiB
Haskell
32 lines
1.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE Arrows #-}
|
|
module HomeAssistant.Controller.Hallway where
|
|
|
|
import HomeAssistant.Controller (Presence, HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), LightCommand (..))
|
|
import HomeAssistant.Controller.Light.Mode (LightingMode (..), lightingModeEvents)
|
|
import AFRP (Event (..))
|
|
import qualified AFRP
|
|
import Data.Aeson (Value)
|
|
import Control.Arrow ((>>>), returnA)
|
|
import Data.Time (LocalTime(..), TimeOfDay (..))
|
|
import Data.Default (def)
|
|
|
|
|
|
|
|
hallwayPresence :: HASS (Event Value) Presence
|
|
hallwayPresence = motion "binary_sensor.hallway_movement_occupancy" >>> motionToPresence 500
|
|
|
|
hallwayLightsController :: HASS (Event Value) ()
|
|
hallwayLightsController = proc x -> do
|
|
now <- AFRP.currentTime -< ()
|
|
p <- hallwayPresence -< x
|
|
ev <- lightingModeEvents -< p
|
|
traceEvent -< ev
|
|
case ev of
|
|
-- The lights entity is a "group of lights" in hass
|
|
Event LightingOn | lightsAllowed now -> callServiceDyn "Lights on" (light [EntityId "light.hallway_lights"]) -< On def
|
|
Event LightingOff -> callServiceDyn "Lights off" (light [EntityId "light.hallway_lights"]) -< Off
|
|
_ -> returnA -< ()
|
|
where
|
|
lightsAllowed (LocalTime _ tod) = not (tod > TimeOfDay 1 45 0 && tod < TimeOfDay 5 0 0)
|