aboutsummaryrefslogtreecommitdiff
path: root/hsm-command/Hsm
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-command/Hsm')
-rw-r--r--hsm-command/Hsm/Command/Command.hs49
-rw-r--r--hsm-command/Hsm/Command/Readline.hs40
2 files changed, 0 insertions, 89 deletions
diff --git a/hsm-command/Hsm/Command/Command.hs b/hsm-command/Hsm/Command/Command.hs
deleted file mode 100644
index 53964c4..0000000
--- a/hsm-command/Hsm/Command/Command.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
-module Hsm.Command.Command
- ( Direction(X, Z)
- , Angle(CW, CCW)
- , Speed(Slow, Mid, Fast)
- , Command(Move, Rotate)
- , commandStream
- ) where
-
-import Data.Binary (Binary)
-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 qualified as S
-import Text.Read (readEither)
-
-data Direction
- = X
- | Z
- 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 :: (Log :> es, Readline :> es) => S.Stream (Eff es) Command
-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
diff --git a/hsm-command/Hsm/Command/Readline.hs b/hsm-command/Hsm/Command/Readline.hs
deleted file mode 100644
index 1caa562..0000000
--- a/hsm-command/Hsm/Command/Readline.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Hsm.Command.Readline
- ( Readline
- , readline
- , runReadline
- ) where
-
-import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>))
-import Effectful.Dispatch.Static qualified as S
-import Effectful.Log (Log)
-import Effectful.Resource (Resource, allocate)
-import Hsm.Core.Log (flushLogger)
-import System.Console.Haskeline qualified as H
-import System.Console.Haskeline.IO qualified as H
-
-data Readline a b
-
-type instance DispatchOf Readline = Static S.WithSideEffects
-
-newtype instance S.StaticRep Readline =
- Readline H.InputState
-
-readline :: (Log :> es, Readline :> es) => Eff es (Maybe String)
-readline = do
- flushLogger
- Readline hdl <- S.getStaticRep
- S.unsafeEff_
- $ H.queryInput hdl
- $ H.handleInterrupt (return Nothing)
- $ H.withInterrupt
- $ H.getInputLine "% "
-
-runReadline :: (IOE :> es, Resource :> es) => Eff (Readline : es) a -> Eff es a
-runReadline action = do
- handle <- snd <$> allocate (H.initializeInput settings) H.cancelInput
- S.evalStaticRep (Readline handle) action
- where
- settings = H.defaultSettings {H.historyFile = Just ".hsm_command_history"}