Code organization

src/HomeAssistant/Controller/Bedroom.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE OverloadedStrings #-}
+module HomeAssistant.Controller.Bedroom where
+
+import HomeAssistant.Controller
+import qualified Data.Text as T
+import AFRP (Event (..))
+import Data.Aeson (Value, object, (.=))
+import Control.Arrow ((>>>), returnA)
+
+
+
+bedroomLights :: [T.Text]
+bedroomLights = ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"]
+
+createBedroomScene :: Service
+createBedroomScene = Service
+  { serviceDomain="scene"
+  , serviceName= "create"
+  , serviceData= Just $ object
+      [ "scene_id" .= ("makuuhuone_lights_snapshot" :: T.Text)
+      , "snapshot_entities" .= bedroomLights
+      ]
+  , serviceTarget= []
+  }
+
+
+activateScene :: T.Text -> Service
+activateScene sceneId = Service
+  { serviceDomain="scene"
+  , serviceName= "turn_on"
+  , serviceTarget= [sceneId]
+  , serviceData = Nothing
+  }
+
+-- Bedroom presence
+bedroomPresence :: HASS (Event Value) (Event Presence)
+bedroomPresence = presence "binary_sensor.presence_sensor_bedroom_occupancy"
+
+bedroomPresenceController :: HASS (Event Value) ()
+bedroomPresenceController = proc x -> do
+  p <- bedroomPresence -< x
+  case p of
+       Event Unoccupied -> callService createBedroomScene >>> callService (light bedroomLights False) -< ()
+       Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
+       _ -> returnA -< ()
+