HUmidifier logic with some extra new primitives

src/HomeAssistant/Controller.hs

@@ -19,13 +19,12 @@ module HomeAssistant.Controller
   , ruuviTemperatures
   , ruuviPressures
   , DoorState(..)
-  , door
   , light
-  , lightController
   , Presence(..)
   , presence
   , debug
   , traceEvent
+  , traceValue
   , switch
   , Target(..)
   ) where
@@ -71,6 +70,11 @@ traceEvent = Mealy $ \nt req -> \case
   Event a -> nt (Trace req a) >>= \() -> pure (Event a, traceEvent)
   Tick -> pure (Tick, traceEvent)
 
+traceValue :: Show a => HASS a a
+traceValue = proc x -> do
+  eff Trace -< x
+  returnA -< x
+
 ruuviTemperatures :: Mealy eff (Event Value) Double
 ruuviTemperatures = entityRead @Double "sensor.ruuvitag_b168_temperature" >>> hold 0
 
@@ -95,11 +99,6 @@ presence entityId =entityBool entityId
 
 
 
-door :: HASS (Event Value) (Event DoorState)
-door = entityBool "binary_sensor.makuuhuone_ovi_contact"
-  >>> arr (fmap (bool Closed Open))
-  >>> hold Open
-  >>> changes
 
 -- Turn off lights when door is closed
 light :: [Target] -> Bool -> Service
@@ -119,14 +118,6 @@ switch targets b = Service
   , serviceTarget=targets
   }
 
-lightController :: HASS (Event Value) (Event DoorState)
-lightController = proc ev -> do
-  doorState <- door -< ev
-  case doorState of
-       Event Open -> callService (light [EntityId "light.bedroom_masse"] False) -< ()
-       Event Closed -> callService (light [EntityId "light.bedroom_masse"] True) -< ()
-       _ -> returnA -< ()
-  returnA -< doorState
 
 entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value)
 entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent

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"]
+      }

src/HomeAssistant/Runtime.hs

@@ -26,7 +26,7 @@ import HomeAssistant.Runtime.Connection (readerAction, writerAction)
 import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv, lookupEnv)
-import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController)
+import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController, humidifierController)
 import Data.UUID (UUID, toText)
 import qualified Data.UUID.V4 as UUID.V4
 import Katip (runKatipT, logF, sl, Severity (..), ls, Namespace (Namespace), runKatipContextT)
@@ -45,6 +45,7 @@ controllers =
   [ Controller "bedroom-presence" bedroomPresenceController False
   , Controller "bedroom-button" bedroomButtonController False -- This works but leaving for vacation
   , Controller "bedroom-drawer" bedroomDrawerController True
+  , Controller "bedroom-humidifier" humidifierController True
   ]
 
 -- | Steps the machine for every inbound message; service calls go to the