Livingroom lights

src/HomeAssistant/Controller.hs

@@ -19,6 +19,8 @@ module HomeAssistant.Controller
   , light
   , Presence(..)
   , presence
+  , motion
+  , motionToPresence
   , debug
   , traceEvent
   , traceValue
@@ -28,7 +30,7 @@ module HomeAssistant.Controller
   , Light(..)
   ) where
 
-import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request)
+import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge)
 import Control.Arrow (Arrow(..), returnA)
 import Control.Category ((>>>))
 import Data.Aeson (Value, object, (.=))
@@ -40,6 +42,7 @@ import qualified Data.Text.Lens as TL
 import Data.Bool (bool)
 import Data.Serialize (Serialize)
 import GHC.Generics (Generic)
+import Data.Time (NominalDiffTime)
 
 data Target = EntityId !T.Text | AreaId !T.Text
   deriving (Show,Eq,Ord)
@@ -93,10 +96,35 @@ data Presence = Occupied | Unoccupied
 instance Serialize Presence
 
 presence :: T.Text -> HASS (Event Value) (Event Presence)
-presence entityId =entityBool entityId
+presence entityId = entityBool entityId
   >>> arr (fmap (bool Unoccupied Occupied))
 
 
+data Motion = MotionDetected | MotionNotDetected | MotionUnknown
+  deriving (Show, Eq, Generic)
+
+
+motion :: T.Text -> HASS (Event Value) Motion
+motion entityId = entityBool entityId
+  >>> arr (fmap (bool MotionNotDetected MotionDetected))
+  >>> hold MotionUnknown
+
+
+-- Convert a motion status into a simulated presence
+--
+-- A motion tracker detects _motion_, but if you are still, it can't detect you.
+-- A simple and cheap heuristic is to assume the person is a bit longer there
+motionToPresence :: NominalDiffTime -> HASS Motion Presence
+motionToPresence delay = (eventOccupied &&& eventUnoccupied)
+  >>> arr (uncurry lMerge)
+  >>> AFRP.hold Unoccupied
+  where
+    eventOccupied :: HASS Motion (Event Presence)
+    eventOccupied = arr (== MotionDetected) >>> edge >>> arr (fmap (const Occupied))
+    eventUnoccupied :: HASS Motion (Event Presence)
+    eventUnoccupied = arr (== MotionNotDetected) >>> waitFor delay >>> arr (tag Unoccupied)
+
+instance Serialize Motion
 
 data Light
   = Off