diff options
Diffstat (limited to 'hsm-command/Hsm/Command')
-rw-r--r-- | hsm-command/Hsm/Command/Command.hs | 49 | ||||
-rw-r--r-- | hsm-command/Hsm/Command/Readline.hs | 40 |
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"} |