Try a separate holdKnown primitive
This commit is contained in:
1 parent
8a4a5aef33
commit
55855db55b
2 files changed
+10
-3
No files matched your search
@@ -8,6 +8,7 @@ module AFRP
|
|||||||
, withEntities
|
, withEntities
|
||||||
, Event(..)
|
, Event(..)
|
||||||
, hold
|
, hold
|
||||||
|
, holdKnown
|
||||||
, events
|
, events
|
||||||
-- , switch
|
-- , switch
|
||||||
, preMapAccum
|
, preMapAccum
|
||||||
@@ -326,6 +327,11 @@ hold def = mapAccum step def id
|
|||||||
Tick -> prev
|
Tick -> prev
|
||||||
Event new -> new
|
Event new -> new
|
||||||
|
|
||||||
|
|
||||||
|
-- A variant of 'hold' which makes it explicit whether we have a previous value
|
||||||
|
holdKnown :: (Serialize a, Eq a) => Mealy m (Event a) (Maybe a)
|
||||||
|
holdKnown = arr (fmap Just) >>> hold Nothing
|
||||||
|
|
||||||
snapshot :: (Serialize a, Eq a) => a -> Mealy m (Event (), a) a
|
snapshot :: (Serialize a, Eq a) => a -> Mealy m (Event (), a) a
|
||||||
snapshot def = mapAccum step def id
|
snapshot def = mapAccum step def id
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -19,6 +19,7 @@ import Data.Aeson.Types (ToJSON (..))
|
|||||||
import Data.Aeson.Lens (key, _String)
|
import Data.Aeson.Lens (key, _String)
|
||||||
import Control.Lens ((^?), to)
|
import Control.Lens ((^?), to)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Control.Monad (join)
|
||||||
|
|
||||||
-- Let's see building some reasonable interface for utctime
|
-- Let's see building some reasonable interface for utctime
|
||||||
dow :: Day -> (WeekOfYear, Int)
|
dow :: Day -> (WeekOfYear, Int)
|
||||||
@@ -131,8 +132,8 @@ data HumidifierAction
|
|||||||
instance Serialize HumidifierAction
|
instance Serialize HumidifierAction
|
||||||
|
|
||||||
-- what is the humidifer doing right now?
|
-- what is the humidifer doing right now?
|
||||||
humidifierEntityAction :: HASS (Event Value) (Event (Maybe HumidifierAction))
|
humidifierOperatingState :: HASS (Event Value) (Event (Maybe HumidifierAction))
|
||||||
humidifierEntityAction = entityChangeEvent "humidifier.lapset_ilmankostutin"
|
humidifierOperatingState = entityChangeEvent "humidifier.lapset_ilmankostutin"
|
||||||
>>> arr (fmap entityAction)
|
>>> arr (fmap entityAction)
|
||||||
where
|
where
|
||||||
entityAction v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "action" . _String . to humidifierAction
|
entityAction v = v ^? key "event" . key "variables" . key "trigger" . key "to_state" . key "attributes" . key "action" . _String . to humidifierAction
|
||||||
@@ -149,7 +150,7 @@ instance ToJSON Percentage where
|
|||||||
childrenAirFilterController :: HASS (Event Value) ()
|
childrenAirFilterController :: HASS (Event Value) ()
|
||||||
childrenAirFilterController = proc ev -> do
|
childrenAirFilterController = proc ev -> do
|
||||||
level <- pm25 >>> pm25Level >>> AFRP.changes >>> traceEvent -< ev
|
level <- pm25 >>> pm25Level >>> AFRP.changes >>> traceEvent -< ev
|
||||||
humidifier <- humidifierEntityAction >>> AFRP.hold Nothing -< ev
|
humidifier <- humidifierOperatingState >>> AFRP.holdKnown >>> arr join -< ev
|
||||||
case level of
|
case level of
|
||||||
Event PM25High ->
|
Event PM25High ->
|
||||||
AFRP.whenA (== Just Idle) (callService (fanOnTo (Percentage 80))) -< humidifier
|
AFRP.whenA (== Just Idle) (callService (fanOnTo (Percentage 80))) -< humidifier
|
||||||
|
|||||||
Reference in new issue
Block a user