blob: 8a0c2324c1b902792adc618ec5b469812e1a113d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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
|
