diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,33 +1,34 @@ # Changelog -## Version 1.0.0.0 (2025-03-28) +## Version 1.1.0.2 (2025-10-24) -* Initial release +* Widen microlens dependency version bounds -## Version 1.0.1.0 (2025-05-16) +## Version 1.1.0.1 (2025-07-15) -* Add yes/no prompts +* Fix prompt text when prompting multiple choice to give buttons actually used + +## Version 1.1.0.0 (2025-07-14) -## Version 1.0.2.0 (2025-07-11) +* **BREAKING:** Remove initialSelectionChoosableItem class function; it didn't always have a sensible implementation and isn't needed -* Add multi-select (zero-to-many) prompts +## Version 1.0.3.1 (2025-07-14) +* Add support for GHC 9.10 + ## Version 1.0.3.0 (2025-07-14) * Add multi-select (zero-to-many) prompts with arbitrary values; the multiple analogue to promptChoiceFromSet -## Version 1.0.3.1 (2025-07-14) +## Version 1.0.2.0 (2025-07-11) -* Add support for GHC 9.10 +* Add multi-select (zero-to-many) prompts -## Version 1.1.0.0 (2025-07-14) +## Version 1.0.1.0 (2025-05-16) -* **BREAKING:** Remove initialSelectionChoosableItem class function; it didn't always have a sensible implementation and isn't needed +* Add yes/no prompts -## Version 1.1.0.1 (2025-07-15) +## Version 1.0.0.0 (2025-03-28) -* Fix prompt text when prompting multiple choice to give buttons actually used - -## Version 1.1.0.2 (2025-10-24) +* Initial release -* Widen microlens dependency version bounds diff --git a/prompt-hs.cabal b/prompt-hs.cabal --- a/prompt-hs.cabal +++ b/prompt-hs.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.36.1. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: prompt-hs -version: 1.1.0.2 +version: 1.1.1.0 synopsis: A user-friendly, dependently-typed library for asking your users questions description: A library making use of the terminal package to prompt users for answers in a CLI context. . @@ -18,13 +18,11 @@ license: BSD-3-Clause build-type: Simple tested-with: - GHC == 8.10.7 - , GHC == 9.0.2 - , GHC == 9.2.8 - , GHC == 9.4.8 + GHC == 9.4.8 , GHC == 9.6.6 , GHC == 9.8.4 - , GHC == 9.10.1 + , GHC == 9.10.3 + , GHC == 9.12.3 extra-doc-files: CHANGELOG.md README.md diff --git a/src/System/Prompt.hs b/src/System/Prompt.hs --- a/src/System/Prompt.hs +++ b/src/System/Prompt.hs @@ -52,7 +52,7 @@ ) where -import Control.Monad (forM_) +import Control.Monad (forM_, when) import Control.Monad.IO.Class (MonadIO (liftIO)) import qualified Data.Char as C import Data.Kind (Type) @@ -77,7 +77,7 @@ MonadInput, MonadMarkupPrinter (Attribute, resetAttributes, setAttribute), MonadPrinter (flush, putText, putTextLn), - MonadScreen (deleteLines, moveCursorUp), + MonadScreen (deleteLines, moveCursorUp, setCursorColumn), awaitEvent, ctrlKey, runTerminalT, @@ -593,8 +593,7 @@ Either Interrupt Event -> m (PerRequirement requirement a) handlePromptChoiceEvent prompt linesRendered s e = do - moveCursorUp (linesRendered - 1) - deleteLines linesRendered + clearRenderedLines linesRendered case e of Left Interrupt -> liftIO exitFailure Right (KeyEvent key modifiers) -> case key of @@ -617,9 +616,7 @@ s & _pcsFilter %~ T.dropEnd 1 & applyFilter - & _pcsInstruction %~ \case - ChoiceInstructionNoOptionSelected -> ChoiceInstructionNormal - currentInstruction -> currentInstruction + & _pcsInstruction %~ clearNoOptionSelectedState EnterKey -> case pcsHoveredOption s of Just o -> case pcsConfirmation s of RequireConfirmation -> confirmSelection prompt o (chooseableItemText o) (goAgain s) @@ -634,7 +631,21 @@ if null (pcsFilteredOptions s) then goAgain $ s {pcsInstruction = ChoiceInstructionNoOptionSelected} else goAgain $ s & _pcsFilter %~ flip T.snoc c & applyFilter - else goAgain s + else case c of + 'U' + | modifiers == ctrlKey -> + goAgain $ + s {pcsFilter = ""} + & applyFilter + & _pcsInstruction %~ clearNoOptionSelectedState + 'W' + | modifiers == ctrlKey -> + goAgain $ + s + & _pcsFilter %~ deleteLastWord + & applyFilter + & _pcsInstruction %~ clearNoOptionSelectedState + _ -> goAgain s _ -> goAgain s _ -> goAgain s where @@ -650,8 +661,7 @@ Either Interrupt Event -> m [a] handlePromptMultipleChoiceEvent prompt linesRendered s e = do - moveCursorUp (linesRendered - 1) - deleteLines linesRendered + clearRenderedLines linesRendered case e of Left Interrupt -> liftIO exitFailure Right (KeyEvent key modifiers) -> case key of @@ -674,9 +684,7 @@ s & _pmcsFilter %~ T.dropEnd 1 & applyFilterMultiple - & _pmcsInstruction %~ \case - ChoiceInstructionNoOptionSelected -> ChoiceInstructionNormal - currentInstruction -> currentInstruction + & _pmcsInstruction %~ clearNoOptionSelectedState EnterKey -> confirmSelection prompt @@ -704,7 +712,21 @@ if null (pmcsFilteredOptions s) then goAgain $ s {pmcsInstruction = ChoiceInstructionNoOptionSelected} else goAgain $ s & _pmcsFilter %~ flip T.snoc c & applyFilterMultiple - else goAgain s + else case c of + 'U' + | modifiers == ctrlKey -> + goAgain $ + s {pmcsFilter = ""} + & applyFilterMultiple + & _pmcsInstruction %~ clearNoOptionSelectedState + 'W' + | modifiers == ctrlKey -> + goAgain $ + s + & _pmcsFilter %~ deleteLastWord + & applyFilterMultiple + & _pmcsInstruction %~ clearNoOptionSelectedState + _ -> goAgain s _ -> goAgain s _ -> goAgain s where @@ -717,7 +739,7 @@ Either Interrupt Event -> m (PerRequirement requirement Text) handlePromptTextEvent s e = do - deleteLines 1 + clearRenderedLines 1 case e of Left Interrupt -> liftIO exitFailure Right (KeyEvent key modifiers) -> case key of @@ -732,7 +754,8 @@ promptTextInternal $ s {ptsCurrentInput = ""} 'W' | modifiers == ctrlKey -> - promptTextInternal $ s & _ptsCurrentInput %~ (T.dropWhile C.isSpace . T.dropWhileEnd (not . C.isSpace)) + promptTextInternal $ + s & _ptsCurrentInput %~ deleteLastWord _ -> promptTextInternal s _ -> promptTextInternal s _ -> promptTextInternal s @@ -784,7 +807,7 @@ withAttributes [bold, foreground yellow] $ putTextLn selectionText withAttributes [italic] $ putTextLn "Press enter again to confirm, or escape to go back." e <- awaitEvent - moveCursorUp 3 *> deleteLines 4 + clearRenderedLines 4 case e of Left Interrupt -> liftIO exitFailure Right (KeyEvent EnterKey _) -> do @@ -808,7 +831,7 @@ writePromptWithResponse withAttributes [italic] $ putTextLn "Press enter again to confirm, or escape to go back." e <- awaitEvent - moveCursorUp 2 *> deleteLines 3 + clearRenderedLines 3 case e of Left Interrupt -> liftIO exitFailure Right (KeyEvent EnterKey _) -> do @@ -874,6 +897,13 @@ putErrorLn :: (MonadColorPrinter m, MonadFormattingPrinter m) => Text -> m () putErrorLn msg = withAttributes [foreground red, bold] (putTextLn msg) >> flush +-- | Clears `n` lines upwards and resets the cursor to the first column. +clearRenderedLines :: (MonadScreen m) => Int -> m () +clearRenderedLines n = do + when (n > 1) $ moveCursorUp (n - 1) + deleteLines n + setCursorColumn 0 + -- | Applies the given attributes to the terminal, runs the action, -- then resets the terminal's attributes. withAttributes :: (MonadMarkupPrinter m, Foldable t) => t (Attribute m) -> m a -> m a @@ -891,3 +921,15 @@ Just (x :| _) -> Just x Nothing -> Nothing . NE.nonEmpty + +-- | If the input instruction is `ChoiceInstructionNoOptionSelected`, set it to `ChoiceInstructionNormal`. +-- +-- Otherwise, leave it unchanged. +clearNoOptionSelectedState :: ChoiceInstruction -> ChoiceInstruction +clearNoOptionSelectedState = \case + ChoiceInstructionNoOptionSelected -> ChoiceInstructionNormal + currentInstruction -> currentInstruction + +-- | Delete the last word (vim WORD) from the text. +deleteLastWord :: Text -> Text +deleteLastWord = T.dropWhileEnd (not . C.isSpace) . T.dropWhileEnd C.isSpace