InitialHEADmaster

2 files changed, 68 insertions, 0 deletions

diff --git a/hsm-readline/Hsm/Readline.hs b/hsm-readline/Hsm/Readline.hs
new file mode 100644
index 0000000..8a0c232
--- /dev/null
+++ b/hsm-readline/Hsm/Readline.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hsm.Readline
+  ( readline
+  , allocateReadline
+  ) where
+
+import Control.IO.Region (Region, alloc_)
+import Data.Text (Text, pack)
+import Data.Typeable (Proxy(Proxy), Typeable, typeRep)
+import Hsm.Log qualified as L
+import System.Console.Haskeline qualified as H
+import System.Console.Haskeline.IO qualified as H
+import Text.Read (readEither)
+
+logMsg :: Text -> IO ()
+logMsg = L.logMsg ["readline"]
+
+readline ::
+     forall a. (Read a, Show a, Typeable a)
+  => H.InputState
+  -> IO (Maybe a)
+readline handle = do
+  logMsg $ "Expecting value of type " <> pack (show $ typeRep $ Proxy @a)
+  valueMaybe <- queryInput
+  maybe (return Nothing) parseValueStr valueMaybe
+  where
+    queryInput =
+      H.queryInput handle
+        $ H.handleInterrupt (return Nothing)
+        $ H.withInterrupt
+        $ H.getInputLine "% "
+    parseValueStr valueStr =
+      case readEither @a valueStr of
+        Right commandValue -> do
+          logMsg $ "Parsed value " <> pack (show commandValue)
+          return $ Just commandValue
+        Left err -> do
+          logMsg $ pack err
+          readline handle
+
+allocateReadline :: Region -> IO H.InputState
+allocateReadline region = alloc_ region initializeInput cancelInput
+  where
+    initializeInput = do
+      logMsg "Initializing input with default settings"
+      H.initializeInput H.defaultSettings
+    cancelInput handle = do
+      logMsg "Cancelling input"
+      H.cancelInput handle
diff --git a/hsm-readline/hsm-readline.cabal b/hsm-readline/hsm-readline.cabal
new file mode 100644
index 0000000..4532219
--- /dev/null
+++ b/hsm-readline/hsm-readline.cabal
@@ -0,0 +1,18 @@
+cabal-version: 3.4
+author:        Paul Oliver
+build-type:    Simple
+maintainer:    contact@pauloliver.dev
+name:          hsm-readline
+version:       0.1.0.0
+
+library
+  build-depends:
+    , base
+    , haskeline
+    , hsm-log
+    , io-region
+    , text
+
+  exposed-modules:  Hsm.Readline
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2021