commit
4985d2694a
|
@ -32,8 +32,10 @@ module Mtlstats.Actions
|
||||||
, validateGameDate
|
, validateGameDate
|
||||||
, createPlayer
|
, createPlayer
|
||||||
, addPlayer
|
, addPlayer
|
||||||
|
, awardGoal
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time.Calendar (fromGregorianValid)
|
import Data.Time.Calendar (fromGregorianValid)
|
||||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
||||||
|
@ -116,7 +118,13 @@ validateGameDate s = fromMaybe s $ do
|
||||||
|
|
||||||
-- | Starts player creation mode
|
-- | Starts player creation mode
|
||||||
createPlayer :: ProgState -> ProgState
|
createPlayer :: ProgState -> ProgState
|
||||||
createPlayer = progMode .~ CreatePlayer newCreatePlayerState
|
createPlayer = let
|
||||||
|
cb = modify $ progMode .~ MainMenu
|
||||||
|
cps
|
||||||
|
= newCreatePlayerState
|
||||||
|
& cpsSuccessCallback .~ cb
|
||||||
|
& cpsFailureCallback .~ cb
|
||||||
|
in progMode .~ CreatePlayer cps
|
||||||
|
|
||||||
-- | Adds the entered player to the roster
|
-- | Adds the entered player to the roster
|
||||||
addPlayer :: ProgState -> ProgState
|
addPlayer :: ProgState -> ProgState
|
||||||
|
@ -129,3 +137,18 @@ addPlayer s = fromMaybe s $ do
|
||||||
player = newPlayer num name pos
|
player = newPlayer num name pos
|
||||||
Just $ s & database.dbPlayers
|
Just $ s & database.dbPlayers
|
||||||
%~ (player:)
|
%~ (player:)
|
||||||
|
|
||||||
|
-- | Awards a goal to a player
|
||||||
|
awardGoal
|
||||||
|
:: Int
|
||||||
|
-- ^ The player's index number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
awardGoal n ps = ps
|
||||||
|
& database.dbPlayers
|
||||||
|
%~ map
|
||||||
|
(\(i, p) -> if i == n
|
||||||
|
then p
|
||||||
|
& pYtd.psGoals %~ succ
|
||||||
|
& pLifetime.psGoals %~ succ
|
||||||
|
else p) . zip [0..]
|
||||||
|
|
|
@ -24,3 +24,7 @@ module Mtlstats.Config where
|
||||||
-- | The name of the team whose stats we're tracking
|
-- | The name of the team whose stats we're tracking
|
||||||
myTeam :: String
|
myTeam :: String
|
||||||
myTeam = "MONTREAL"
|
myTeam = "MONTREAL"
|
||||||
|
|
||||||
|
-- | The maximum number of function keys
|
||||||
|
maxFunKeys :: Int
|
||||||
|
maxFunKeys = 9
|
||||||
|
|
|
@ -21,11 +21,12 @@ 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 (when)
|
import Control.Monad (join, when)
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Lens.Micro ((^.), (.~))
|
import Lens.Micro ((^.), (.~))
|
||||||
|
import Lens.Micro.Extras (view)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
@ -52,6 +53,7 @@ dispatch s = case s^.progMode of
|
||||||
| null $ gs^.awayScore -> awayScoreC
|
| null $ gs^.awayScore -> awayScoreC
|
||||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
| null $ gs^.overtimeFlag -> overtimeFlagC
|
||||||
| not $ gs^.dataVerified -> verifyDataC
|
| not $ gs^.dataVerified -> verifyDataC
|
||||||
|
| fromJust (unaccountedPoints gs) -> recordGoalC
|
||||||
| otherwise -> reportC
|
| otherwise -> reportC
|
||||||
CreatePlayer cps
|
CreatePlayer cps
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||||
|
@ -180,6 +182,19 @@ verifyDataC = Controller
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
|
recordGoalC :: Controller
|
||||||
|
recordGoalC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
game = s^.database.dbGames
|
||||||
|
goal = succ $ s^.progMode.gameStateL.pointsAccounted
|
||||||
|
in drawPrompt (recordGoalPrompt game goal) s
|
||||||
|
, handleController = \e -> do
|
||||||
|
game <- gets $ view $ database.dbGames
|
||||||
|
goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
|
||||||
|
promptHandler (recordGoalPrompt game goal) e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
reportC :: Controller
|
reportC :: Controller
|
||||||
reportC = Controller
|
reportC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> do
|
||||||
|
@ -237,8 +252,9 @@ confirmCreatePlayerC = Controller
|
||||||
case ynHandler e of
|
case ynHandler e of
|
||||||
Just True -> do
|
Just True -> do
|
||||||
modify addPlayer
|
modify addPlayer
|
||||||
modify $ progMode .~ MainMenu
|
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
|
||||||
Just False -> modify $ progMode .~ MainMenu
|
Just False ->
|
||||||
|
join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
|
@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Prompt (
|
module Mtlstats.Prompt (
|
||||||
-- * Prompt Functions
|
-- * Prompt Functions
|
||||||
drawPrompt,
|
drawPrompt,
|
||||||
|
@ -33,20 +35,25 @@ module Mtlstats.Prompt (
|
||||||
awayScorePrompt,
|
awayScorePrompt,
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
playerPosPrompt
|
playerPosPrompt,
|
||||||
|
selectPlayerPrompt,
|
||||||
|
recordGoalPrompt,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (isDigit, toUpper)
|
import Data.Char (isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Format
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Draws the prompt to the screen
|
-- | Draws the prompt to the screen
|
||||||
drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
|
drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
|
||||||
|
@ -66,8 +73,8 @@ promptHandler p (C.EventCharacter c) = let
|
||||||
modify $ addChar c'
|
modify $ addChar c'
|
||||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
||||||
modify removeChar
|
modify removeChar
|
||||||
promptHandler p (C.EventSpecialKey (C.KeyFunction k)) =
|
promptHandler p (C.EventSpecialKey k) =
|
||||||
promptFunctionKey p k
|
promptSpecialKey p k
|
||||||
promptHandler _ _ = return ()
|
promptHandler _ _ = return ()
|
||||||
|
|
||||||
-- | Builds a string prompt
|
-- | Builds a string prompt
|
||||||
|
@ -81,7 +88,7 @@ strPrompt pStr act = Prompt
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
{ promptDrawer = drawSimplePrompt pStr
|
||||||
, promptCharCheck = const True
|
, promptCharCheck = const True
|
||||||
, promptAction = act
|
, promptAction = act
|
||||||
, promptFunctionKey = const $ return ()
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Builds a numeric prompt
|
-- | Builds a numeric prompt
|
||||||
|
@ -95,7 +102,7 @@ numPrompt pStr act = Prompt
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
{ promptDrawer = drawSimplePrompt pStr
|
||||||
, promptCharCheck = isDigit
|
, promptCharCheck = isDigit
|
||||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
||||||
, promptFunctionKey = const $ return ()
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the game year
|
-- | Prompts for the game year
|
||||||
|
@ -138,5 +145,73 @@ playerPosPrompt :: Prompt
|
||||||
playerPosPrompt = strPrompt "Player position: " $
|
playerPosPrompt = strPrompt "Player position: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||||
|
|
||||||
|
-- | Selects a player (creating one if necessary)
|
||||||
|
selectPlayerPrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Maybe Int -> Action ())
|
||||||
|
-- ^ 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 -> 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
|
||||||
|
callback (Just 0)
|
||||||
|
& cpsFailureCallback .~ do
|
||||||
|
modify $ progMode .~ mode
|
||||||
|
callback Nothing
|
||||||
|
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 ()
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Prompts for the player who scored the goal
|
||||||
|
recordGoalPrompt
|
||||||
|
:: Int
|
||||||
|
-- ^ The game number
|
||||||
|
-> Int
|
||||||
|
-- ^ The goal number
|
||||||
|
-> Prompt
|
||||||
|
recordGoalPrompt game goal = selectPlayerPrompt
|
||||||
|
("*** GAME " ++ padNum 2 game ++ " ***\n" ++
|
||||||
|
"Who scored goal number " ++ show goal ++ "? ") $
|
||||||
|
\case
|
||||||
|
Nothing -> return ()
|
||||||
|
Just n -> modify
|
||||||
|
$ awardGoal n
|
||||||
|
. (progMode.gameStateL.pointsAccounted %~ succ)
|
||||||
|
|
||||||
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
||||||
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
||||||
|
|
|
@ -55,10 +55,13 @@ module Mtlstats.Types (
|
||||||
awayScore,
|
awayScore,
|
||||||
overtimeFlag,
|
overtimeFlag,
|
||||||
dataVerified,
|
dataVerified,
|
||||||
|
pointsAccounted,
|
||||||
-- ** CreatePlayerState Lenses
|
-- ** CreatePlayerState Lenses
|
||||||
cpsNumber,
|
cpsNumber,
|
||||||
cpsName,
|
cpsName,
|
||||||
cpsPosition,
|
cpsPosition,
|
||||||
|
cpsSuccessCallback,
|
||||||
|
cpsFailureCallback,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
|
@ -111,12 +114,15 @@ module Mtlstats.Types (
|
||||||
gameWon,
|
gameWon,
|
||||||
gameLost,
|
gameLost,
|
||||||
gameTied,
|
gameTied,
|
||||||
|
unaccountedPoints,
|
||||||
-- ** GameStats Helpers
|
-- ** GameStats Helpers
|
||||||
gmsGames,
|
gmsGames,
|
||||||
gmsPoints,
|
gmsPoints,
|
||||||
addGameStats,
|
addGameStats,
|
||||||
-- ** Player Helpers
|
-- ** Player Helpers
|
||||||
pPoints
|
pPoints,
|
||||||
|
playerSearch,
|
||||||
|
playerSearchExact
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (StateT)
|
import Control.Monad.Trans.State (StateT)
|
||||||
|
@ -132,6 +138,8 @@ import Data.Aeson
|
||||||
, (.:)
|
, (.:)
|
||||||
, (.=)
|
, (.=)
|
||||||
)
|
)
|
||||||
|
import Data.List (isInfixOf)
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
import Lens.Micro (Lens', lens, (&), (^.), (.~))
|
import Lens.Micro (Lens', lens, (&), (^.), (.~))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
@ -157,7 +165,7 @@ data ProgState = ProgState
|
||||||
-- ^ The program's mode
|
-- ^ The program's mode
|
||||||
, _inputBuffer :: String
|
, _inputBuffer :: String
|
||||||
-- ^ Buffer for user input
|
-- ^ Buffer for user input
|
||||||
} deriving (Eq, Show)
|
}
|
||||||
|
|
||||||
-- | The program mode
|
-- | The program mode
|
||||||
data ProgMode
|
data ProgMode
|
||||||
|
@ -165,7 +173,12 @@ data ProgMode
|
||||||
| NewSeason
|
| NewSeason
|
||||||
| NewGame GameState
|
| NewGame GameState
|
||||||
| CreatePlayer CreatePlayerState
|
| CreatePlayer CreatePlayerState
|
||||||
deriving (Eq, Show)
|
|
||||||
|
instance Show ProgMode where
|
||||||
|
show MainMenu = "MainMenu"
|
||||||
|
show NewSeason = "NewSeason"
|
||||||
|
show (NewGame _) = "NewGame"
|
||||||
|
show (CreatePlayer _) = "CreatePlayer"
|
||||||
|
|
||||||
-- | The game state
|
-- | The game state
|
||||||
data GameState = GameState
|
data GameState = GameState
|
||||||
|
@ -187,6 +200,7 @@ data GameState = GameState
|
||||||
-- ^ Indicates whether or not the game went into overtime
|
-- ^ Indicates whether or not the game went into overtime
|
||||||
, _dataVerified :: Bool
|
, _dataVerified :: Bool
|
||||||
-- ^ Set to 'True' when the user confirms the entered data
|
-- ^ Set to 'True' when the user confirms the entered data
|
||||||
|
, _pointsAccounted :: Int
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
-- | The type of game
|
-- | The type of game
|
||||||
|
@ -203,7 +217,11 @@ data CreatePlayerState = CreatePlayerState
|
||||||
-- ^ The player's name
|
-- ^ The player's name
|
||||||
, _cpsPosition :: String
|
, _cpsPosition :: String
|
||||||
-- ^ The player's position
|
-- ^ The player's position
|
||||||
} deriving (Eq, Show)
|
, _cpsSuccessCallback :: Action ()
|
||||||
|
-- ^ The function to call on success
|
||||||
|
, _cpsFailureCallback :: Action ()
|
||||||
|
-- ^ The function to call on failure
|
||||||
|
}
|
||||||
|
|
||||||
-- | Represents the database
|
-- | Represents the database
|
||||||
data Database = Database
|
data Database = Database
|
||||||
|
@ -420,8 +438,8 @@ data Prompt = Prompt
|
||||||
-- ^ Determines whether or not the character is valid
|
-- ^ Determines whether or not the character is valid
|
||||||
, promptAction :: String -> Action ()
|
, promptAction :: String -> Action ()
|
||||||
-- ^ Action to perform when the value is entered
|
-- ^ Action to perform when the value is entered
|
||||||
, promptFunctionKey :: Integer -> Action ()
|
, promptSpecialKey :: C.Key -> Action ()
|
||||||
-- ^ Action to perform when a function key is pressed
|
-- ^ Action to perform when a special key is pressed
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''ProgState
|
makeLenses ''ProgState
|
||||||
|
@ -468,6 +486,7 @@ newGameState = GameState
|
||||||
, _awayScore = Nothing
|
, _awayScore = Nothing
|
||||||
, _overtimeFlag = Nothing
|
, _overtimeFlag = Nothing
|
||||||
, _dataVerified = False
|
, _dataVerified = False
|
||||||
|
, _pointsAccounted = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'CreatePlayerState'
|
-- | Constructor for a 'CreatePlayerState'
|
||||||
|
@ -476,6 +495,8 @@ newCreatePlayerState = CreatePlayerState
|
||||||
{ _cpsNumber = Nothing
|
{ _cpsNumber = Nothing
|
||||||
, _cpsName = ""
|
, _cpsName = ""
|
||||||
, _cpsPosition = ""
|
, _cpsPosition = ""
|
||||||
|
, _cpsSuccessCallback = return ()
|
||||||
|
, _cpsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'Database'
|
-- | Constructor for a 'Database'
|
||||||
|
@ -593,6 +614,13 @@ gameLost gs = do
|
||||||
gameTied :: GameState -> Maybe Bool
|
gameTied :: GameState -> Maybe Bool
|
||||||
gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
|
gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
|
||||||
|
|
||||||
|
-- | Checks for unaccounted points
|
||||||
|
unaccountedPoints :: GameState -> Maybe Bool
|
||||||
|
unaccountedPoints gs = do
|
||||||
|
scored <- teamScore gs
|
||||||
|
let accounted = gs^.pointsAccounted
|
||||||
|
Just $ scored > accounted
|
||||||
|
|
||||||
-- | Calculates the number of games played
|
-- | Calculates the number of games played
|
||||||
gmsGames :: GameStats -> Int
|
gmsGames :: GameStats -> Int
|
||||||
gmsGames gs = gs^.gmsWins + gs^.gmsLosses + gs^.gmsOvertime
|
gmsGames gs = gs^.gmsWins + gs^.gmsLosses + gs^.gmsOvertime
|
||||||
|
@ -612,3 +640,30 @@ addGameStats s1 s2 = GameStats
|
||||||
-- | Calculates a player's points
|
-- | Calculates a player's points
|
||||||
pPoints :: PlayerStats -> Int
|
pPoints :: PlayerStats -> Int
|
||||||
pPoints s = s^.psGoals + s^.psAssists
|
pPoints s = s^.psGoals + s^.psAssists
|
||||||
|
|
||||||
|
-- | Searches through a list of players
|
||||||
|
playerSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Player]
|
||||||
|
-- ^ The list of players to search
|
||||||
|
-> [(Int, Player)]
|
||||||
|
-- ^ The matching players with their index numbers
|
||||||
|
playerSearch sStr =
|
||||||
|
filter (match sStr) .
|
||||||
|
zip [0..]
|
||||||
|
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
|
||||||
|
|
||||||
|
-- | Searches for a player by exact match on name
|
||||||
|
playerSearchExact
|
||||||
|
:: String
|
||||||
|
-- ^ The player's name
|
||||||
|
-> [Player]
|
||||||
|
-- ^ The list of players to search
|
||||||
|
-> Maybe (Int, Player)
|
||||||
|
-- ^ The player's index and value
|
||||||
|
playerSearchExact sStr =
|
||||||
|
listToMaybe .
|
||||||
|
filter (match sStr) .
|
||||||
|
zip [0..]
|
||||||
|
where match sStr (_, p) = p^.pName == sStr
|
||||||
|
|
|
@ -0,0 +1,29 @@
|
||||||
|
{- |
|
||||||
|
|
||||||
|
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.Util (nth) where
|
||||||
|
|
||||||
|
nth :: Int -> [a] -> Maybe a
|
||||||
|
nth _ [] = Nothing
|
||||||
|
nth n (x:xs)
|
||||||
|
| n == 0 = Just x
|
||||||
|
| n < 0 = Nothing
|
||||||
|
| otherwise = nth (pred n) xs
|
|
@ -41,6 +41,7 @@ spec = describe "Mtlstats.Actions" $ do
|
||||||
validateGameDateSpec
|
validateGameDateSpec
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
addPlayerSpec
|
addPlayerSpec
|
||||||
|
awardGoalSpec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
|
@ -50,7 +51,7 @@ startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
& startNewSeason
|
& startNewSeason
|
||||||
|
|
||||||
it "should set the progState to NewSeason" $
|
it "should set the progState to NewSeason" $
|
||||||
s ^. progMode `shouldBe` NewSeason
|
show (s^.progMode) `shouldBe` "NewSeason"
|
||||||
|
|
||||||
it "should set the number of games to 0" $
|
it "should set the number of games to 0" $
|
||||||
s ^. database . dbGames `shouldBe` 0
|
s ^. database . dbGames `shouldBe` 0
|
||||||
|
@ -63,7 +64,7 @@ startNewGameSpec = describe "startNewGame" $ do
|
||||||
s ^. database . dbGames `shouldBe` 1
|
s ^. database . dbGames `shouldBe` 1
|
||||||
|
|
||||||
it "should set the mode to NewGame" $
|
it "should set the mode to NewGame" $
|
||||||
s ^. progMode `shouldBe` NewGame newGameState
|
show (s^.progMode) `shouldBe` "NewGame"
|
||||||
|
|
||||||
resetYtdSpec :: Spec
|
resetYtdSpec :: Spec
|
||||||
resetYtdSpec = describe "resetYtd" $
|
resetYtdSpec = describe "resetYtd" $
|
||||||
|
@ -255,22 +256,26 @@ updateGameStatsSpec = describe "updateGameStats" $ do
|
||||||
context "missing game type" $
|
context "missing game type" $
|
||||||
it "should not change anything" $ let
|
it "should not change anything" $ let
|
||||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||||
in updateGameStats s' `shouldBe` s'
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1
|
||||||
|
|
||||||
context "missing home score" $
|
context "missing home score" $
|
||||||
it "should not change anything" $ let
|
it "should not change anything" $ let
|
||||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||||
in updateGameStats s' `shouldBe` s'
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1
|
||||||
|
|
||||||
context "missing away score" $
|
context "missing away score" $
|
||||||
it "should not change anything" $ let
|
it "should not change anything" $ let
|
||||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||||
in updateGameStats s' `shouldBe` s'
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1
|
||||||
|
|
||||||
context "missing overtime flag" $
|
context "missing overtime flag" $
|
||||||
it "should not change anything" $ let
|
it "should not change anything" $ let
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||||
in updateGameStats s' `shouldBe` s'
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1
|
||||||
|
|
||||||
validateGameDateSpec :: Spec
|
validateGameDateSpec :: Spec
|
||||||
validateGameDateSpec = describe "validateGameDate" $ do
|
validateGameDateSpec = describe "validateGameDate" $ do
|
||||||
|
@ -321,7 +326,7 @@ createPlayerSpec :: Spec
|
||||||
createPlayerSpec = describe "createPlayer" $
|
createPlayerSpec = describe "createPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
s = createPlayer newProgState
|
s = createPlayer newProgState
|
||||||
in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState
|
in show (s^.progMode) `shouldBe` "CreatePlayer"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
addPlayerSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
addPlayerSpec = describe "addPlayer" $ do
|
||||||
|
@ -347,6 +352,56 @@ addPlayerSpec = describe "addPlayer" $ do
|
||||||
s' = addPlayer $ s MainMenu
|
s' = addPlayer $ s MainMenu
|
||||||
in s'^.database.dbPlayers `shouldBe` [p2]
|
in s'^.database.dbPlayers `shouldBe` [p2]
|
||||||
|
|
||||||
|
awardGoalSpec :: Spec
|
||||||
|
awardGoalSpec = describe "awardGoal" $ do
|
||||||
|
let
|
||||||
|
joe
|
||||||
|
= newPlayer 2 "Joe" "centre"
|
||||||
|
& pYtd.psGoals .~ 1
|
||||||
|
& pLifetime.psGoals .~ 2
|
||||||
|
bob
|
||||||
|
= newPlayer 3 "Bob" "defense"
|
||||||
|
& pYtd.psGoals .~ 3
|
||||||
|
& pLifetime.psGoals .~ 4
|
||||||
|
db
|
||||||
|
= newDatabase
|
||||||
|
& dbPlayers .~ [joe, bob]
|
||||||
|
ps
|
||||||
|
= newProgState
|
||||||
|
& database .~ db
|
||||||
|
|
||||||
|
context "Joe" $ do
|
||||||
|
let
|
||||||
|
ps' = awardGoal 0 ps
|
||||||
|
player = head $ ps'^.database.dbPlayers
|
||||||
|
|
||||||
|
it "should increment Joe's year-to-date goals" $
|
||||||
|
player^.pYtd.psGoals `shouldBe` 2
|
||||||
|
|
||||||
|
it "should increment Joe's lifetime goals" $
|
||||||
|
player^.pLifetime.psGoals `shouldBe` 3
|
||||||
|
|
||||||
|
context "Bob" $ do
|
||||||
|
let
|
||||||
|
ps' = awardGoal 1 ps
|
||||||
|
player = last $ ps'^.database.dbPlayers
|
||||||
|
|
||||||
|
it "should increment Bob's year-to-data goals" $
|
||||||
|
player^.pYtd.psGoals `shouldBe` 4
|
||||||
|
|
||||||
|
it "should increment Bob's lifetime goals" $
|
||||||
|
player^.pLifetime.psGoals `shouldBe` 5
|
||||||
|
|
||||||
|
context "invalid index" $ let
|
||||||
|
ps' = awardGoal 2 ps
|
||||||
|
in it "should not change the database" $
|
||||||
|
ps'^.database `shouldBe` db
|
||||||
|
|
||||||
|
context "negative index" $ let
|
||||||
|
ps' = awardGoal (-1) ps
|
||||||
|
in it "should not change the database" $
|
||||||
|
ps'^.database `shouldBe` db
|
||||||
|
|
||||||
makePlayer :: IO Player
|
makePlayer :: IO Player
|
||||||
makePlayer = Player
|
makePlayer = Player
|
||||||
<$> makeNum
|
<$> makeNum
|
||||||
|
|
|
@ -26,6 +26,7 @@ import qualified FormatSpec as Format
|
||||||
import qualified HandlersSpec as Handlers
|
import qualified HandlersSpec as Handlers
|
||||||
import qualified ReportSpec as Report
|
import qualified ReportSpec as Report
|
||||||
import qualified TypesSpec as Types
|
import qualified TypesSpec as Types
|
||||||
|
import qualified UtilSpec as Util
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec $ do
|
main = hspec $ do
|
||||||
|
@ -34,3 +35,4 @@ main = hspec $ do
|
||||||
Format.spec
|
Format.spec
|
||||||
Handlers.spec
|
Handlers.spec
|
||||||
Report.spec
|
Report.spec
|
||||||
|
Util.spec
|
||||||
|
|
|
@ -50,10 +50,13 @@ spec = describe "Mtlstats.Types" $ do
|
||||||
gameWonSpec
|
gameWonSpec
|
||||||
gameLostSpec
|
gameLostSpec
|
||||||
gameTiedSpec
|
gameTiedSpec
|
||||||
|
unaccountedPointsSpec
|
||||||
gmsGamesSpec
|
gmsGamesSpec
|
||||||
gmsPointsSpec
|
gmsPointsSpec
|
||||||
addGameStatsSpec
|
addGameStatsSpec
|
||||||
pPointsSpec
|
pPointsSpec
|
||||||
|
playerSearchSpec
|
||||||
|
playerSearchExactSpec
|
||||||
Menu.spec
|
Menu.spec
|
||||||
|
|
||||||
playerSpec :: Spec
|
playerSpec :: Spec
|
||||||
|
@ -83,21 +86,32 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
|
||||||
where gs t = newGameState & gameType ?~ t
|
where gs t = newGameState & gameType ?~ t
|
||||||
|
|
||||||
createPlayerStateLSpec :: Spec
|
createPlayerStateLSpec :: Spec
|
||||||
createPlayerStateLSpec = describe "createPlayerStateL" $
|
createPlayerStateLSpec = describe "createPlayerStateL" $ do
|
||||||
lensSpec createPlayerStateL
|
context "getters" $ do
|
||||||
-- getters
|
context "state missing" $ let
|
||||||
[ ( MainMenu, newCreatePlayerState )
|
pm = MainMenu
|
||||||
, ( CreatePlayer $ cps 1 , cps 1 )
|
cps = pm^.createPlayerStateL
|
||||||
]
|
in it "should not have a number" $
|
||||||
-- setters
|
cps^.cpsNumber `shouldBe` Nothing
|
||||||
[ ( MainMenu, cps 1 )
|
|
||||||
, ( CreatePlayer $ cps 1, cps 2 )
|
context "existing state" $ let
|
||||||
]
|
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
|
||||||
where
|
cps = pm^.createPlayerStateL
|
||||||
cps n = newCreatePlayerState
|
in it "should have a number of 1" $
|
||||||
& cpsNumber ?~ n
|
cps^.cpsNumber `shouldBe` Just 1
|
||||||
& cpsName .~ "foo"
|
|
||||||
& cpsPosition .~ "bar"
|
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
|
||||||
|
|
||||||
teamScoreSpec :: Spec
|
teamScoreSpec :: Spec
|
||||||
teamScoreSpec = describe "teamScore" $ do
|
teamScoreSpec = describe "teamScore" $ do
|
||||||
|
@ -388,6 +402,35 @@ gameTiedSpec = describe "gameTied" $ mapM_
|
||||||
, ( Just 1, Just 2, Just False )
|
, ( Just 1, Just 2, Just False )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
unaccountedPointsSpec :: Spec
|
||||||
|
unaccountedPointsSpec = describe "unaccounted points" $ do
|
||||||
|
context "no data" $
|
||||||
|
it "should return Nothing" $
|
||||||
|
unaccountedPoints newGameState `shouldBe` Nothing
|
||||||
|
|
||||||
|
context "unaccounted points" $
|
||||||
|
it "should return True" $ let
|
||||||
|
gs = newGameState
|
||||||
|
& gameType ?~ HomeGame
|
||||||
|
& homeScore ?~ 1
|
||||||
|
in unaccountedPoints gs `shouldBe` Just True
|
||||||
|
|
||||||
|
context "all points accounted" $
|
||||||
|
it "should return False" $ let
|
||||||
|
gs = newGameState
|
||||||
|
& gameType ?~ HomeGame
|
||||||
|
& homeScore ?~ 1
|
||||||
|
& pointsAccounted .~ 1
|
||||||
|
in unaccountedPoints gs `shouldBe` Just False
|
||||||
|
|
||||||
|
context "more points accounted" $
|
||||||
|
it "should return True" $ let
|
||||||
|
gs = newGameState
|
||||||
|
& gameType ?~ HomeGame
|
||||||
|
& homeScore ?~ 1
|
||||||
|
& pointsAccounted .~ 2
|
||||||
|
in unaccountedPoints gs `shouldBe` Just False
|
||||||
|
|
||||||
gmsGamesSpec :: Spec
|
gmsGamesSpec :: Spec
|
||||||
gmsGamesSpec = describe "gmsGames" $ mapM_
|
gmsGamesSpec = describe "gmsGames" $ mapM_
|
||||||
(\(w, l, ot, expected) -> let
|
(\(w, l, ot, expected) -> let
|
||||||
|
@ -471,3 +514,39 @@ pPointsSpec = describe "pPoints" $ mapM_
|
||||||
, ( 0, 1, 1 )
|
, ( 0, 1, 1 )
|
||||||
, ( 2, 3, 5 )
|
, ( 2, 3, 5 )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
playerSearchSpec :: Spec
|
||||||
|
playerSearchSpec = describe "playerSearch" $ mapM_
|
||||||
|
(\(sStr, expected) -> context sStr $
|
||||||
|
it ("should return " ++ show expected) $ let
|
||||||
|
ps = [joe, bob, steve]
|
||||||
|
in playerSearch sStr ps `shouldBe` expected)
|
||||||
|
-- search, result
|
||||||
|
[ ( "Joe", [(0, joe)] )
|
||||||
|
, ( "o", [(0, joe), (1, bob)] )
|
||||||
|
, ( "e", [(0, joe), (2, steve)] )
|
||||||
|
, ( "x", [] )
|
||||||
|
]
|
||||||
|
|
||||||
|
playerSearchExactSpec :: Spec
|
||||||
|
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||||
|
(\(sStr, expected) -> context sStr $
|
||||||
|
it ("should be " ++ show expected) $ let
|
||||||
|
ps = [joe, bob, steve]
|
||||||
|
in playerSearchExact sStr ps `shouldBe` expected)
|
||||||
|
-- search, result
|
||||||
|
[ ( "Joe", Just (0, joe) )
|
||||||
|
, ( "Bob", Just (1, bob) )
|
||||||
|
, ( "Steve", Just (2, steve) )
|
||||||
|
, ( "Sam", Nothing )
|
||||||
|
, ( "", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
joe :: Player
|
||||||
|
joe = newPlayer 2 "Joe" "center"
|
||||||
|
|
||||||
|
bob :: Player
|
||||||
|
bob = newPlayer 3 "Bob" "defense"
|
||||||
|
|
||||||
|
steve :: Player
|
||||||
|
steve = newPlayer 5 "Steve" "forward"
|
||||||
|
|
|
@ -0,0 +1,44 @@
|
||||||
|
{-
|
||||||
|
|
||||||
|
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 UtilSpec (spec) where
|
||||||
|
|
||||||
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Mtlstats.Util"
|
||||||
|
nthSpec
|
||||||
|
|
||||||
|
nthSpec :: Spec
|
||||||
|
nthSpec = describe "nth" $ mapM_
|
||||||
|
(\(n, expected) -> context (show n) $
|
||||||
|
it ("should be " ++ show expected) $ let
|
||||||
|
xs = ["foo", "bar", "baz"]
|
||||||
|
in nth n xs `shouldBe` expected)
|
||||||
|
-- index, expected
|
||||||
|
[ ( 0, Just "foo" )
|
||||||
|
, ( 1, Just "bar" )
|
||||||
|
, ( 2, Just "baz" )
|
||||||
|
, ( 3, Nothing )
|
||||||
|
, ( -1, Nothing )
|
||||||
|
]
|
Loading…
Reference in New Issue
Block a user