implemented editHomeStandings
This commit is contained in:
parent
264d9f81e2
commit
49963277be
@ -31,11 +31,11 @@ import Mtlstats.Types
|
||||
|
||||
-- | Enters edit standings mode
|
||||
editStandings :: ProgState -> ProgState
|
||||
editStandings = progMode .~ EditStandings
|
||||
editStandings = progMode .~ EditStandings ESMMenu
|
||||
|
||||
-- | Edits the home standings
|
||||
editHomeStandings :: ProgState -> ProgState
|
||||
editHomeStandings = undefined
|
||||
editHomeStandings = progMode .~ EditStandings ESMHome
|
||||
|
||||
-- | Edits the road standings
|
||||
editRoadStandings :: ProgState -> ProgState
|
||||
|
@ -55,9 +55,9 @@ dispatch s = case s^.progMode of
|
||||
| null $ cgs^.cgsNumber -> getGoalieNumC
|
||||
| null $ cgs^.cgsName -> getGoalieNameC
|
||||
| otherwise -> confirmCreateGoalieC
|
||||
EditPlayer eps -> editPlayerC eps
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
EditStandings -> editStandingsC
|
||||
EditPlayer eps -> editPlayerC eps
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
(EditStandings esm) -> editStandingsC esm
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
|
@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Control.EditStandings (editStandingsC) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
@ -30,8 +32,13 @@ import Mtlstats.Menu.EditStandings
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Controller for the edit standings menu
|
||||
editStandingsC :: Controller
|
||||
editStandingsC = menuControllerWith header editStandingsMenu
|
||||
editStandingsC :: EditStandingsMode -> Controller
|
||||
editStandingsC = \case
|
||||
ESMMenu -> menuControllerWith header editStandingsMenu
|
||||
ESMHome -> editHomeStandingsC
|
||||
|
||||
editHomeStandingsC :: Controller
|
||||
editHomeStandingsC = undefined
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header = do
|
||||
|
@ -35,6 +35,7 @@ module Mtlstats.Types (
|
||||
EditPlayerMode (..),
|
||||
EditGoalieState (..),
|
||||
EditGoalieMode (..),
|
||||
EditStandingsMode (..),
|
||||
Database (..),
|
||||
Player (..),
|
||||
PlayerStats (..),
|
||||
@ -56,6 +57,7 @@ module Mtlstats.Types (
|
||||
createGoalieStateL,
|
||||
editPlayerStateL,
|
||||
editGoalieStateL,
|
||||
editStandingsModeL,
|
||||
-- ** GameState Lenses
|
||||
gameYear,
|
||||
gameMonth,
|
||||
@ -239,18 +241,18 @@ data ProgMode
|
||||
| CreateGoalie CreateGoalieState
|
||||
| EditPlayer EditPlayerState
|
||||
| EditGoalie EditGoalieState
|
||||
| EditStandings
|
||||
| EditStandings EditStandingsMode
|
||||
|
||||
instance Show ProgMode where
|
||||
show MainMenu = "MainMenu"
|
||||
show (NewSeason _) = "NewSeason"
|
||||
show (NewGame _) = "NewGame"
|
||||
show EditMenu = "EditMenu"
|
||||
show (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
show (EditPlayer _) = "EditPlayer"
|
||||
show (EditGoalie _) = "EditGoalie"
|
||||
show EditStandings = "EditStandings"
|
||||
show MainMenu = "MainMenu"
|
||||
show (NewSeason _) = "NewSeason"
|
||||
show (NewGame _) = "NewGame"
|
||||
show EditMenu = "EditMenu"
|
||||
show (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
show (EditPlayer _) = "EditPlayer"
|
||||
show (EditGoalie _) = "EditGoalie"
|
||||
show (EditStandings _) = "EditStandings"
|
||||
|
||||
-- | The game state
|
||||
data GameState = GameState
|
||||
@ -391,6 +393,12 @@ data EditGoalieMode
|
||||
| EGLtTies
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the standings edit mode
|
||||
data EditStandingsMode
|
||||
= ESMMenu
|
||||
| ESMHome
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the database
|
||||
data Database = Database
|
||||
{ _dbPlayers :: [Player]
|
||||
@ -716,6 +724,13 @@ editGoalieStateL = lens
|
||||
_ -> newEditGoalieState)
|
||||
(\_ egs -> EditGoalie egs)
|
||||
|
||||
editStandingsModeL :: Lens' ProgMode EditStandingsMode
|
||||
editStandingsModeL = lens
|
||||
(\case
|
||||
EditStandings esm -> esm
|
||||
_ -> ESMMenu)
|
||||
(\_ esm -> EditStandings esm)
|
||||
|
||||
-- | Constructor for a 'ProgState'
|
||||
newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
|
@ -24,20 +24,27 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Actions.EditStandingsSpec (spec) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
import Test.Hspec (Spec, describe, it, shouldSatisfy)
|
||||
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
|
||||
|
||||
import Mtlstats.Actions.EditStandings
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "EditStandings"
|
||||
editStandingsSpec
|
||||
spec = describe "EditStandings" $ mapM_
|
||||
(\(label, f, expected) -> describe label $ do
|
||||
let
|
||||
ps = newProgState
|
||||
ps' = f ps
|
||||
|
||||
editStandingsSpec :: Spec
|
||||
editStandingsSpec = describe "editStandings" $ let
|
||||
ps = newProgState
|
||||
ps' = editStandings ps
|
||||
in it "should set progMode to EditStandings" $
|
||||
ps'^.progMode `shouldSatisfy` \case
|
||||
EditStandings -> True
|
||||
_ -> False
|
||||
it "should set progMode to EditStandings" $
|
||||
ps'^.progMode `shouldSatisfy` \case
|
||||
(EditStandings _) -> True
|
||||
_ -> False
|
||||
|
||||
it ("should set editStandingsMode to " ++ show expected) $
|
||||
ps'^.progMode.editStandingsModeL `shouldBe` expected)
|
||||
|
||||
-- label, function, expected mode
|
||||
[ ( "editStandings", editStandings, ESMMenu )
|
||||
, ( "editHomeStandings", editHomeStandings, ESMHome )
|
||||
]
|
||||
|
@ -58,6 +58,7 @@ spec = describe "Mtlstats.Types" $ do
|
||||
createGoalieStateLSpec
|
||||
editPlayerStateLSpec
|
||||
editGoalieStateLSpec
|
||||
editStandingsModeLSpec
|
||||
teamScoreSpec
|
||||
otherScoreSpec
|
||||
homeTeamSpec
|
||||
@ -191,6 +192,18 @@ editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||
egs2 = newEditGoalieState
|
||||
& egsSelectedGoalie ?~ 2
|
||||
|
||||
editStandingsModeLSpec :: Spec
|
||||
editStandingsModeLSpec = describe "editStandingsModeL" $
|
||||
lensSpec editStandingsModeL
|
||||
-- getters
|
||||
[ ( "missing mode", MainMenu, ESMMenu )
|
||||
, ( "with mode", EditStandings ESMHome, ESMHome )
|
||||
]
|
||||
-- setters
|
||||
[ ( "set mode", MainMenu, ESMHome )
|
||||
, ( "change mode", EditStandings ESMMenu, ESMHome )
|
||||
]
|
||||
|
||||
teamScoreSpec :: Spec
|
||||
teamScoreSpec = describe "teamScore" $ do
|
||||
let
|
||||
@ -957,3 +970,8 @@ instance Comparable CreateGoalieState where
|
||||
describe "cgsName" $
|
||||
it ("should be " ++ expected^.cgsName) $
|
||||
actual^.cgsName `shouldBe` expected^.cgsName
|
||||
|
||||
instance Comparable EditStandingsMode where
|
||||
compareTest actual expected =
|
||||
it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected
|
||||
|
Loading…
x
Reference in New Issue
Block a user