implemented player confirmation/addition
This commit is contained in:
parent
0ee0451496
commit
375e87a49e
|
@ -31,6 +31,7 @@ module Mtlstats.Actions
|
||||||
, updateGameStats
|
, updateGameStats
|
||||||
, validateGameDate
|
, validateGameDate
|
||||||
, createPlayer
|
, createPlayer
|
||||||
|
, addPlayer
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
@ -116,3 +117,15 @@ validateGameDate s = fromMaybe s $ do
|
||||||
-- | Starts player creation mode
|
-- | Starts player creation mode
|
||||||
createPlayer :: ProgState -> ProgState
|
createPlayer :: ProgState -> ProgState
|
||||||
createPlayer = progMode .~ CreatePlayer newCreatePlayerState
|
createPlayer = progMode .~ CreatePlayer newCreatePlayerState
|
||||||
|
|
||||||
|
-- | Adds the entered player to the roster
|
||||||
|
addPlayer :: ProgState -> ProgState
|
||||||
|
addPlayer s = fromMaybe s $ do
|
||||||
|
let cps = s^.progMode.createPlayerStateL
|
||||||
|
num <- cps^.cpsNumber
|
||||||
|
let
|
||||||
|
name = cps^.cpsName
|
||||||
|
pos = cps^.cpsPosition
|
||||||
|
player = newPlayer num name pos
|
||||||
|
Just $ s & database.dbPlayers
|
||||||
|
%~ (player:)
|
||||||
|
|
|
@ -57,6 +57,7 @@ dispatch s = case s^.progMode of
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
| null $ cps^.cpsName -> getPlayerNameC
|
||||||
| null $ cps^.cpsPosition -> getPlayerPosC
|
| null $ cps^.cpsPosition -> getPlayerPosC
|
||||||
|
| not $ cps^.cpsConfirmed -> confirmCreatePlayerC
|
||||||
| otherwise -> undefined
|
| otherwise -> undefined
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: Controller
|
||||||
|
@ -223,3 +224,22 @@ getPlayerPosC = Controller
|
||||||
promptHandler playerPosPrompt e
|
promptHandler playerPosPrompt e
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
|
confirmCreatePlayerC :: Controller
|
||||||
|
confirmCreatePlayerC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let cps = s^.progMode.createPlayerStateL
|
||||||
|
C.drawString $ " Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
|
||||||
|
C.drawString $ " Player name: " ++ cps^.cpsName ++ "\n"
|
||||||
|
C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
|
||||||
|
C.drawString "Create player: are you sure? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
modify addPlayer
|
||||||
|
modify $ progMode .~ MainMenu
|
||||||
|
Just False -> modify $ progMode .~ MainMenu
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
|
@ -40,6 +40,7 @@ spec = describe "Mtlstats.Actions" $ do
|
||||||
updateGameStatsSpec
|
updateGameStatsSpec
|
||||||
validateGameDateSpec
|
validateGameDateSpec
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
|
addPlayerSpec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
|
@ -322,6 +323,30 @@ createPlayerSpec = describe "createPlayer" $
|
||||||
s = createPlayer newProgState
|
s = createPlayer newProgState
|
||||||
in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState
|
in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState
|
||||||
|
|
||||||
|
addPlayerSpec :: Spec
|
||||||
|
addPlayerSpec = describe "addPlayer" $ do
|
||||||
|
let
|
||||||
|
p1 = newPlayer 1 "Joe" "centre"
|
||||||
|
p2 = newPlayer 2 "Bob" "defense"
|
||||||
|
db = newDatabase
|
||||||
|
& dbPlayers .~ [p2]
|
||||||
|
s pm = newProgState
|
||||||
|
& progMode .~ pm
|
||||||
|
& database .~ db
|
||||||
|
|
||||||
|
context "data available" $
|
||||||
|
it "should create the player" $ let
|
||||||
|
s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
|
||||||
|
& cpsNumber ?~ 1
|
||||||
|
& cpsName .~ "Joe"
|
||||||
|
& cpsPosition .~ "centre"
|
||||||
|
in s'^.database.dbPlayers `shouldBe` [p1, p2]
|
||||||
|
|
||||||
|
context "data unavailable" $
|
||||||
|
it "should not create the player" $ let
|
||||||
|
s' = addPlayer $ s MainMenu
|
||||||
|
in s'^.database.dbPlayers `shouldBe` [p2]
|
||||||
|
|
||||||
makePlayer :: IO Player
|
makePlayer :: IO Player
|
||||||
makePlayer = Player
|
makePlayer = Player
|
||||||
<$> makeNum
|
<$> makeNum
|
||||||
|
|
Loading…
Reference in New Issue
Block a user