Allows services to publish different topicsHEADmaster

3 files changed, 30 insertions, 8 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
diff --git a/hsm-command/Main.hs b/hsm-command/Main.hs
index efcbc6e..d135e53 100644
--- a/hsm-command/Main.hs
+++ b/hsm-command/Main.hs
@@ -26,7 +26,7 @@ $(deriveFromYaml ''Env)
 main :: IO ()
 main =
   launch @Env "command" id $ \env logger level ->
-    (commandStream & send @Env)
+    (commandStream @Env & send)
       & runServer @Env
       & runLog env.name logger level
       & runReader env
diff --git a/hsm-command/hsm-command.cabal b/hsm-command/hsm-command.cabal
index 836bf07..ae83574 100644
--- a/hsm-command/hsm-command.cabal
+++ b/hsm-command/hsm-command.cabal
@@ -9,6 +9,7 @@ library
   build-depends:
     , base
     , binary
+    , bytestring
     , effectful-core
     , haskeline
     , hsm-core
@@ -28,6 +29,7 @@ executable command
   build-depends:
     , base
     , binary
+    , bytestring
     , effectful-core
     , haskeline
     , hsm-core