aboutsummaryrefslogtreecommitdiff
path: root/hsm-readline
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-readline')
-rw-r--r--hsm-readline/Hsm/Readline.hs50
-rw-r--r--hsm-readline/hsm-readline.cabal18
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