From ebb88408c1d0884b5ca9b7d68bf76d31c33d2e5b Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Fri, 17 Jan 2025 14:37:20 -0800
Subject: Allows services to publish different topics

---
 hsm-command/Hsm/Command/Command.hs | 34 +++++++++++++++++++++++++++-------
 1 file changed, 27 insertions(+), 7 deletions(-)

(limited to 'hsm-command/Hsm/Command/Command.hs')

diff --git a/hsm-command/Hsm/Command/Command.hs b/hsm-command/Hsm/Command/Command.hs
index 53964c4..902d637 100644
--- a/hsm-command/Hsm/Command/Command.hs
+++ b/hsm-command/Hsm/Command/Command.hs
@@ -1,4 +1,8 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Hsm.Command.Command
   ( Direction(X, Z)
@@ -9,12 +13,16 @@ module Hsm.Command.Command
   ) where
 
 import Data.Binary (Binary)
+import Data.ByteString (ByteString)
 import Data.Maybe (fromJust, isJust)
-import Data.Text (pack)
+import Data.Text (Text, pack)
 import Effectful (Eff, (:>))
-import Effectful.Log (Log, logAttention_)
+import Effectful.Log (Log, logAttention_, logTrace_)
+import Effectful.Reader.Static (Reader, ask)
 import GHC.Generics (Generic)
+import GHC.Records (HasField)
 import Hsm.Command.Readline (Readline, readline)
+import Hsm.Core.Message (message)
 import Streamly.Data.Stream qualified as S
 import Text.Read (readEither)
 
@@ -39,11 +47,23 @@ data Command
   | Rotate Angle Speed Int
   deriving (Binary, Generic, Read, Show)
 
-commandStream :: (Log :> es, Readline :> es) => S.Stream (Eff es) Command
+commandStream ::
+     forall env es.
+     ( HasField "name" env Text
+     , Log :> es
+     , Reader env :> es
+     , Readline :> es
+     )
+  => S.Stream (Eff es) ByteString
 commandStream =
   S.mapMaybeM (parse . fromJust) $ S.takeWhile isJust $ S.repeatM readline
   where
-    parse string =
-      case readEither string of
-        Left err -> logAttention_ (pack err) >> return Nothing
-        Right command -> return $ Just command
+    parse string = do
+      case readEither @Command string of
+        Left err -> do
+          logAttention_ $ pack err
+          return Nothing
+        Right command -> do
+          env <- ask @env
+          logTrace_ $ "Sending command: " <> pack (show command)
+          return $ Just $ message env.name command
-- 
cgit v1.2.1