Allows services to publish different topicsHEADmaster

1 files changed, 27 insertions, 7 deletions

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