Jonathan Lamothe
GitHub
commit
db105d4348
|
|
@ -31,12 +31,17 @@ module Mtlstats.Actions
|
|||
, updateGameStats
|
||||
, validateGameDate
|
||||
, createPlayer
|
||||
, createGoalie
|
||||
, addPlayer
|
||||
, addGoalie
|
||||
, resetCreatePlayerState
|
||||
, resetCreateGoalieState
|
||||
, recordGoalAssists
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, recordGoalieStats
|
||||
, backHome
|
||||
, scrollUp
|
||||
, scrollDown
|
||||
|
|
@ -139,13 +144,21 @@ validateGameDate s = fromMaybe s $ do
|
|||
-- | Starts player creation mode
|
||||
createPlayer :: ProgState -> ProgState
|
||||
createPlayer = let
|
||||
cb = modify $ progMode .~ MainMenu
|
||||
cps
|
||||
= newCreatePlayerState
|
||||
& cpsSuccessCallback .~ cb
|
||||
& cpsFailureCallback .~ cb
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
cps = newCreatePlayerState
|
||||
& cpsSuccessCallback .~ callback
|
||||
& cpsFailureCallback .~ callback
|
||||
in progMode .~ CreatePlayer cps
|
||||
|
||||
-- | Starts goalie creation mode
|
||||
createGoalie :: ProgState -> ProgState
|
||||
createGoalie = let
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
cgs = newCreateGoalieState
|
||||
& cgsSuccessCallback .~ callback
|
||||
& cgsFailureCallback .~ callback
|
||||
in progMode .~ CreateGoalie cgs
|
||||
|
||||
-- | Adds the entered player to the roster
|
||||
addPlayer :: ProgState -> ProgState
|
||||
addPlayer s = fromMaybe s $ do
|
||||
|
|
@ -158,6 +171,30 @@ addPlayer s = fromMaybe s $ do
|
|||
Just $ s & database.dbPlayers
|
||||
%~ (++[player])
|
||||
|
||||
-- | Adds the entered goalie to the roster
|
||||
addGoalie :: ProgState -> ProgState
|
||||
addGoalie s = fromMaybe s $ do
|
||||
let cgs = s^.progMode.createGoalieStateL
|
||||
num <- cgs^.cgsNumber
|
||||
let
|
||||
name = cgs^.cgsName
|
||||
goalie = newGoalie num name
|
||||
Just $ s & database.dbGoalies
|
||||
%~ (++[goalie])
|
||||
|
||||
-- | Resets the 'CreatePlayerState' value
|
||||
resetCreatePlayerState :: ProgState -> ProgState
|
||||
resetCreatePlayerState = progMode.createPlayerStateL
|
||||
%~ (cpsNumber .~ Nothing)
|
||||
. (cpsName .~ "")
|
||||
. (cpsPosition .~ "")
|
||||
|
||||
-- | Resets the 'CreateGoalieState' value
|
||||
resetCreateGoalieState :: ProgState -> ProgState
|
||||
resetCreateGoalieState = progMode.createGoalieStateL
|
||||
%~ (cgsNumber .~ Nothing)
|
||||
. (cgsName .~ "")
|
||||
|
||||
-- | Awards the goal and assists to the players
|
||||
recordGoalAssists :: ProgState -> ProgState
|
||||
recordGoalAssists ps = fromMaybe ps $ do
|
||||
|
|
@ -233,6 +270,31 @@ assignPMins mins s = fromMaybe s $ do
|
|||
)
|
||||
. (selectedPlayer .~ Nothing)
|
||||
|
||||
-- | Records the goalie's game stats
|
||||
recordGoalieStats :: ProgState -> ProgState
|
||||
recordGoalieStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gid <- gs^.gameSelectedGoalie
|
||||
goalie <- nth gid $ s^.database.dbGoalies
|
||||
mins <- gs^.goalieMinsPlayed
|
||||
goals <- gs^.goalsAllowed
|
||||
|
||||
let
|
||||
bumpStats gs = gs
|
||||
& gsMinsPlayed +~ mins
|
||||
& gsGoalsAllowed +~ goals
|
||||
|
||||
Just $ s
|
||||
& progMode.gameStateL
|
||||
%~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats)
|
||||
. (gameSelectedGoalie .~ Nothing)
|
||||
. (goalieMinsPlayed .~ Nothing)
|
||||
. (goalsAllowed .~ Nothing)
|
||||
& database.dbGoalies
|
||||
%~ modifyNth gid (\goalie -> goalie
|
||||
& gYtd %~ bumpStats
|
||||
& gLifetime %~ bumpStats)
|
||||
|
||||
-- | Resets the program state back to the main menu
|
||||
backHome :: ProgState -> ProgState
|
||||
backHome
|
||||
|
|
|
|||
|
|
@ -40,3 +40,7 @@ dbFname = "database.json"
|
|||
-- | The maximum number of assists
|
||||
maxAssists :: Int
|
||||
maxAssists = 2
|
||||
|
||||
-- | The length of a typical game (in minutes)
|
||||
gameLength :: Int
|
||||
gameLength = 60
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ import Lens.Micro.Extras (view)
|
|||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Control.GoalieInput
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Menu
|
||||
|
|
@ -58,12 +59,17 @@ dispatch s = case s^.progMode of
|
|||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
||||
| isJust $ gs^.selectedPlayer -> getPMinsC
|
||||
| not $ gs^.pMinsRecorded -> pMinPlayerC
|
||||
| not $ gs^.goaliesRecorded -> goalieInput gs
|
||||
| otherwise -> reportC
|
||||
CreatePlayer cps
|
||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||
| null $ cps^.cpsName -> getPlayerNameC
|
||||
| null $ cps^.cpsPosition -> getPlayerPosC
|
||||
| otherwise -> confirmCreatePlayerC
|
||||
CreateGoalie cgs
|
||||
| null $ cgs^.cgsNumber -> getGoalieNumC
|
||||
| null $ cgs^.cgsName -> getGoalieNameC
|
||||
| otherwise -> confirmCreateGoalieC
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
|
|
@ -336,6 +342,44 @@ confirmCreatePlayerC = Controller
|
|||
return True
|
||||
}
|
||||
|
||||
getGoalieNumC :: Controller
|
||||
getGoalieNumC = Controller
|
||||
{ drawController = drawPrompt goalieNumPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler goalieNumPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getGoalieNameC :: Controller
|
||||
getGoalieNameC = Controller
|
||||
{ drawController = drawPrompt goalieNamePrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler goalieNamePrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmCreateGoalieC :: Controller
|
||||
confirmCreateGoalieC = Controller
|
||||
{ drawController = \s -> do
|
||||
let cgs = s^.progMode.createGoalieStateL
|
||||
C.drawString $ unlines
|
||||
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
|
||||
, " Goalie name: " ++ cgs^.cgsName
|
||||
, ""
|
||||
, "Create goalie: are you sure? (Y/N)"
|
||||
]
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> do
|
||||
modify addGoalie
|
||||
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
|
||||
Just False ->
|
||||
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
gameGoal :: ProgState -> (Int, Int)
|
||||
gameGoal s =
|
||||
( s^.database.dbGames
|
||||
|
|
|
|||
|
|
@ -0,0 +1,75 @@
|
|||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Control.GoalieInput (goalieInput) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | The dispatcher for handling goalie input
|
||||
goalieInput :: GameState -> Controller
|
||||
goalieInput gs
|
||||
| null $ gs^.gameSelectedGoalie = selectGoalieC
|
||||
| null $ gs^.goalieMinsPlayed = minsPlayedC
|
||||
| otherwise = goalsAllowedC
|
||||
|
||||
selectGoalieC :: Controller
|
||||
selectGoalieC = Controller
|
||||
{ drawController = drawPrompt selectGameGoaliePrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler selectGameGoaliePrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
minsPlayedC :: Controller
|
||||
minsPlayedC = Controller
|
||||
{ drawController = \s -> do
|
||||
C.drawString $ header s
|
||||
drawPrompt goalieMinsPlayedPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler goalieMinsPlayedPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
goalsAllowedC :: Controller
|
||||
goalsAllowedC = Controller
|
||||
{ drawController = \s -> do
|
||||
C.drawString $ header s
|
||||
drawPrompt goalsAllowedPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler goalsAllowedPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> String
|
||||
header s = unlines
|
||||
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
|
||||
, fromMaybe "" $ do
|
||||
n <- s^.progMode.gameStateL.gameSelectedGoalie
|
||||
g <- nth n $ s^.database.dbGoalies
|
||||
Just $ goalieSummary g
|
||||
]
|
||||
|
|
@ -71,7 +71,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
|||
modify startNewGame >> return True
|
||||
, MenuItem '3' "Create Player" $
|
||||
modify createPlayer >> return True
|
||||
, MenuItem '4' "Exit" $ do
|
||||
, MenuItem '4' "Create Goalie" $
|
||||
modify createGoalie >> return True
|
||||
, MenuItem '5' "Exit" $ do
|
||||
db <- gets $ view database
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ module Mtlstats.Prompt (
|
|||
promptHandler,
|
||||
strPrompt,
|
||||
numPrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
gameYearPrompt,
|
||||
gameDayPrompt,
|
||||
|
|
@ -37,16 +38,24 @@ module Mtlstats.Prompt (
|
|||
playerNamePrompt,
|
||||
playerPosPrompt,
|
||||
selectPlayerPrompt,
|
||||
selectGoaliePrompt,
|
||||
recordGoalPrompt,
|
||||
recordAssistPrompt,
|
||||
pMinPlayerPrompt,
|
||||
assignPMinsPrompt
|
||||
assignPMinsPrompt,
|
||||
goalieNumPrompt,
|
||||
goalieNamePrompt,
|
||||
selectGameGoaliePrompt,
|
||||
goalieMinsPlayedPrompt,
|
||||
goalsAllowedPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (isDigit, toUpper)
|
||||
import Data.Foldable (forM_)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import Text.Read (readMaybe)
|
||||
|
|
@ -108,6 +117,43 @@ numPrompt pStr act = Prompt
|
|||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Builds a selection prompt
|
||||
selectPrompt :: SelectParams a -> Prompt
|
||||
selectPrompt params = Prompt
|
||||
{ promptDrawer = \s -> do
|
||||
let sStr = s^.inputBuffer
|
||||
C.drawString $ spPrompt params ++ sStr
|
||||
(row, col) <- C.cursorPosition
|
||||
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
|
||||
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
||||
C.drawString $ unlines $ map
|
||||
(\(n, (_, x)) -> let
|
||||
desc = spElemDesc params x
|
||||
in "F" ++ show n ++ ") " ++ desc)
|
||||
results
|
||||
C.moveCursor row col
|
||||
, promptCharCheck = const True
|
||||
, promptAction = \sStr -> if null sStr
|
||||
then spCallback params Nothing
|
||||
else do
|
||||
db <- gets (^.database)
|
||||
case spSearchExact params sStr db of
|
||||
Nothing -> spNotFound params sStr
|
||||
Just n -> spCallback params $ Just n
|
||||
, promptSpecialKey = \case
|
||||
C.KeyFunction rawK -> do
|
||||
sStr <- gets (^.inputBuffer)
|
||||
db <- gets (^.database)
|
||||
let
|
||||
n = pred $ fromInteger rawK
|
||||
results = spSearch params sStr db
|
||||
when (n < maxFunKeys) $
|
||||
whenJust (nth n results) $ \(n, _) -> do
|
||||
modify $ inputBuffer .~ ""
|
||||
spCallback params $ Just n
|
||||
_ -> return ()
|
||||
}
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
|
|
@ -156,49 +202,52 @@ selectPlayerPrompt
|
|||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectPlayerPrompt pStr callback = Prompt
|
||||
{ promptDrawer = \s -> do
|
||||
let sStr = s^.inputBuffer
|
||||
C.drawString pStr
|
||||
C.drawString sStr
|
||||
(row, col) <- C.cursorPosition
|
||||
C.drawString "\n\nPlayer select:\n"
|
||||
let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
|
||||
mapM_
|
||||
(\(n, (_, p)) -> C.drawString $
|
||||
"F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
|
||||
sel
|
||||
C.moveCursor row col
|
||||
, promptCharCheck = const True
|
||||
, promptAction = \sStr -> if null sStr
|
||||
then callback Nothing
|
||||
else do
|
||||
players <- gets $ view $ database.dbPlayers
|
||||
case playerSearchExact sStr players of
|
||||
Just (n, _) -> callback $ Just n
|
||||
Nothing -> do
|
||||
mode <- gets $ view progMode
|
||||
let
|
||||
cps = newCreatePlayerState
|
||||
& cpsName .~ sStr
|
||||
& cpsSuccessCallback .~ do
|
||||
modify $ progMode .~ mode
|
||||
pIndex <- pred . length <$> gets (view $ database.dbPlayers)
|
||||
callback $ Just pIndex
|
||||
& cpsFailureCallback .~ do
|
||||
modify $ progMode .~ mode
|
||||
modify $ progMode .~ CreatePlayer cps
|
||||
, promptSpecialKey = \case
|
||||
C.KeyFunction n -> do
|
||||
sStr <- gets $ view inputBuffer
|
||||
players <- gets $ view $ database.dbPlayers
|
||||
modify $ inputBuffer .~ ""
|
||||
let
|
||||
fKey = pred $ fromIntegral n
|
||||
options = playerSearch sStr players
|
||||
sel = fst <$> nth fKey options
|
||||
callback sel
|
||||
_ -> return ()
|
||||
selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Player select:"
|
||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||
, spElemDesc = playerSummary
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
let
|
||||
cps = newCreatePlayerState
|
||||
& cpsName .~ sStr
|
||||
& cpsSuccessCallback .~ do
|
||||
modify $ progMode .~ mode
|
||||
index <- pred . length <$> gets (^.database.dbPlayers)
|
||||
callback $ Just index
|
||||
& cpsFailureCallback .~ modify (progMode .~ mode)
|
||||
modify $ progMode .~ CreatePlayer cps
|
||||
}
|
||||
|
||||
-- | Selects a goalie (creating one if necessary)
|
||||
selectGoaliePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Goalie select:"
|
||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||
, spElemDesc = goalieSummary
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
let
|
||||
cgs = newCreateGoalieState
|
||||
& cgsName .~ sStr
|
||||
& cgsSuccessCallback .~ do
|
||||
modify $ progMode .~ mode
|
||||
index <- pred . length <$> gets (^.database.dbGoalies)
|
||||
callback $ Just index
|
||||
& cgsFailureCallback .~ modify (progMode .~ mode)
|
||||
modify $ progMode .~ CreateGoalie cgs
|
||||
}
|
||||
|
||||
-- | Prompts for the player who scored the goal
|
||||
|
|
@ -234,6 +283,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
|
|||
when (nAssists >= maxAssists) $
|
||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
|
||||
-- | Prompts for the player to assign penalty minutes to
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectPlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
|
|
@ -241,9 +291,41 @@ pMinPlayerPrompt = selectPlayerPrompt
|
|||
Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n
|
||||
|
||||
-- | Prompts for the number of penalty mintues to assign to the player
|
||||
assignPMinsPrompt :: Prompt
|
||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||
modify . assignPMins
|
||||
|
||||
-- | Prompts tor the goalie's number
|
||||
goalieNumPrompt :: Prompt
|
||||
goalieNumPrompt = numPrompt "Goalie number: " $
|
||||
modify . (progMode.createGoalieStateL.cgsNumber ?~)
|
||||
|
||||
-- | Prompts for the goalie's name
|
||||
goalieNamePrompt :: Prompt
|
||||
goalieNamePrompt = strPrompt "Goalie name: " $
|
||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||
|
||||
-- | Prompts for a goalie who played in the game
|
||||
selectGameGoaliePrompt :: Prompt
|
||||
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.goaliesRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||
|
||||
-- | Prompts for the number of minutes the goalie has played
|
||||
goalieMinsPlayedPrompt :: Prompt
|
||||
goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
|
||||
modify . (progMode.gameStateL.goalieMinsPlayed ?~)
|
||||
|
||||
-- | Prompts for the number of goals the goalie allowed
|
||||
goalsAllowedPrompt :: Prompt
|
||||
goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
|
||||
modify (progMode.gameStateL.goalsAllowed ?~ n)
|
||||
mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.goalieMinsPlayed)
|
||||
when (mins >= gameLength) $
|
||||
modify $ progMode.gameStateL.goaliesRecorded .~ True
|
||||
modify recordGoalieStats
|
||||
|
||||
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
||||
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ module Mtlstats.Types (
|
|||
GameState (..),
|
||||
GameType (..),
|
||||
CreatePlayerState (..),
|
||||
CreateGoalieState (..),
|
||||
Database (..),
|
||||
Player (..),
|
||||
PlayerStats (..),
|
||||
|
|
@ -37,6 +38,7 @@ module Mtlstats.Types (
|
|||
GoalieStats (..),
|
||||
GameStats (..),
|
||||
Prompt (..),
|
||||
SelectParams (..),
|
||||
-- * Lenses
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
|
|
@ -46,6 +48,7 @@ module Mtlstats.Types (
|
|||
-- ** ProgMode Lenses
|
||||
gameStateL,
|
||||
createPlayerStateL,
|
||||
createGoalieStateL,
|
||||
-- ** GameState Lenses
|
||||
gameYear,
|
||||
gameMonth,
|
||||
|
|
@ -63,12 +66,22 @@ module Mtlstats.Types (
|
|||
confirmGoalDataFlag,
|
||||
selectedPlayer,
|
||||
pMinsRecorded,
|
||||
gameGoalieStats,
|
||||
gameSelectedGoalie,
|
||||
goalieMinsPlayed,
|
||||
goalsAllowed,
|
||||
goaliesRecorded,
|
||||
-- ** CreatePlayerState Lenses
|
||||
cpsNumber,
|
||||
cpsName,
|
||||
cpsPosition,
|
||||
cpsSuccessCallback,
|
||||
cpsFailureCallback,
|
||||
-- ** CreateGoalieState Lenses
|
||||
cgsNumber,
|
||||
cgsName,
|
||||
cgsSuccessCallback,
|
||||
cgsFailureCallback,
|
||||
-- ** Database Lenses
|
||||
dbPlayers,
|
||||
dbGoalies,
|
||||
|
|
@ -94,7 +107,6 @@ module Mtlstats.Types (
|
|||
gsGames,
|
||||
gsMinsPlayed,
|
||||
gsGoalsAllowed,
|
||||
gsGoalsAgainst,
|
||||
gsWins,
|
||||
gsLosses,
|
||||
gsTies,
|
||||
|
|
@ -108,6 +120,7 @@ module Mtlstats.Types (
|
|||
newProgState,
|
||||
newGameState,
|
||||
newCreatePlayerState,
|
||||
newCreateGoalieState,
|
||||
newDatabase,
|
||||
newPlayer,
|
||||
newPlayerStats,
|
||||
|
|
@ -136,7 +149,11 @@ module Mtlstats.Types (
|
|||
playerIsActive,
|
||||
-- ** PlayerStats Helpers
|
||||
psPoints,
|
||||
addPlayerStats
|
||||
addPlayerStats,
|
||||
-- ** Goalie Helpers
|
||||
goalieSearch,
|
||||
goalieSearchExact,
|
||||
goalieSummary
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (StateT)
|
||||
|
|
@ -190,12 +207,14 @@ data ProgMode
|
|||
| NewSeason
|
||||
| NewGame GameState
|
||||
| CreatePlayer CreatePlayerState
|
||||
| CreateGoalie CreateGoalieState
|
||||
|
||||
instance Show ProgMode where
|
||||
show MainMenu = "MainMenu"
|
||||
show NewSeason = "NewSeason"
|
||||
show (NewGame _) = "NewGame"
|
||||
show (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
|
||||
-- | The game state
|
||||
data GameState = GameState
|
||||
|
|
@ -233,6 +252,18 @@ data GameState = GameState
|
|||
-- ^ Index number of the selected 'Player'
|
||||
, _pMinsRecorded :: Bool
|
||||
-- ^ Set when the penalty mintes have been recorded
|
||||
, _gameGoalieStats :: M.Map Int GoalieStats
|
||||
-- ^ The goalie stats accumulated over the game
|
||||
, _gameSelectedGoalie :: Maybe Int
|
||||
-- ^ Index number of the selected 'Goalie'
|
||||
, _goalieMinsPlayed :: Maybe Int
|
||||
-- ^ The number of minutes the currently selected goalie played in
|
||||
-- the game
|
||||
, _goalsAllowed :: Maybe Int
|
||||
-- ^ The number of goals the currently selected goalie allowed in
|
||||
-- the game
|
||||
, _goaliesRecorded :: Bool
|
||||
-- ^ Set when the user confirms that all goalie info has been entered
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | The type of game
|
||||
|
|
@ -255,6 +286,18 @@ data CreatePlayerState = CreatePlayerState
|
|||
-- ^ The function to call on failure
|
||||
}
|
||||
|
||||
-- | Goalie creation status
|
||||
data CreateGoalieState = CreateGoalieState
|
||||
{ _cgsNumber :: Maybe Int
|
||||
-- ^ The goalie's number
|
||||
, _cgsName :: String
|
||||
-- ^ The goalie's name
|
||||
, _cgsSuccessCallback :: Action ()
|
||||
-- ^ The function to call on success
|
||||
, _cgsFailureCallback :: Action ()
|
||||
-- ^ The function to call on failure
|
||||
}
|
||||
|
||||
-- | Represents the database
|
||||
data Database = Database
|
||||
{ _dbPlayers :: [Player]
|
||||
|
|
@ -396,8 +439,6 @@ data GoalieStats = GoalieStats
|
|||
-- ^ The number of minutes played
|
||||
, _gsGoalsAllowed :: Int
|
||||
-- ^ The number of goals allowed
|
||||
, _gsGoalsAgainst :: Int
|
||||
-- ^ The number of goals against
|
||||
, _gsWins :: Int
|
||||
-- ^ The number of wins
|
||||
, _gsLosses :: Int
|
||||
|
|
@ -411,28 +452,25 @@ instance FromJSON GoalieStats where
|
|||
<$> v .: "games"
|
||||
<*> v .: "mins_played"
|
||||
<*> v .: "goals_allowed"
|
||||
<*> v .: "goals_against"
|
||||
<*> v .: "wins"
|
||||
<*> v .: "losses"
|
||||
<*> v .: "ties"
|
||||
|
||||
instance ToJSON GoalieStats where
|
||||
toJSON (GoalieStats g m al ag w l t) = object
|
||||
toJSON (GoalieStats g m a w l t) = object
|
||||
[ "games" .= g
|
||||
, "mins_played" .= m
|
||||
, "goals_allowed" .= al
|
||||
, "goals_against" .= ag
|
||||
, "goals_allowed" .= a
|
||||
, "wins" .= w
|
||||
, "losses" .= l
|
||||
, "ties" .= t
|
||||
]
|
||||
toEncoding (GoalieStats g m al ag w l t) = pairs $
|
||||
"games" .= g <>
|
||||
"mins_played" .= m <>
|
||||
"goals_allowed" .= al <>
|
||||
"goals_against" .= ag <>
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
toEncoding (GoalieStats g m a w l t) = pairs $
|
||||
"games" .= g <>
|
||||
"mins_played" .= m <>
|
||||
"goals_allowed" .= a <>
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
"ties" .= t
|
||||
|
||||
-- | Game statistics
|
||||
|
|
@ -484,9 +522,28 @@ data Prompt = Prompt
|
|||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
|
|
@ -508,6 +565,13 @@ createPlayerStateL = lens
|
|||
_ -> newCreatePlayerState)
|
||||
(\_ cps -> CreatePlayer cps)
|
||||
|
||||
createGoalieStateL :: Lens' ProgMode CreateGoalieState
|
||||
createGoalieStateL = lens
|
||||
(\case
|
||||
CreateGoalie cgs -> cgs
|
||||
_ -> newCreateGoalieState)
|
||||
(\_ cgs -> CreateGoalie cgs)
|
||||
|
||||
-- | Constructor for a 'ProgState'
|
||||
newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
|
|
@ -536,6 +600,11 @@ newGameState = GameState
|
|||
, _confirmGoalDataFlag = False
|
||||
, _selectedPlayer = Nothing
|
||||
, _pMinsRecorded = False
|
||||
, _gameGoalieStats = M.empty
|
||||
, _gameSelectedGoalie = Nothing
|
||||
, _goalieMinsPlayed = Nothing
|
||||
, _goalsAllowed = Nothing
|
||||
, _goaliesRecorded = False
|
||||
}
|
||||
|
||||
-- | Constructor for a 'CreatePlayerState'
|
||||
|
|
@ -548,6 +617,15 @@ newCreatePlayerState = CreatePlayerState
|
|||
, _cpsFailureCallback = return ()
|
||||
}
|
||||
|
||||
-- | Constructor for a 'CreateGoalieState'
|
||||
newCreateGoalieState :: CreateGoalieState
|
||||
newCreateGoalieState = CreateGoalieState
|
||||
{ _cgsNumber = Nothing
|
||||
, _cgsName = ""
|
||||
, _cgsSuccessCallback = return ()
|
||||
, _cgsFailureCallback = return ()
|
||||
}
|
||||
|
||||
-- | Constructor for a 'Database'
|
||||
newDatabase :: Database
|
||||
newDatabase = Database
|
||||
|
|
@ -603,7 +681,6 @@ newGoalieStats = GoalieStats
|
|||
{ _gsGames = 0
|
||||
, _gsMinsPlayed = 0
|
||||
, _gsGoalsAllowed = 0
|
||||
, _gsGoalsAgainst = 0
|
||||
, _gsWins = 0
|
||||
, _gsLosses = 0
|
||||
, _gsTies = 0
|
||||
|
|
@ -757,3 +834,33 @@ addPlayerStats s1 s2 = newPlayerStats
|
|||
& psGoals .~ s1^.psGoals + s2^.psGoals
|
||||
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||
& psPMin .~ s1^.psPMin + s2^.psPMin
|
||||
|
||||
-- | Searches a list of goalies
|
||||
goalieSearch
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
|
||||
zip [0..]
|
||||
|
||||
-- | Searches a list of goalies for an exact match
|
||||
goalieSearchExact
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> Maybe (Int, Goalie)
|
||||
-- ^ The result with its index number
|
||||
goalieSearchExact sStr goalies = let
|
||||
results = filter (\(_, goalie) -> sStr == goalie^.gName) $
|
||||
zip [0..] goalies
|
||||
in case results of
|
||||
[] -> Nothing
|
||||
result:_ -> Just result
|
||||
|
||||
-- | Provides a description string for a 'Goalie'
|
||||
goalieSummary :: Goalie -> String
|
||||
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
||||
|
|
|
|||
|
|
@ -43,6 +43,8 @@ import Mtlstats.Actions
|
|||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Actions" $ do
|
||||
startNewSeasonSpec
|
||||
|
|
@ -54,12 +56,17 @@ spec = describe "Mtlstats.Actions" $ do
|
|||
updateGameStatsSpec
|
||||
validateGameDateSpec
|
||||
createPlayerSpec
|
||||
createGoalieSpec
|
||||
addPlayerSpec
|
||||
addGoalieSpec
|
||||
resetCreatePlayerStateSpec
|
||||
resetCreateGoalieStateSpec
|
||||
recordGoalAssistsSpec
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
recordGoalieStatsSpec
|
||||
backHomeSpec
|
||||
scrollUpSpec
|
||||
scrollDownSpec
|
||||
|
|
@ -117,14 +124,12 @@ resetYtdSpec = describe "resetYtd" $
|
|||
ytd ^. gsGames `shouldBe` 0
|
||||
ytd ^. gsMinsPlayed `shouldBe` 0
|
||||
ytd ^. gsGoalsAllowed `shouldBe` 0
|
||||
ytd ^. gsGoalsAgainst `shouldBe` 0
|
||||
ytd ^. gsWins `shouldBe` 0
|
||||
ytd ^. gsLosses `shouldBe` 0
|
||||
ytd ^. gsTies `shouldBe` 0
|
||||
lt ^. gsGames `shouldNotBe` 0
|
||||
lt ^. gsMinsPlayed `shouldNotBe` 0
|
||||
lt ^. gsGoalsAllowed `shouldNotBe` 0
|
||||
lt ^. gsGoalsAgainst `shouldNotBe` 0
|
||||
lt ^. gsWins `shouldNotBe` 0
|
||||
lt ^. gsLosses `shouldNotBe` 0
|
||||
lt ^. gsTies `shouldNotBe` 0) $
|
||||
|
|
@ -355,6 +360,12 @@ createPlayerSpec = describe "createPlayer" $
|
|||
s = createPlayer newProgState
|
||||
in show (s^.progMode) `shouldBe` "CreatePlayer"
|
||||
|
||||
createGoalieSpec :: Spec
|
||||
createGoalieSpec = describe "createGoalie" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = createGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||
|
||||
addPlayerSpec :: Spec
|
||||
addPlayerSpec = describe "addPlayer" $ do
|
||||
let
|
||||
|
|
@ -379,6 +390,48 @@ addPlayerSpec = describe "addPlayer" $ do
|
|||
s' = addPlayer $ s MainMenu
|
||||
in s'^.database.dbPlayers `shouldBe` [p1]
|
||||
|
||||
addGoalieSpec :: Spec
|
||||
addGoalieSpec = describe "addGoalie" $ do
|
||||
let
|
||||
g1 = newGoalie 2 "Joe"
|
||||
g2 = newGoalie 3 "Bob"
|
||||
db = newDatabase
|
||||
& dbGoalies .~ [g1]
|
||||
s pm = newProgState
|
||||
& database .~ db
|
||||
& progMode .~ pm
|
||||
|
||||
context "data available" $
|
||||
it "should create the goalie" $ let
|
||||
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
|
||||
& cgsNumber ?~ 3
|
||||
& cgsName .~ "Bob"
|
||||
in s'^.database.dbGoalies `shouldBe` [g1, g2]
|
||||
|
||||
context "data unavailable" $
|
||||
it "should not create the goalie" $ let
|
||||
s' = addGoalie $ s MainMenu
|
||||
in s'^.database.dbGoalies `shouldBe` [g1]
|
||||
|
||||
resetCreatePlayerStateSpec :: Spec
|
||||
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
||||
cps = newCreatePlayerState
|
||||
& cpsNumber ?~ 1
|
||||
& cpsName .~ "Joe"
|
||||
& cpsPosition .~ "centre"
|
||||
ps = resetCreatePlayerState $
|
||||
newProgState & progMode.createPlayerStateL .~ cps
|
||||
in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
|
||||
|
||||
resetCreateGoalieStateSpec :: Spec
|
||||
resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
||||
cgs = newCreateGoalieState
|
||||
& cgsNumber ?~ 1
|
||||
& cgsName .~ "Joe"
|
||||
ps = resetCreateGoalieState $
|
||||
newProgState & progMode.createGoalieStateL .~ cgs
|
||||
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||
|
||||
recordGoalAssistsSpec :: Spec
|
||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||
let
|
||||
|
|
@ -618,6 +671,137 @@ assignPMinsSpec = describe "assignPMins" $ let
|
|||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
recordGoalieStatsSpec :: Spec
|
||||
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
goalieStats mins goals = newGoalieStats
|
||||
& gsMinsPlayed .~ mins
|
||||
& gsGoalsAllowed .~ goals
|
||||
|
||||
joe = newGoalie 2 "Joe"
|
||||
& gYtd .~ goalieStats 10 11
|
||||
& gLifetime .~ goalieStats 12 13
|
||||
|
||||
bob = newGoalie 3 "Bob"
|
||||
& gYtd .~ goalieStats 14 15
|
||||
& gLifetime .~ goalieStats 16 17
|
||||
|
||||
gameState n mins goals = newGameState
|
||||
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2)]
|
||||
& gameSelectedGoalie .~ n
|
||||
& goalieMinsPlayed .~ mins
|
||||
& goalsAllowed .~ goals
|
||||
|
||||
progState n mins goals = newProgState
|
||||
& database.dbGoalies .~ [joe, bob]
|
||||
& progMode.gameStateL .~ gameState n mins goals
|
||||
|
||||
in mapM_
|
||||
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
|
||||
s = recordGoalieStats $ progState gid mins goals
|
||||
in context name $ do
|
||||
|
||||
mapM_
|
||||
(\(name, gid, (gMins, gGoals, ytdMins, ytdGoals, ltMins, ltGoals)) ->
|
||||
context name $ do
|
||||
let
|
||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats gid gs
|
||||
goalie = fromJust $ nth gid $ s^.database.dbGoalies
|
||||
ytd = goalie^.gYtd
|
||||
lt = goalie^.gLifetime
|
||||
|
||||
context "game minutes played" $
|
||||
it ("should be " ++ show gMins) $
|
||||
game^.gsMinsPlayed `shouldBe` gMins
|
||||
|
||||
context "game goals allowed" $
|
||||
it ("should be " ++ show gGoals) $
|
||||
game^.gsGoalsAllowed `shouldBe` gGoals
|
||||
|
||||
context "year-to-date minutes played" $
|
||||
it ("should be " ++ show ytdMins) $
|
||||
ytd^.gsMinsPlayed `shouldBe` ytdMins
|
||||
|
||||
context "year-to-date goals allowed" $
|
||||
it ("should be " ++ show ytdGoals) $
|
||||
ytd^.gsGoalsAllowed `shouldBe` ytdGoals
|
||||
|
||||
context "lifetime minutes played" $
|
||||
it ("should be " ++ show ltMins) $
|
||||
lt^.gsMinsPlayed `shouldBe` ltMins
|
||||
|
||||
context "lifetime goals allowed" $
|
||||
it ("should be " ++ show ltGoals) $
|
||||
lt^.gsGoalsAllowed `shouldBe` ltGoals)
|
||||
[ ( "Joe", 0, joeData )
|
||||
, ( "Bob", 1, bobData )
|
||||
]
|
||||
|
||||
context "selected goalie" $ let
|
||||
expected = if reset then Nothing else gid
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||
|
||||
context "minutes played" $ let
|
||||
expected = if reset then Nothing else mins
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.goalieMinsPlayed) `shouldBe` expected
|
||||
|
||||
context "goals allowed" $ let
|
||||
expected = if reset then Nothing else goals
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.goalsAllowed) `shouldBe` expected)
|
||||
|
||||
[ ( "Joe"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Just 2
|
||||
, ( 1, 2, 11, 13, 13, 15 )
|
||||
, ( 1, 2, 14, 15, 16, 17 )
|
||||
, True
|
||||
)
|
||||
, ( "Bob"
|
||||
, Just 1
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 10, 11, 12, 13 )
|
||||
, (2, 4, 15, 17, 17, 19 )
|
||||
, True
|
||||
)
|
||||
, ( "goalie out of bounds"
|
||||
, Just 2
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 10, 11, 12, 13 )
|
||||
, (1, 2, 14, 15, 16, 17 )
|
||||
, False
|
||||
)
|
||||
, ( "missing goalie"
|
||||
, Nothing
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 10, 11, 12, 13 )
|
||||
, (1, 2, 14, 15, 16, 17 )
|
||||
, False
|
||||
)
|
||||
, ( "missing minutes"
|
||||
, Just 0
|
||||
, Nothing
|
||||
, Just 1
|
||||
, (0, 0, 10, 11, 12, 13 )
|
||||
, (1, 2, 14, 15, 16, 17 )
|
||||
, False
|
||||
)
|
||||
, ( "missing goals"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Nothing
|
||||
, (0, 0, 10, 11, 12, 13 )
|
||||
, (1, 2, 14, 15, 16, 17 )
|
||||
, False
|
||||
)
|
||||
]
|
||||
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
|
|
@ -647,7 +831,6 @@ makeGoalieStats = GoalieStats
|
|||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
|
||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||
|
||||
module TypesSpec (spec) where
|
||||
module TypesSpec (Comparable (..), spec) where
|
||||
|
||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||
import Data.Aeson.Types (Value (Object))
|
||||
|
|
@ -35,6 +35,9 @@ import Mtlstats.Types
|
|||
|
||||
import qualified Types.MenuSpec as Menu
|
||||
|
||||
class Comparable a where
|
||||
compareTest :: a -> a -> Spec
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Types" $ do
|
||||
playerSpec
|
||||
|
|
@ -43,6 +46,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||
databaseSpec
|
||||
gameStateLSpec
|
||||
createPlayerStateLSpec
|
||||
createGoalieStateLSpec
|
||||
teamScoreSpec
|
||||
otherScoreSpec
|
||||
homeTeamSpec
|
||||
|
|
@ -61,6 +65,9 @@ spec = describe "Mtlstats.Types" $ do
|
|||
playerIsActiveSpec
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
goalieSearchSpec
|
||||
goalieSearchExactSpec
|
||||
goalieSummarySpec
|
||||
Menu.spec
|
||||
|
||||
playerSpec :: Spec
|
||||
|
|
@ -79,43 +86,60 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
|
|||
gameStateLSpec :: Spec
|
||||
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
|
||||
-- getters
|
||||
[ ( MainMenu, newGameState )
|
||||
, ( NewGame $ gs HomeGame, gs HomeGame )
|
||||
[ ( "missing state", MainMenu, newGameState )
|
||||
, ( "home game", NewGame $ gs HomeGame, gs HomeGame )
|
||||
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
|
||||
]
|
||||
-- setters
|
||||
[ ( MainMenu, gs HomeGame )
|
||||
, ( NewGame $ gs HomeGame, gs AwayGame )
|
||||
, ( NewGame $ gs HomeGame, newGameState )
|
||||
[ ( "set home", MainMenu, gs HomeGame )
|
||||
, ( "home to away", NewGame $ gs HomeGame, gs AwayGame )
|
||||
, ( "away to home", NewGame $ gs AwayGame, gs HomeGame )
|
||||
, ( "clear home", NewGame $ gs HomeGame, newGameState )
|
||||
, ( "clear away", NewGame $ gs AwayGame, newGameState )
|
||||
]
|
||||
where gs t = newGameState & gameType ?~ t
|
||||
|
||||
createPlayerStateLSpec :: Spec
|
||||
createPlayerStateLSpec = describe "createPlayerStateL" $ do
|
||||
context "getters" $ do
|
||||
context "state missing" $ let
|
||||
pm = MainMenu
|
||||
cps = pm^.createPlayerStateL
|
||||
in it "should not have a number" $
|
||||
cps^.cpsNumber `shouldBe` Nothing
|
||||
createPlayerStateLSpec = describe "createPlayerStateL" $
|
||||
lensSpec createPlayerStateL
|
||||
-- getters
|
||||
[ ( "missing state", MainMenu, newCreatePlayerState )
|
||||
, ( "with state", CreatePlayer cps1, cps1 )
|
||||
]
|
||||
-- setters
|
||||
[ ( "missing state", MainMenu, cps1 )
|
||||
, ( "change state", CreatePlayer cps1, cps2 )
|
||||
, ( "clear state", CreatePlayer cps1, newCreatePlayerState )
|
||||
]
|
||||
where
|
||||
cps1 = newCreatePlayerState
|
||||
& cpsNumber ?~ 1
|
||||
& cpsName .~ "Joe"
|
||||
& cpsPosition .~ "centre"
|
||||
cps2 = newCreatePlayerState
|
||||
& cpsNumber ?~ 2
|
||||
& cpsName .~ "Bob"
|
||||
& cpsPosition .~ "defense"
|
||||
|
||||
context "existing state" $ let
|
||||
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
|
||||
cps = pm^.createPlayerStateL
|
||||
in it "should have a number of 1" $
|
||||
cps^.cpsNumber `shouldBe` Just 1
|
||||
|
||||
context "setters" $ do
|
||||
context "state missing" $ let
|
||||
pm = MainMenu
|
||||
pm' = pm & createPlayerStateL.cpsNumber ?~ 1
|
||||
in it "should set the player number to 1" $
|
||||
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
|
||||
|
||||
context "existing state" $ let
|
||||
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
|
||||
pm' = pm & createPlayerStateL.cpsNumber ?~ 2
|
||||
in it "should set the player number to 2" $
|
||||
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
|
||||
createGoalieStateLSpec :: Spec
|
||||
createGoalieStateLSpec = describe "createGoalieStateL" $
|
||||
lensSpec createGoalieStateL
|
||||
-- getters
|
||||
[ ( "missing state", MainMenu, newCreateGoalieState )
|
||||
, ( "with state", CreateGoalie cgs1, cgs1 )
|
||||
]
|
||||
-- setters
|
||||
[ ( "set state", MainMenu, cgs1 )
|
||||
, ( "change state", CreateGoalie cgs1, cgs2 )
|
||||
, ( "clear state", CreateGoalie cgs1, newCreateGoalieState )
|
||||
]
|
||||
where
|
||||
cgs1 = newCreateGoalieState
|
||||
& cgsNumber ?~ 1
|
||||
& cgsName .~ "Joe"
|
||||
cgs2 = newCreateGoalieState
|
||||
& cgsNumber ?~ 2
|
||||
& cgsName .~ "Bob"
|
||||
|
||||
teamScoreSpec :: Spec
|
||||
teamScoreSpec = describe "teamScore" $ do
|
||||
|
|
@ -177,24 +201,23 @@ jsonSpec x j = do
|
|||
decode (encode x) `shouldBe` Just x
|
||||
|
||||
lensSpec
|
||||
:: (Eq a, Show s, Show a)
|
||||
:: Comparable a
|
||||
=> Lens' s a
|
||||
-> [(s, a)]
|
||||
-> [(s, a)]
|
||||
-> [(String, s, a)]
|
||||
-> [(String, s, a)]
|
||||
-> Spec
|
||||
lensSpec l gs ss = do
|
||||
lensSpec lens getters setters = do
|
||||
|
||||
context "getters" $ mapM_
|
||||
(\(s, x) -> context (show s) $
|
||||
it ("should be " ++ show x) $
|
||||
s ^. l `shouldBe` x)
|
||||
gs
|
||||
(\(label, s, x) -> context label $
|
||||
compareTest (s^.lens) x)
|
||||
getters
|
||||
|
||||
context "setters" $ mapM_
|
||||
(\(s, x) -> context (show s) $
|
||||
it ("should set to " ++ show x) $
|
||||
(s & l .~ x) ^. l `shouldBe` x)
|
||||
ss
|
||||
(\(label, s, x) -> context label $ let
|
||||
s' = s & lens .~ x
|
||||
in compareTest (s'^.lens) x)
|
||||
setters
|
||||
|
||||
player :: Player
|
||||
player = newPlayer 1 "Joe" "centre"
|
||||
|
|
@ -241,20 +264,18 @@ goalieStats n = newGoalieStats
|
|||
& gsGames .~ n
|
||||
& gsMinsPlayed .~ n + 1
|
||||
& gsGoalsAllowed .~ n + 2
|
||||
& gsGoalsAgainst .~ n + 3
|
||||
& gsWins .~ n + 4
|
||||
& gsLosses .~ n + 5
|
||||
& gsTies .~ n + 6
|
||||
& gsWins .~ n + 3
|
||||
& gsLosses .~ n + 4
|
||||
& gsTies .~ n + 5
|
||||
|
||||
goalieStatsJSON :: Int -> Value
|
||||
goalieStatsJSON n = Object $ HM.fromList
|
||||
[ ( "games", toJSON n )
|
||||
, ( "mins_played", toJSON $ n + 1 )
|
||||
, ( "goals_allowed", toJSON $ n + 2 )
|
||||
, ( "goals_against", toJSON $ n + 3 )
|
||||
, ( "wins", toJSON $ n + 4 )
|
||||
, ( "losses", toJSON $ n + 5 )
|
||||
, ( "ties", toJSON $ n + 6 )
|
||||
, ( "wins", toJSON $ n + 3 )
|
||||
, ( "losses", toJSON $ n + 4 )
|
||||
, ( "ties", toJSON $ n + 5 )
|
||||
]
|
||||
|
||||
gameStats :: Int -> GameStats
|
||||
|
|
@ -633,6 +654,57 @@ addPlayerStatsSpec = describe "addPlayerStats" $ do
|
|||
it "should be 9" $
|
||||
s3^.psPMin `shouldBe` 9
|
||||
|
||||
goalieSearchSpec :: Spec
|
||||
goalieSearchSpec = describe "goalieSearch" $ do
|
||||
let
|
||||
goalies =
|
||||
[ newGoalie 2 "Joe"
|
||||
, newGoalie 3 "Bob"
|
||||
, newGoalie 5 "Steve"
|
||||
]
|
||||
result n = (n, goalies!!n)
|
||||
|
||||
context "partial match" $
|
||||
it "should return Joe and Steve" $
|
||||
goalieSearch "e" goalies `shouldBe` [result 0, result 2]
|
||||
|
||||
context "no match" $
|
||||
it "should return an empty list" $
|
||||
goalieSearch "x" goalies `shouldBe` []
|
||||
|
||||
context "exact match" $
|
||||
it "should return Steve" $
|
||||
goalieSearch "Bob" goalies `shouldBe` [result 1]
|
||||
|
||||
goalieSearchExactSpec :: Spec
|
||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||
let
|
||||
goalies =
|
||||
[ newGoalie 2 "Joe"
|
||||
, newGoalie 3 "Bob"
|
||||
, newGoalie 5 "Steve"
|
||||
]
|
||||
result n = (n, goalies!!n)
|
||||
|
||||
mapM_
|
||||
(\(name, num) -> context name $
|
||||
it ("should return " ++ name) $
|
||||
goalieSearchExact name goalies `shouldBe` Just (result num))
|
||||
-- name, num
|
||||
[ ( "Joe", 0 )
|
||||
, ( "Bob", 1 )
|
||||
, ( "Steve", 2 )
|
||||
]
|
||||
|
||||
context "Greg" $
|
||||
it "should return Nothing" $
|
||||
goalieSearchExact "Greg" goalies `shouldBe` Nothing
|
||||
|
||||
goalieSummarySpec :: Spec
|
||||
goalieSummarySpec = describe "goalieSummary" $
|
||||
it "should provide a summary string" $
|
||||
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
||||
|
||||
joe :: Player
|
||||
joe = newPlayer 2 "Joe" "center"
|
||||
|
||||
|
|
@ -641,3 +713,34 @@ bob = newPlayer 3 "Bob" "defense"
|
|||
|
||||
steve :: Player
|
||||
steve = newPlayer 5 "Steve" "forward"
|
||||
|
||||
instance Comparable GameState where
|
||||
compareTest actual expected =
|
||||
it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected
|
||||
|
||||
instance Comparable CreatePlayerState where
|
||||
compareTest actual expected = do
|
||||
|
||||
describe "cpsNumber" $
|
||||
it ("should be " ++ show (expected^.cpsNumber)) $
|
||||
actual^.cpsNumber `shouldBe` expected^.cpsNumber
|
||||
|
||||
describe "cpsName" $
|
||||
it ("should be " ++ expected^.cpsName) $
|
||||
actual^.cpsName `shouldBe` expected^.cpsName
|
||||
|
||||
describe "cpsPosition" $
|
||||
it ("should be " ++ expected^.cpsPosition) $
|
||||
actual^.cpsPosition `shouldBe` expected^.cpsPosition
|
||||
|
||||
instance Comparable CreateGoalieState where
|
||||
compareTest actual expected = do
|
||||
|
||||
describe "cgsNuber" $
|
||||
it("should be " ++ show (expected^.cgsNumber)) $
|
||||
actual^.cgsNumber `shouldBe` expected^.cgsNumber
|
||||
|
||||
describe "cgsName" $
|
||||
it ("should be " ++ expected^.cgsName) $
|
||||
actual^.cgsName `shouldBe` expected^.cgsName
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user