Merge pull request #27 from mtlstats/bugfix-create-user
don't abort creating new player on selection
This commit is contained in:
commit
ba968657d9
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user