don't abort creating new player on selection

This commit is contained in:
Jonathan Lamothe 2019-10-19 00:41:56 -04:00
parent c7849d3558
commit ef8f7f3fee
3 changed files with 16 additions and 6 deletions

View File

@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where module Mtlstats.Control (dispatch) where
import Control.Monad (join, when) import Control.Monad (join, when)
import Control.Monad.Extra (ifM)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper) import Data.Char (toUpper)
import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Maybe (fromJust, fromMaybe, isJust)
@ -330,7 +331,12 @@ confirmCreatePlayerC = Controller
modify addPlayer modify addPlayer
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
Just False -> Just False ->
join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback ifM (gets $ view $ progMode.createPlayerStateL.cpsAbortable)
(join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback)
(modify $ progMode.createPlayerStateL
%~ (cpsNumber .~ Nothing)
. (cpsName .~ "")
. (cpsPosition .~ ""))
Nothing -> return () Nothing -> return ()
return True return True
} }

View File

@ -179,9 +179,9 @@ selectPlayerPrompt pStr callback = Prompt
Nothing -> do Nothing -> do
mode <- gets $ view progMode mode <- gets $ view progMode
let let
cps cps = newCreatePlayerState
= newCreatePlayerState & cpsAbortable .~ False
& cpsName .~ sStr & cpsName .~ sStr
& cpsSuccessCallback .~ do & cpsSuccessCallback .~ do
modify $ progMode .~ mode modify $ progMode .~ mode
pIndex <- pred . length <$> gets (view $ database.dbPlayers) pIndex <- pred . length <$> gets (view $ database.dbPlayers)

View File

@ -64,6 +64,7 @@ module Mtlstats.Types (
selectedPlayer, selectedPlayer,
pMinsRecorded, pMinsRecorded,
-- ** CreatePlayerState Lenses -- ** CreatePlayerState Lenses
cpsAbortable,
cpsNumber, cpsNumber,
cpsName, cpsName,
cpsPosition, cpsPosition,
@ -243,7 +244,9 @@ data GameType
-- | Player creation status -- | Player creation status
data CreatePlayerState = CreatePlayerState data CreatePlayerState = CreatePlayerState
{ _cpsNumber :: Maybe Int { _cpsAbortable :: Bool
-- ^ Set to 'True' when player creation is abortable
, _cpsNumber :: Maybe Int
-- ^ The player's number -- ^ The player's number
, _cpsName :: String , _cpsName :: String
-- ^ The player's name -- ^ The player's name
@ -541,7 +544,8 @@ newGameState = GameState
-- | Constructor for a 'CreatePlayerState' -- | Constructor for a 'CreatePlayerState'
newCreatePlayerState :: CreatePlayerState newCreatePlayerState :: CreatePlayerState
newCreatePlayerState = CreatePlayerState newCreatePlayerState = CreatePlayerState
{ _cpsNumber = Nothing { _cpsAbortable = True
, _cpsNumber = Nothing
, _cpsName = "" , _cpsName = ""
, _cpsPosition = "" , _cpsPosition = ""
, _cpsSuccessCallback = return () , _cpsSuccessCallback = return ()