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
import Control.Monad (join, when)
import Control.Monad.Extra (ifM)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper)
import Data.Maybe (fromJust, fromMaybe, isJust)
@ -330,7 +331,12 @@ confirmCreatePlayerC = Controller
modify addPlayer
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
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 ()
return True
}

View File

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

View File

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