HUmidifier logic with some extra new primitives

src/HomeAssistant/Controller/Bedroom.hs

@@ -4,12 +4,14 @@ module HomeAssistant.Controller.Bedroom where
 
 import HomeAssistant.Controller
 import qualified Data.Text as T
-import AFRP (Event (..), (>>|), toEvent, lMerge)
+import AFRP (Event (..), (>>|), toEvent, lMerge, duration, edge)
 import Data.Aeson (Value, object, (.=))
 import Control.Arrow ((>>>), returnA, arr, Arrow (..))
 import Control.Lens ((^?), to, traversed)
 import Data.Aeson.Lens (key, _String)
 import Data.Bool (bool)
+import Data.Time (NominalDiffTime)
+import qualified AFRP
 
 
 
@@ -121,3 +123,33 @@ bedroomDrawerController = proc x -> do
        _ -> returnA -< ()
   where
     entity = EntityId "switch.bedroom_drawer_light_masse"
+
+door :: HASS (Event Value) (Event DoorState)
+door = entityBool "binary_sensor.makuuhuone_ovi_contact"
+  >>> arr (fmap (bool Closed Open))
+
+waitFor :: NominalDiffTime -> HASS a (Event ())
+waitFor n = duration >>> arr (> n) >>> edge
+
+delayedDoor :: HASS (Event Value) (Event DoorState)
+delayedDoor = door
+  >>> (AFRP.hold Open &&& AFRP.delayEvent 15)
+  >>> AFRP.sample
+  >>> traceEvent
+
+humidifierController :: HASS (Event Value) ()
+humidifierController = proc x -> do
+  st <- delayedDoor -< x
+  case st of
+       -- Turn the humidifier on when the door is closed
+       -- the humidifier is low-powered, no point in losing all the humidity
+       Event Open -> callService (humidifier False) -< ()
+       Event Closed -> callService (humidifier True) -< ()
+       _ -> returnA -< ()
+  where
+    humidifier state = Service
+      { serviceDomain="humidifier"
+      , serviceName= bool "turn_off" "turn_on" state
+      , serviceData= Nothing
+      , serviceTarget= [EntityId "humidifier.makuuhuone_ilmankostutin"]
+      }