Filter setup

src/HomeAssistant/Controller/Children.hs

@@ -1,15 +1,24 @@
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DerivingVia #-}
 module HomeAssistant.Controller.Children where
-import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, LightCommand(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightAttributes (..), Brightness (..))
+import HomeAssistant.Controller (HASS, callService, light, LightCommand(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightAttributes (..), Brightness (..), entityRead, entityChangeEvent)
 import AFRP (Event (..))
 import qualified AFRP
 import Control.Arrow (Arrow(..), (>>>), returnA)
 import Data.Time (Day, TimeOfDay (..), localDay, LocalTime (..))
 import Data.Time.Calendar.OrdinalDate (WeekOfYear, mondayStartWeek)
 import Data.Functor.Contravariant (Predicate (..), (>$<))
-import Data.Aeson (Value)
+import Data.Aeson (Value, object, (.=))
 import Data.Default (Default(..))
+import Data.Serialize (Serialize)
+import Data.Serialize.Text ()
+import GHC.Generics (Generic)
+import HomeAssistant.Controller.Service (Service(..), Target(..))
+import Data.Aeson.Types (ToJSON (..))
+import Data.Aeson.Lens (key, _String)
+import Control.Lens ((^?), to)
+import Data.Text (Text)
 
 -- Let's see building some reasonable interface for utctime
 dow :: Day -> (WeekOfYear, Int)
@@ -94,3 +103,62 @@ childrenBedroomButtonController = proc x -> do
        Event (OnButton LongClick) -> callService (activateScene "scene.lasten_kirkas") -< ()
        Event (OffButton _) -> callService (light [AreaId "lasten_makuuhuone"] Off) -< ()
        _ -> returnA -< ()
+
+newtype PM25 = PM25 Float
+  deriving (Serialize, Eq, Ord) via Float
+  deriving Show
+
+data PM25Level = PM25High | PM25Low
+  deriving (Eq, Generic, Show)
+
+instance Serialize PM25Level
+
+pm25 :: HASS (Event Value) PM25
+pm25 = fmap PM25 (entityRead "sensor.children_temp_pm25" >>> AFRP.hold 0)
+
+pm25Level :: HASS PM25 PM25Level
+pm25Level = (tagHigh &&& tagLow) >>> arr (uncurry AFRP.lMerge) >>> AFRP.hold PM25Low
+  where
+    -- Band between 8 and 12 to avoid oscillation near the ~10 mark
+    tagHigh = arr (> PM25 12) >>> AFRP.edge >>> arr (AFRP.tag PM25High)
+    tagLow = arr (< PM25 8) >>> AFRP.edge >>> arr (AFRP.tag PM25Low)
+
+data HumidifierAction
+  = Idle
+  | Humidifying
+  | Other Text
+  deriving (Show, Eq, Generic)
+instance Serialize HumidifierAction
+
+-- what is the humidifer doing right now?
+humidifierEntityAction :: HASS (Event Value) (Event (Maybe HumidifierAction))
+humidifierEntityAction = entityChangeEvent "humidifier.lapset_ilmankostutin"
+  >>> arr (fmap entityAction)
+  where
+    entityAction v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "action" . _String . to humidifierAction
+    humidifierAction = \case
+      "idle" -> Idle
+      "humidifying" -> Humidifying
+      other -> Other other
+
+-- TODO: There's some other percentages elsewhere that could be replaced with this
+newtype Percentage = Percentage Int
+instance ToJSON Percentage where
+  toJSON (Percentage p) = object ["percentage" .= p]
+
+childrenAirFilterController :: HASS (Event Value) ()
+childrenAirFilterController = proc ev -> do
+  level <- pm25 >>> pm25Level >>> AFRP.changes >>> traceEvent -< ev
+  humidifier <- humidifierEntityAction >>> AFRP.hold Nothing -< ev
+  case level of
+       Event PM25High ->
+         AFRP.whenA (== Just Idle) (callService (fanOnTo (Percentage 80))) -< humidifier
+       Event PM25Low -> callService (fanOnTo (Percentage 20)) -< ()
+       _ -> returnA -< ()
+  where
+    fanOnTo percentage = Service
+      { serviceDomain = "fan"
+      , serviceName = "set_percentage"
+      , serviceTarget = [EntityId "fan.children_fan"]
+      , serviceData = Just $ toJSON percentage
+      }

src/HomeAssistant/Runtime.hs

@@ -28,7 +28,7 @@ import Data.Void (Void)
 import GHC.Stack (HasCallStack)
 import HomeAssistant.Controller (HASS, HASSEff (..))
 import HomeAssistant.Controller.Bedroom (bedroomButtonController, bedroomDrawerController, bedroomPresenceController, humidifierController)
-import HomeAssistant.Controller.Children (childrenBedroomButtonController, schoolLightController)
+import HomeAssistant.Controller.Children (childrenBedroomButtonController, schoolLightController, childrenAirFilterController)
 import HomeAssistant.Controller.Hallway (hallwayLightsController)
 import HomeAssistant.Controller.Kitchen (kitchenMotionController)
 import HomeAssistant.Controller.Livingroom (livingroomPlantLights, livingroomPresenceController)
@@ -69,7 +69,8 @@ controllers =
     Controller "livingroom-presence" livingroomPresenceController,
     Controller "hallway-motion-controller" hallwayLightsController,
     Controller "children-button" childrenBedroomButtonController,
-    Controller "livingroom-plants" livingroomPlantLights
+    Controller "livingroom-plants" livingroomPlantLights,
+    Controller "children-filter" childrenAirFilterController
   ]
 
 -- | Steps the machine for every inbound message; service calls go to the