diff options
Diffstat (limited to 'hsm-readline/Hsm/Readline.hs')
-rw-r--r-- | hsm-readline/Hsm/Readline.hs | 50 |
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 |