Initial commitHEADmaster

1 files changed, 58 insertions, 0 deletions

diff --git a/hsm-command/Hsm/Command/Readline.hs b/hsm-command/Hsm/Command/Readline.hs
new file mode 100644
index 0000000..66246b5
--- /dev/null
+++ b/hsm-command/Hsm/Command/Readline.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Command.Readline
+  ( Readline
+  , readline
+  , runReadline
+  )
+where
+
+import Data.Function ((&))
+import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, IOE, (:>))
+import Effectful.Dispatch.Static qualified as S
+import Effectful.Log (Log, getLoggerEnv, leLogger, waitForLogger)
+import Effectful.Resource (Resource, allocate)
+import System.Console.Haskeline qualified as H
+import System.Console.Haskeline.IO qualified as H
+import Prelude hiding (takeWhile)
+
+data Readline :: Effect
+
+type instance DispatchOf Readline = Static S.WithSideEffects
+
+newtype instance S.StaticRep Readline = Readline H.InputState
+
+readline
+  :: forall es
+   . ( Log :> es
+     , Readline :> es
+     )
+  => Eff es (Maybe String)
+readline = do
+  flushLogger
+  Readline handle <- S.getStaticRep
+  H.getInputLine "% "
+    & H.withInterrupt
+    & H.handleInterrupt (return Nothing)
+    & H.queryInput handle
+    & S.unsafeEff_
+ where
+  flushLogger :: Eff es ()
+  flushLogger = getLoggerEnv >>= S.unsafeEff_ . waitForLogger . leLogger
+
+runReadline
+  :: ( IOE :> es
+     , Resource :> es
+     )
+  => Eff (Readline : es) a
+  -> Eff es a
+runReadline action = do
+  handle <- snd <$> allocate state H.cancelInput
+  S.evalStaticRep (Readline handle) action
+ where
+  settings :: H.Settings IO
+  settings = H.defaultSettings {H.historyFile = Just "/tmp/hsm_command_history"}
+
+  state :: IO H.InputState
+  state = H.initializeInput settings