aboutsummaryrefslogtreecommitdiff
path: root/hsm-readline/Hsm/Readline.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-readline/Hsm/Readline.hs')
-rw-r--r--hsm-readline/Hsm/Readline.hs50
1 files changed, 0 insertions, 50 deletions
diff --git a/hsm-readline/Hsm/Readline.hs b/hsm-readline/Hsm/Readline.hs
deleted file mode 100644
index 8a0c232..0000000
--- a/hsm-readline/Hsm/Readline.hs
+++ /dev/null
@@ -1,50 +0,0 @@
-{-# 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