mtlstats/src/Mtlstats/Actions.hs

101 lines
3.1 KiB
Haskell
Raw Normal View History

2019-08-20 11:17:24 -04:00
{- |
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/>.
-}
2019-08-24 17:01:18 -04:00
{-# LANGUAGE LambdaCase #-}
2019-08-20 12:50:39 -04:00
module Mtlstats.Actions
( startNewSeason
, resetYtd
, startNewGame
2019-08-24 16:23:56 -04:00
, addChar
, removeChar
2019-08-29 00:12:30 -04:00
, overtimeCheck
2019-08-30 01:21:17 -04:00
, updateGameStats
2019-08-20 12:50:39 -04:00
) where
2019-08-20 11:17:24 -04:00
import Data.Maybe (fromMaybe)
2019-08-30 01:21:17 -04:00
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
2019-08-20 12:26:24 -04:00
2019-08-20 11:17:24 -04:00
import Mtlstats.Types
2019-08-20 12:25:40 -04:00
-- | Starts a new season
2019-08-20 11:17:24 -04:00
startNewSeason :: ProgState -> ProgState
2019-08-20 12:26:24 -04:00
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
2019-08-20 11:17:24 -04:00
2019-08-20 12:50:39 -04:00
-- | Resets all players year-to-date stats
resetYtd :: ProgState -> ProgState
2019-08-21 15:57:52 -04:00
resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
2019-08-20 12:50:39 -04:00
2019-08-20 12:25:40 -04:00
-- | Starts a new game
2019-08-20 11:17:24 -04:00
startNewGame :: ProgState -> ProgState
2019-08-22 01:18:02 -04:00
startNewGame
= (progMode .~ NewGame newGameState)
. (database . dbGames %~ succ)
2019-08-24 16:23:56 -04:00
-- | Adds a character to the input buffer
addChar :: Char -> ProgState -> ProgState
2019-08-24 17:01:18 -04:00
addChar c = inputBuffer %~ (++[c])
2019-08-24 16:23:56 -04:00
-- | Removes a character from the input buffer (if possible)
removeChar :: ProgState -> ProgState
2019-08-24 17:01:18 -04:00
removeChar = inputBuffer %~ \case
"" -> ""
str -> init str
2019-08-29 00:12:30 -04:00
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
2019-08-29 00:12:30 -04:00
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
2019-08-29 00:12:30 -04:00
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
2019-08-30 01:21:17 -04:00
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s result
where
result = do
gType <- s^.progMode.gameStateL.gameType
won <- gameWon $ s^.progMode.gameStateL
lost <- gameLost $ s^.progMode.gameStateL
ot <- s^.progMode.gameStateL.overtimeFlag
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)