Initial commitHEADmaster

1 files changed, 67 insertions, 0 deletions

diff --git a/hsm-command/Hsm/Command/Command.hs b/hsm-command/Hsm/Command/Command.hs
new file mode 100644
index 0000000..2080143
--- /dev/null
+++ b/hsm-command/Hsm/Command/Command.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Hsm.Command.Command
+  ( Direction (Forward, Backward, Left, Right)
+  , Angle (CW, CCW)
+  , Speed (Slow, Mid, Fast)
+  , Command (Move, Rotate)
+  , commandStream
+  )
+where
+
+import Data.Binary (Binary)
+import Data.Function ((&))
+import Data.Maybe (fromJust, isJust)
+import Data.Text (pack)
+import Effectful (Eff, (:>))
+import Effectful.Log (Log, logAttention_)
+import GHC.Generics (Generic)
+import Hsm.Command.Readline (Readline, readline)
+import Streamly.Data.Stream (Stream, mapMaybeM, repeatM, takeWhile)
+import Text.Read (readEither)
+import Prelude hiding (Left, Right, takeWhile)
+import Prelude qualified as P
+
+data Direction
+  = Forward
+  | Backward
+  | Left
+  | Right
+  deriving (Binary, Generic, Read, Show)
+
+data Angle
+  = CW
+  | CCW
+  deriving (Binary, Generic, Read, Show)
+
+data Speed
+  = Slow
+  | Mid
+  | Fast
+  deriving (Binary, Generic, Read, Show)
+
+data Command
+  = Move Direction Speed Int
+  | Rotate Angle Speed Int
+  deriving (Binary, Generic, Read, Show)
+
+commandStream
+  :: forall es
+   . ( Log :> es
+     , Readline :> es
+     )
+  => Stream (Eff es) Command
+commandStream =
+  repeatM readline
+    & takeWhile isJust
+    & mapMaybeM (parse . fromJust)
+ where
+  parse
+    :: Log :> es
+    => String
+    -> Eff es (Maybe Command)
+  parse string =
+    case readEither string of
+      P.Left err -> logAttention_ (pack err) >> return Nothing
+      P.Right command -> return $ Just command