module System.Console.ListPrompt
(
Color
, ListPromptOptions(..)
, simpleListPrompt
, Default(..)
)
where
import Control.Concurrent.STM
import Control.Monad (forM_)
import Data.Default (Default (..), def)
import Graphics.Vty (Event (..), Key (..),
Modifier (..))
import qualified Graphics.Vty as Vty
import System.Console.ANSI
import System.IO (BufferMode (..), stdin)
import System.Console.ListPrompt.Internal
import System.Console.ListPrompt.Types
simpleListPrompt :: ListPromptOptions -> Choices -> IO (Maybe String)
simpleListPrompt options choices = setup $ do
inp <- Vty.inputForConfig =<< Vty.standardIOConfig
selection <- waitForSelection (Vty._eventChannel inp) 0
setSGR []
clearScreen
setCursorPosition 0 0
Vty.shutdownInput inp
return selection
where
setup = withNoBuffering stdin NoBuffering . withNoCursor . withNoEcho
numChoices = length choices
waitForSelection ichan currentIdx = do
clearScreen
renderListOptions options def choices currentIdx
e <- atomically $ readTChan ichan
case e of
EvKey KEnter _ -> return $ Just (choices !! currentIdx)
EvKey (KChar 'n') [MCtrl] -> onDown
EvKey (KChar 'j') _ -> onDown
EvKey KDown _ -> onDown
EvKey (KChar 'p') [MCtrl] -> onUp
EvKey (KChar 'k') _ -> onUp
EvKey KUp _ -> onUp
EvKey (KChar 'q') _ -> return Nothing
EvKey KEsc _ -> return Nothing
_ -> waitForSelection ichan currentIdx
where
onDown = waitForSelection ichan ((currentIdx + 1) `rem` numChoices)
onUp = let currentIdx' = if currentIdx == 0
then length choices 1
else currentIdx 1
in waitForSelection ichan currentIdx'
renderListOptions :: ListPromptOptions
-> ListPromptDimensions
-> Choices
-> Int
-> IO ()
renderListOptions options dimensions choices currentIdx = do
clearScreen
forM_ [0..2] $ drawLine options dimensions
forM_ (zip [2..] choices) $ \(i, t) ->
drawTextLine options dimensions i t (i2 == currentIdx)
forM_ [len + 2..len + 3] $ drawLine options dimensions
where
len = length choices
drawLine :: ListPromptOptions -> ListPromptDimensions -> Int -> IO ()
drawLine options dimensions@ListPromptDimensions{..} n = do
let (_, w) = listPromptSize
drawTextLine options dimensions n (replicate w ' ') False
drawTextLine :: ListPromptOptions -> ListPromptDimensions
-> Int
-> String
-> Bool
-> IO ()
drawTextLine ListPromptOptions{..} ListPromptDimensions{..} n str selected = do
setSGR $ if selected then selectedItemSGR else normalItemSGR
let (y1, x1) = targetCoordinate
setCursorPosition (y1 + n) x1
let (_, w) = listPromptSize
putStrLn $ " " ++ str ++ replicate (w length str) ' '