implemented selectPrompt

This commit is contained in:
Jonathan Lamothe 2019-10-30 16:57:08 -04:00
parent faa214bf6d
commit 1e78ca6f40
2 changed files with 58 additions and 0 deletions

View File

@ -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: " $

View File

@ -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