diff --git a/src/HomeAssistant/Controller/Children.hs b/src/HomeAssistant/Controller/Children.hs index a4dcfd9..65767df 100644 --- a/src/HomeAssistant/Controller/Children.hs +++ b/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 + } diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs index 1e5dcfb..3355dbb 100644 --- a/src/HomeAssistant/Runtime.hs +++ b/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