implemented selectPrompt
This commit is contained in:
parent
faa214bf6d
commit
1e78ca6f40
|
@ -27,6 +27,7 @@ module Mtlstats.Prompt (
|
||||||
promptHandler,
|
promptHandler,
|
||||||
strPrompt,
|
strPrompt,
|
||||||
numPrompt,
|
numPrompt,
|
||||||
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
gameYearPrompt,
|
gameYearPrompt,
|
||||||
gameDayPrompt,
|
gameDayPrompt,
|
||||||
|
@ -48,6 +49,7 @@ module Mtlstats.Prompt (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
import Control.Monad.Extra (whenJust)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (isDigit, toUpper)
|
import Data.Char (isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
|
@ -112,6 +114,43 @@ numPrompt pStr act = Prompt
|
||||||
, promptSpecialKey = const $ return ()
|
, 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
|
-- | Prompts for the game year
|
||||||
gameYearPrompt :: Prompt
|
gameYearPrompt :: Prompt
|
||||||
gameYearPrompt = numPrompt "Game year: " $
|
gameYearPrompt = numPrompt "Game year: " $
|
||||||
|
|
|
@ -38,6 +38,7 @@ module Mtlstats.Types (
|
||||||
GoalieStats (..),
|
GoalieStats (..),
|
||||||
GameStats (..),
|
GameStats (..),
|
||||||
Prompt (..),
|
Prompt (..),
|
||||||
|
SelectParams (..),
|
||||||
-- * Lenses
|
-- * Lenses
|
||||||
-- ** ProgState Lenses
|
-- ** ProgState Lenses
|
||||||
database,
|
database,
|
||||||
|
@ -517,6 +518,24 @@ data Prompt = Prompt
|
||||||
-- ^ Action to perform when a special key is pressed
|
-- ^ 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 ''ProgState
|
||||||
makeLenses ''GameState
|
makeLenses ''GameState
|
||||||
makeLenses ''CreatePlayerState
|
makeLenses ''CreatePlayerState
|
||||||
|
|
Loading…
Reference in New Issue
Block a user