implemented selectPrompt
This commit is contained in:
parent
faa214bf6d
commit
1e78ca6f40
|
@ -27,6 +27,7 @@ module Mtlstats.Prompt (
|
|||
promptHandler,
|
||||
strPrompt,
|
||||
numPrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
gameYearPrompt,
|
||||
gameDayPrompt,
|
||||
|
@ -48,6 +49,7 @@ module Mtlstats.Prompt (
|
|||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (isDigit, toUpper)
|
||||
import Data.Foldable (forM_)
|
||||
|
@ -112,6 +114,43 @@ numPrompt pStr act = Prompt
|
|||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Builds a selection prompt
|
||||
selectPrompt :: SelectParams a -> Prompt
|
||||
selectPrompt params = Prompt
|
||||
{ promptDrawer = \s -> do
|
||||
let sStr = s^.inputBuffer
|
||||
C.drawString $ spPrompt params ++ sStr
|
||||
(row, col) <- C.cursorPosition
|
||||
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
|
||||
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
||||
C.drawString $ unlines $ map
|
||||
(\(n, (_, x)) -> let
|
||||
desc = spElemDesc params x
|
||||
in "F" ++ show n ++ ") " ++ desc)
|
||||
results
|
||||
C.moveCursor row col
|
||||
, promptCharCheck = const True
|
||||
, promptAction = \sStr -> if null sStr
|
||||
then spCallback params Nothing
|
||||
else do
|
||||
db <- gets (^.database)
|
||||
case spSearchExact params sStr db of
|
||||
Nothing -> spNotFound params sStr
|
||||
Just n -> spCallback params $ Just n
|
||||
, promptSpecialKey = \case
|
||||
C.KeyFunction rawK -> do
|
||||
sStr <- gets (^.inputBuffer)
|
||||
db <- gets (^.database)
|
||||
let
|
||||
n = pred $ fromInteger rawK
|
||||
results = spSearch params sStr db
|
||||
when (n < maxFunKeys) $
|
||||
whenJust (nth n results) $ \(n, _) -> do
|
||||
modify $ inputBuffer .~ ""
|
||||
spCallback params $ Just n
|
||||
_ -> return ()
|
||||
}
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
|
|
|
@ -38,6 +38,7 @@ module Mtlstats.Types (
|
|||
GoalieStats (..),
|
||||
GameStats (..),
|
||||
Prompt (..),
|
||||
SelectParams (..),
|
||||
-- * Lenses
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
|
@ -517,6 +518,24 @@ data Prompt = Prompt
|
|||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
|
|
Loading…
Reference in New Issue
Block a user