summaryrefslogtreecommitdiff
path: root/src/Output.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Output.hs')
-rw-r--r--src/Output.hs19
1 files changed, 13 insertions, 6 deletions
diff --git a/src/Output.hs b/src/Output.hs
index 412e7b4..8c913b2 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -6,6 +6,7 @@ module Output (
startOutput,
outLine,
outPromptGetLine,
+ outPromptGetLineCompletion,
) where
import Control.Concurrent.MVar
@@ -18,6 +19,7 @@ import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TL
import System.Console.Haskeline
+import System.Console.Haskeline.History
data Output = Output
{ outState :: MVar OutputState
@@ -29,8 +31,8 @@ data OutputConfig = OutputConfig
}
data OutputState = OutputState
- { outCurPrompt :: Maybe Text
- , outPrint :: TL.Text -> IO ()
+ { outPrint :: TL.Text -> IO ()
+ , outHistory :: History
}
data OutputType = OutputChildStdout
@@ -51,7 +53,7 @@ instance MonadIO m => MonadOutput (ReaderT Output m) where
startOutput :: Bool -> IO Output
startOutput verbose = Output
- <$> newMVar OutputState { outCurPrompt = Nothing, outPrint = TL.putStrLn }
+ <$> newMVar OutputState { outPrint = TL.putStrLn, outHistory = emptyHistory }
<*> pure OutputConfig { outVerbose = verbose }
outColor :: OutputType -> Text
@@ -104,13 +106,18 @@ outLine otype prompt line = ioWithOutput $ \out ->
]
outPromptGetLine :: MonadOutput m => Text -> m (Maybe Text)
-outPromptGetLine prompt = ioWithOutput $ \out -> do
+outPromptGetLine = outPromptGetLineCompletion noCompletion
+
+outPromptGetLineCompletion :: MonadOutput m => CompletionFunc IO -> Text -> m (Maybe Text)
+outPromptGetLineCompletion compl prompt = ioWithOutput $ \out -> do
st <- takeMVar (outState out)
- (x, st') <- runInputT defaultSettings $ do
+ (x, st') <- runInputT (setComplete compl defaultSettings) $ do
p <- getExternalPrint
+ putHistory $ outHistory st
liftIO $ putMVar (outState out) st { outPrint = p . TL.unpack . (<>"\n") }
x <- getInputLine $ T.unpack prompt
st' <- liftIO $ takeMVar (outState out)
- return (x, st' { outPrint = outPrint st })
+ hist' <- getHistory
+ return (x, st' { outPrint = outPrint st, outHistory = hist' })
putMVar (outState out) st'
return $ fmap T.pack x