Drawer controller

src/HomeAssistant/Controller.hs

@@ -25,6 +25,7 @@ module HomeAssistant.Controller
   , Presence(..)
   , presence
   , debug
+  , switch
   ) where
 
 import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
@@ -98,6 +99,15 @@ light entityIds b = Service
   , serviceTarget=entityIds
   }
 
+-- Name conflict with AFRP
+switch :: [T.Text] -> Bool -> Service
+switch entityIds b = Service
+  { serviceDomain="switch"
+  , serviceName= bool "turn_off" "turn_on" b
+  , serviceData=Nothing
+  , serviceTarget=entityIds
+  }
+
 lightController :: HASS (Event Value) (Event DoorState)
 lightController = proc ev -> do
   doorState <- door -< ev

src/HomeAssistant/Controller/Bedroom.hs

@@ -9,6 +9,7 @@ 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)
 
 
 
@@ -98,3 +99,19 @@ bedroomButtonController = proc x -> do
        Event (Enishen DoubleClickOn) -> callService (activateScene "scene.makuuhuone_keski") -< ()
        Event (Enishen LongClickOn) -> callService (activateScene "scene.makuuhuone_kirkas") -< ()
        _ -> returnA -< ()
+
+
+
+drawer :: HASS (Event Value) (Event DoorState)
+drawer = entityBool "binary_sensor.bedroom_nightstand_drawer_sensor_masse_contact"
+  >>> arr (fmap (bool Closed Open))
+
+bedroomDrawerController :: HASS (Event Value) ()
+bedroomDrawerController = proc x -> do
+  st <- drawer -< x
+  case st of
+       Event Open -> callService (switch [entity] True) -< ()
+       Event Closed -> callService (switch [entity] False) -< ()
+       _ -> returnA -< ()
+  where
+    entity = "switch.bedroom_drawer_light_masse"

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)
-import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController)
+import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController)
 
 step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
 step nt (Mealy f) a = do
@@ -39,6 +39,7 @@ controllers :: [Controller]
 controllers =
   [ Controller "bedroom-presence" bedroomPresenceController
   , Controller "bedroom-button" bedroomButtonController
+  , Controller "bedroom-drawer" bedroomDrawerController
   ]
 
 -- | Steps the machine for every inbound message; service calls go to the