Tracing

src/HomeAssistant/Runtime.hs

@@ -13,7 +13,7 @@ module HomeAssistant.Runtime
   , runController
   ) where
 
-import AFRP (Event (..), Mealy (..))
+import AFRP (Event (..), Mealy (..), Request (..))
 import Control.Concurrent.Async (async, waitAny)
 import Control.Concurrent.STM (atomically, dupTChan, readTChan)
 import Data.Aeson (Value)
@@ -27,11 +27,13 @@ import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
 import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController)
+import Data.UUID (UUID)
+import qualified Data.UUID.V4 as UUID.V4
 
-step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
-step nt (Mealy f) a = do
+step :: (forall x. eff x -> IO x) -> UUID -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
+step nt trace (Mealy f) a = do
   now <- getCurrentTime
-  f nt now a
+  f nt (Request now trace) a
 
 data Controller = forall b. Controller T.Text (HASS (Event Value) b)
 
@@ -52,8 +54,9 @@ runController bus (Controller _name machine) = do
   where
     go inbound f = do
       msg <- atomically (readTChan inbound)
+      uuid <- UUID.V4.nextRandom
       -- (_, f') <- step (channelHassEval bus) f (Event msg)
-      (_, f') <- step (dryRunHassEval (busGen bus)) f (Event msg)
+      (_, f') <- step (dryRunHassEval (busGen bus)) uuid f (Event msg)
       go inbound f'
 
 defaultMain :: IO ()
@@ -74,3 +77,4 @@ dryRunHassEval gen = \case
     callId <- generateCallId gen
     print (callId, x)
   Debug x -> print x
+  Trace req x -> print (req, x)