diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs index e5f6ee1..7daf4f4 100644 --- a/src/HomeAssistant/Controller.hs +++ b/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 diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs index f38bc66..f9bbb03 100644 --- a/src/HomeAssistant/Controller/Bedroom.hs +++ b/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" diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index 8779381..7dbbe59 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/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