mtlstats/src/Mtlstats/Prompt.hs

{- |

mtlstats
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <https://www.gnu.org/licenses/>.

-}

module Mtlstats.Prompt (
  -- * Prompt Functions
  promptHandler,
  promptControllerWith,
  promptController,
  strPrompt,
  ucStrPrompt,
  namePrompt,
  numPrompt,
  numPromptRange,
  numPromptWithFallback,
  dbNamePrompt,
  selectPrompt,
  -- * Individual prompts
  getDBPrompt,
  newSeasonPrompt,
  playerNumPrompt,
  playerNamePrompt,
  playerPosPrompt,
  goalieNumPrompt,
  goalieNamePrompt,
  selectPlayerPrompt,
  selectActivePlayerPrompt,
  selectGoaliePrompt,
  selectActiveGoaliePrompt,
  selectPositionPrompt,
  playerToEditPrompt
) where

import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
import Brick.Widgets.Core (hBox, showCursor, str)
import Control.Monad (when)
import Control.Monad.Extra (whenJust)
import Control.Monad.State.Class (gets, modify)
import Data.Char (isAlphaNum, isDigit, toUpper)
import Graphics.Text.Width (safeWcswidth)
import Graphics.Vty.Input.Events
  ( Event (EvKey)
  , Key (KBS, KChar, KEnter, KFun)
  )
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Mtl ((.=), use)
import Text.Read (readMaybe)

import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Helpers.Position
import Mtlstats.Types
import Mtlstats.Util

-- | Event handler for a prompt
promptHandler :: Prompt -> Handler ()
promptHandler p (VtyEvent (EvKey KEnter [])) = do
  val <- use inputBuffer
  inputBuffer .= ""
  promptAction p val
promptHandler p (VtyEvent (EvKey (KChar c) [])) =
  modify $ inputBuffer %~ promptProcessChar p c
promptHandler _ (VtyEvent (EvKey KBS [])) =
  modify removeChar
promptHandler p (VtyEvent (EvKey k m)) =
  promptSpecialKey p k m
promptHandler _ _ = return ()

-- | Builds a controller out of a prompt with a header
promptControllerWith
  :: (ProgState -> Widget () -> Widget ())
  -- ^ The header
  -> Prompt
  -- ^ The prompt to use
  -> Controller
  -- ^ The resulting controller
promptControllerWith header prompt = Controller
  { drawController   = \s -> header s $ drawPrompt prompt s
  , handleController = promptHandler prompt
  }

-- | Builds a controller out of a prompt
promptController
  :: Prompt
  -- ^ The prompt to use
  -> Controller
  -- ^ The resulting controller
promptController = promptControllerWith $ const id

-- | Builds a string prompt
strPrompt
  :: String
  -- ^ The prompt string
  -> (String -> Action ())
  -- ^ The callback function for the result
  -> Prompt
strPrompt pStr act = Prompt
  { drawPrompt        = drawSimplePrompt pStr
  , promptProcessChar = \ch -> (++ [ch])
  , promptAction      = act
  , promptSpecialKey  = \_ _ -> return ()
  }

-- | Creates an upper case string prompt
ucStrPrompt
  :: String
  -- ^ The prompt string
  -> (String -> Action ())
  -- ^ The callback function for the result
  -> Prompt
ucStrPrompt pStr act = (strPrompt pStr act)
  { promptProcessChar = \ch -> (++ [toUpper ch]) }

-- | Creates a prompt which forces capitalization of input to
-- accomodate a player or goalie name
namePrompt
  :: String
  -- ^ The prompt string
  -> (String -> Action ())
  -- ^ The callback function for the result
  -> Prompt
namePrompt pStr act = (strPrompt pStr act)
  { promptProcessChar = capitalizeName }

-- | Builds a numeric prompt
numPrompt
  :: String
  -- ^ The prompt string
  -> (Int -> Action ())
  -- ^ The callback function for the result
  -> Prompt
numPrompt pStr = numPromptWithFallback pStr $ return ()

-- | Builds a numberic prompt with a range
numPromptRange
  :: Int
  -- ^ The minimum value
  -> Int
  -- ^ The maximum value
  -> String
  -- ^ The prompt string
  -> (Int -> Action ())
  -- ^ The callback function for the result
  -> Prompt
numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
  when (n >= nMin && n <= nMax) $ callback n

-- | Builds a numeric prompt with a fallback action
numPromptWithFallback
  :: String
  -- ^ The prompt string
  -> Action ()
  -- ^ The action to call on invalid (or blank) input
  -> (Int -> Action ())
  -- ^ The callback function for the result
  -> Prompt
numPromptWithFallback pStr fallback act = Prompt
  { drawPrompt        = drawSimplePrompt pStr
  , promptProcessChar = \ch existing -> if isDigit ch
    then existing ++ [ch]
    else existing
  , promptAction      = maybe fallback act . readMaybe
  , promptSpecialKey  = \_ _ -> return ()
  }

-- | Prompts for a database name
dbNamePrompt
  :: String
  -- ^ The prompt string
  -> (String -> Action ())
  -- ^ The callback to pass the result to
  -> Prompt
dbNamePrompt pStr act = (strPrompt pStr act)
  { promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
    then (++[toUpper ch])
    else id
  }

-- | Prompts the user for a filename to save a backup of the database
-- to
newSeasonPrompt :: Prompt
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
  if null fn
  then modify backHome
  else do
    saveDatabase
    modify
      $ (dbName .~ fn)
      . (progMode .~ NewSeason True)

-- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
  { drawPrompt = \s -> let
    sStr       = s^.inputBuffer
    pStr       = spPrompt params ++ sStr
    pWidth     = safeWcswidth pStr
    results    = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
    fmtRes     = map
      (\(n, (_, x)) -> let
        desc = spElemDesc params x
        in str $ "F" ++ show n ++ ") " ++ desc)
      results
    in hBox $
      [ showCursor () (Location (0, pWidth)) $ str pStr
      , str ""
      , str $ spSearchHeader params
      ] ++ fmtRes
  , promptProcessChar = spProcessChar params
  , 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 = \key _ -> case key of
    KFun rawK -> do
      sStr <- use inputBuffer
      db   <- use database
      let
        n       = pred rawK
        results = spSearch params sStr db
      when (n < maxFunKeys) $
        whenJust (nth n results) $ \(sel, _) -> do
          modify $ inputBuffer .~ ""
          spCallback params $ Just sel
    _ -> return ()
  }

-- | Prompts for the database to load
getDBPrompt :: Prompt
getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
  modify $ dbName .~ fn
  loadDatabase

-- | Prompts for a new player's number
playerNumPrompt :: Prompt
playerNumPrompt = numPrompt "Player number: " $
  modify . (progMode.createPlayerStateL.cpsNumber ?~)

-- | Prompts for a new player's name
playerNamePrompt :: Prompt
playerNamePrompt = namePrompt "Player name: " $
  modify . (progMode.createPlayerStateL.cpsName .~)

-- | Prompts for a new player's position
playerPosPrompt :: Prompt
playerPosPrompt = selectPositionPrompt "Player position: " $
  modify . (progMode.createPlayerStateL.cpsPosition .~)

-- | Prompts tor the goalie's number
goalieNumPrompt :: Prompt
goalieNumPrompt = numPrompt "Goalie number: " $
  modify . (progMode.createGoalieStateL.cgsNumber ?~)

-- | Prompts for the goalie's name
goalieNamePrompt :: Prompt
goalieNamePrompt = namePrompt "Goalie name: " $
  modify . (progMode.createGoalieStateL.cgsName .~)

-- | Selects a player using a specified search function (creating the
-- player if necessary)
selectPlayerPromptWith
  :: (String -> [Player] -> [(Int, Player)])
  -- ^ The search function
  -> String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the payer as
  -- input)
  -> Prompt
selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
  { spPrompt       = pStr
  , spSearchHeader = "Player select:"
  , spSearch       = \sStr db -> sFunc sStr (db^.dbPlayers)
  , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
  , spElemDesc     = playerSummary
  , spProcessChar  = capitalizeName
  , spCallback     = callback
  , spNotFound     = \sStr -> do
    mode <- gets (^.progMode)
    let
      cps = newCreatePlayerState
        & cpsName .~ sStr
        & cpsSuccessCallback .~ do
          modify $ progMode .~ mode
          index <- pred . length <$> gets (^.database.dbPlayers)
          callback $ Just index
        & cpsFailureCallback .~ modify (progMode .~ mode)
    modify $ progMode .~ CreatePlayer cps
  }

-- | Selects a player (creating one if necessary)
selectPlayerPrompt
  :: String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the payer as
  -- input)
  -> Prompt
selectPlayerPrompt = selectPlayerPromptWith playerSearch

-- | Selects an active player (creating one if necessary)
selectActivePlayerPrompt
  :: String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the payer as
  -- input)
  -> Prompt
selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch

-- | Selects a goalie with a specified search criteria (creating the
-- goalie if necessary)
selectGoaliePromptWith
  :: (String -> [Goalie] -> [(Int, Goalie)])
  -- ^ The search criteria
  -> String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the goalie as
  -- input)
  -> Prompt
selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
  { spPrompt       = pStr
  , spSearchHeader = "Goalie select:"
  , spSearch       = \sStr db -> criteria sStr (db^.dbGoalies)
  , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
  , spElemDesc     = goalieSummary
  , spProcessChar  = capitalizeName
  , spCallback     = callback
  , spNotFound     = \sStr -> do
    mode <- gets (^.progMode)
    let
      cgs = newCreateGoalieState
        & cgsName .~ sStr
        & cgsSuccessCallback .~ do
          modify $ progMode .~ mode
          index <- pred . length <$> gets (^.database.dbGoalies)
          callback $ Just index
        & cgsFailureCallback .~ modify (progMode .~ mode)
    modify $ progMode .~ CreateGoalie cgs
  }

-- | Selects a goalie (creating one if necessary)
selectGoaliePrompt
  :: String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the goalie as
  -- input)
  -> Prompt
selectGoaliePrompt = selectGoaliePromptWith goalieSearch

-- | Selects an active goalie (creating one if necessary)
selectActiveGoaliePrompt
  :: String
  -- ^ The prompt string
  -> (Maybe Int -> Action ())
  -- ^ The callback to run (takes the index number of the goalie as
  -- input)
  -> Prompt
selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch

-- | Selects (or creates) a player position
selectPositionPrompt
  :: String
  -- ^ The 'Prompt' string
  -> (String -> Action ())
  -- ^ The action to perform when a value is entered
  -> Prompt
selectPositionPrompt pStr callback = selectPrompt SelectParams
  { spPrompt = pStr
  , spSearchHeader = "Positions:"
  , spSearch = posSearch
  , spSearchExact = posSearchExact
  , spElemDesc = id
  , spProcessChar = \ch -> (++ [toUpper ch])
  , spCallback = posCallback callback
  , spNotFound = callback
  }

playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
  modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

drawSimplePrompt :: String -> Renderer
drawSimplePrompt pStr s = let
  fullStr  = pStr ++ s^.inputBuffer
  strWidth = safeWcswidth fullStr
  in showCursor () (Location (strWidth, 0)) $ str fullStr