mtlstats/src/Mtlstats/Types.hs

1180 lines
31 KiB
Haskell
Raw Normal View History

{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 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-22 13:05:25 -04:00
{-# LANGUAGE LambdaCase, OverloadedStrings, TemplateHaskell #-}
2019-08-09 11:06:13 -04:00
module Mtlstats.Types (
-- * Types
2019-09-04 13:47:17 -04:00
Controller (..),
2019-08-23 09:22:32 -04:00
Action,
2019-08-13 10:11:10 -04:00
ProgState (..),
2019-08-20 01:40:59 -04:00
ProgMode (..),
2019-09-07 11:33:03 -04:00
GameState (..),
2019-08-22 01:18:02 -04:00
GameType (..),
2019-09-08 12:06:38 -04:00
CreatePlayerState (..),
2019-10-21 23:53:41 -04:00
CreateGoalieState (..),
2019-10-31 04:14:52 -04:00
EditPlayerState (..),
2019-11-01 04:25:25 -04:00
EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
2020-01-16 12:42:33 -05:00
EditStandingsMode (..),
ESMSubMode (..),
2019-08-16 11:49:04 -04:00
Database (..),
2019-08-09 11:06:13 -04:00
Player (..),
PlayerStats (..),
2019-08-11 10:24:39 -04:00
Goalie (..),
GoalieStats (..),
2019-08-26 10:20:10 -04:00
GameStats (..),
2019-08-24 16:23:56 -04:00
Prompt (..),
2019-10-30 16:57:08 -04:00
SelectParams (..),
2019-11-26 00:34:01 -05:00
TableCell (..),
2019-08-09 11:06:13 -04:00
-- * Lenses
2019-08-19 23:58:18 -04:00
-- ** ProgState Lenses
database,
2019-08-20 01:40:59 -04:00
progMode,
2020-03-11 03:09:47 -04:00
dbName,
2019-08-24 19:02:29 -04:00
inputBuffer,
2019-10-11 22:24:27 -04:00
scrollOffset,
2019-08-22 13:05:25 -04:00
-- ** ProgMode Lenses
2019-08-28 01:04:03 -04:00
gameStateL,
2019-09-09 11:43:37 -04:00
createPlayerStateL,
2019-10-24 09:48:47 -04:00
createGoalieStateL,
2019-11-01 03:42:51 -04:00
editPlayerStateL,
2019-11-11 15:30:04 -05:00
editGoalieStateL,
2020-01-16 12:42:33 -05:00
editStandingsModeL,
-- ** EditStandingsMode Lenses
esmSubModeL,
2019-08-27 13:07:43 -04:00
-- ** GameState Lenses
2019-08-31 10:32:03 -04:00
gameYear,
gameMonth,
gameDay,
2019-08-27 13:07:43 -04:00
gameType,
otherTeam,
homeScore,
awayScore,
2019-08-29 00:12:30 -04:00
overtimeFlag,
2019-09-06 11:21:46 -04:00
dataVerified,
pointsAccounted,
goalBy,
assistsBy,
gamePlayerStats,
confirmGoalDataFlag,
gameSelectedPlayer,
gamePMinsRecorded,
gameGoalieStats,
gameSelectedGoalie,
gameGoalieMinsPlayed,
gameGoalsAllowed,
gameGoaliesRecorded,
gameGoalieAssigned,
2019-09-08 12:06:38 -04:00
-- ** CreatePlayerState Lenses
cpsNumber,
cpsName,
cpsPosition,
2020-02-13 02:31:20 -05:00
cpsRookieFlag,
2020-02-13 23:18:53 -05:00
cpsActiveFlag,
2019-09-13 02:26:03 -04:00
cpsSuccessCallback,
cpsFailureCallback,
2019-10-21 23:53:41 -04:00
-- ** CreateGoalieState Lenses
cgsNumber,
cgsName,
2020-02-13 02:31:20 -05:00
cgsRookieFlag,
2020-02-13 23:18:53 -05:00
cgsActiveFlag,
2019-10-21 23:53:41 -04:00
cgsSuccessCallback,
cgsFailureCallback,
2019-11-01 02:55:43 -04:00
-- ** EditPlayerState Lenses
epsSelectedPlayer,
2019-11-01 04:25:25 -04:00
epsMode,
2020-01-28 00:31:55 -05:00
epsCallback,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
2020-01-31 00:25:20 -05:00
egsCallback,
2019-08-16 11:49:04 -04:00
-- ** Database Lenses
dbPlayers,
dbGoalies,
2019-08-19 09:31:24 -04:00
dbGames,
dbHomeGameStats,
dbAwayGameStats,
2019-08-09 11:06:13 -04:00
-- ** Player Lenses
pNumber,
pName,
pPosition,
pRookie,
pActive,
2019-08-09 11:06:13 -04:00
pYtd,
pLifetime,
-- ** PlayerStats Lenses
psGoals,
psAssists,
psPMin,
2019-08-11 10:24:39 -04:00
-- ** Goalie Lenses
gNumber,
gName,
gRookie,
gActive,
2019-08-11 10:24:39 -04:00
gYtd,
gLifetime,
-- ** GoalieStats Lenses
gsGames,
gsMinsPlayed,
gsGoalsAllowed,
2019-11-22 03:00:42 -05:00
gsShutouts,
2019-08-11 10:24:39 -04:00
gsWins,
gsLosses,
gsTies,
2019-08-26 10:20:10 -04:00
-- ** GameStats Lenses
gmsWins,
gmsLosses,
gmsOvertime,
gmsGoalsFor,
gmsGoalsAgainst,
2019-08-09 11:06:13 -04:00
-- * Constructors
2019-08-19 23:58:18 -04:00
newProgState,
2019-08-22 01:18:02 -04:00
newGameState,
2019-09-08 12:06:38 -04:00
newCreatePlayerState,
2019-10-21 23:53:41 -04:00
newCreateGoalieState,
2019-11-01 02:55:43 -04:00
newEditPlayerState,
newEditGoalieState,
2019-08-16 11:49:04 -04:00
newDatabase,
2019-08-09 11:06:13 -04:00
newPlayer,
newPlayerStats,
2019-08-11 10:24:39 -04:00
newGoalie,
newGoalieStats,
2019-08-26 10:20:10 -04:00
newGameStats,
2019-08-22 03:06:36 -04:00
-- * Helper Functions
2019-08-27 11:44:45 -04:00
-- ** GameState Helpers
teamScore,
2019-08-27 12:06:53 -04:00
otherScore,
2019-09-02 18:50:21 -04:00
homeTeam,
awayTeam,
2019-08-28 13:02:50 -04:00
gameWon,
2019-08-30 00:44:40 -04:00
gameLost,
2019-08-28 01:47:30 -04:00
gameTied,
unaccountedPoints,
2019-08-30 18:57:56 -04:00
-- ** GameStats Helpers
2019-09-03 14:15:29 -04:00
gmsGames,
2019-08-30 18:57:56 -04:00
gmsPoints,
2019-08-31 09:33:26 -04:00
addGameStats,
2019-08-22 03:06:36 -04:00
-- ** Player Helpers
2019-09-19 03:11:48 -04:00
playerSearch,
2020-04-06 14:46:30 -04:00
activePlayerSearch,
2019-09-25 02:28:48 -04:00
playerSearchExact,
2019-10-01 00:58:15 -04:00
modifyPlayer,
2019-10-09 00:24:34 -04:00
playerSummary,
2019-10-15 00:51:42 -04:00
playerIsActive,
2019-10-09 00:24:34 -04:00
-- ** PlayerStats Helpers
2019-10-09 00:35:35 -04:00
psPoints,
2019-10-30 21:57:31 -04:00
addPlayerStats,
-- ** Goalie Helpers
goalieSearch,
2020-04-06 15:01:26 -04:00
activeGoalieSearch,
2019-10-30 21:57:31 -04:00
goalieSearchExact,
goalieSummary,
goalieIsActive,
-- ** GoalieStats Helpers
addGoalieStats,
gsAverage
2019-08-09 11:06:13 -04:00
) where
2019-08-23 09:22:32 -04:00
import Control.Monad.Trans.State (StateT)
2019-08-10 10:01:36 -04:00
import Data.Aeson
( FromJSON
, ToJSON
, object
, pairs
, parseJSON
, toEncoding
, toJSON
, withObject
, (.:)
2019-11-22 03:00:42 -05:00
, (.:?)
, (.!=)
2019-08-10 10:01:36 -04:00
, (.=)
)
import Data.Char (toUpper)
2020-03-05 05:15:58 -05:00
import Data.List (find, isInfixOf)
import qualified Data.Map as M
2019-08-22 13:05:25 -04:00
import Lens.Micro (Lens', lens, (&), (^.), (.~))
2019-08-09 11:06:13 -04:00
import Lens.Micro.TH (makeLenses)
2019-09-04 13:47:17 -04:00
import qualified UI.NCurses as C
2019-08-23 09:22:32 -04:00
2019-09-02 18:50:21 -04:00
import Mtlstats.Config
2019-09-04 13:47:17 -04:00
-- | Controls the program flow
data Controller = Controller
{ drawController :: ProgState -> C.Update C.CursorMode
-- ^ The drawing phase
, handleController :: C.Event -> Action Bool
-- ^ The event handler
}
2019-08-23 09:22:32 -04:00
-- | Action which maintains program state
2019-09-04 13:47:17 -04:00
type Action a = StateT ProgState C.Curses a
2019-08-09 11:06:13 -04:00
2019-08-13 10:11:10 -04:00
-- | Represents the program state
2019-08-20 01:40:59 -04:00
data ProgState = ProgState
2019-10-11 22:24:27 -04:00
{ _database :: Database
2019-08-23 10:10:49 -04:00
-- ^ The data to be saved
2019-10-11 22:24:27 -04:00
, _progMode :: ProgMode
2019-08-23 10:10:49 -04:00
-- ^ The program's mode
2020-03-11 03:09:47 -04:00
, _dbName :: String
-- ^ The name of the database file
2019-10-11 22:24:27 -04:00
, _inputBuffer :: String
2019-08-24 19:02:29 -04:00
-- ^ Buffer for user input
2019-10-11 22:24:27 -04:00
, _scrollOffset :: Int
-- ^ The scrolling offset for the display
2019-09-13 02:26:03 -04:00
}
2019-08-13 10:11:10 -04:00
2019-09-07 11:33:03 -04:00
-- | The program mode
data ProgMode
2020-01-21 22:20:01 -05:00
= TitleScreen
| MainMenu
| NewSeason Bool
2019-09-07 11:33:03 -04:00
| NewGame GameState
2019-12-17 11:32:32 -05:00
| EditMenu
| CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
2019-10-31 04:14:52 -04:00
| EditPlayer EditPlayerState
| EditGoalie EditGoalieState
2020-01-16 12:42:33 -05:00
| EditStandings EditStandingsMode
2019-09-13 02:26:03 -04:00
instance Show ProgMode where
2020-01-21 22:20:01 -05:00
show TitleScreen = "TitleScreen"
2020-01-16 12:42:33 -05:00
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"
2019-09-07 11:33:03 -04:00
2019-08-22 01:18:02 -04:00
-- | The game state
data GameState = GameState
{ _gameYear :: Maybe Int
2019-08-31 10:32:03 -04:00
-- ^ The year the game took place
, _gameMonth :: Maybe Int
2019-08-31 10:32:03 -04:00
-- ^ The month the game took place
, _gameDay :: Maybe Int
2019-08-31 10:32:03 -04:00
-- ^ The day of the month the game took place
, _gameType :: Maybe GameType
2019-08-23 10:10:49 -04:00
-- ^ The type of game (home/away)
, _otherTeam :: String
-- ^ The name of the other team
, _homeScore :: Maybe Int
2019-08-23 10:10:49 -04:00
-- ^ The home team's score
, _awayScore :: Maybe Int
2019-08-23 10:10:49 -04:00
-- ^ The away team's score
, _overtimeFlag :: Maybe Bool
2019-08-29 00:12:30 -04:00
-- ^ Indicates whether or not the game went into overtime
, _dataVerified :: Bool
2019-09-06 11:21:46 -04:00
-- ^ Set to 'True' when the user confirms the entered data
, _pointsAccounted :: Int
-- ^ The number of game points accounted for
, _goalBy :: Maybe Int
-- ^ The index number of the player who scored the most recently
-- entered goal
, _assistsBy :: [Int]
-- ^ The index numbers of the players who have assisted the most
-- recently entered goal
, _gamePlayerStats :: M.Map Int PlayerStats
-- ^ The player stats accumulated over the game
, _confirmGoalDataFlag :: Bool
-- ^ Set when the user confirms the goal data
, _gameSelectedPlayer :: Maybe Int
-- ^ Index number of the selected 'Player'
, _gamePMinsRecorded :: 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'
, _gameGoalieMinsPlayed :: Maybe Int
-- ^ The number of minutes the currently selected goalie played in
-- the game
, _gameGoalsAllowed :: Maybe Int
-- ^ The number of goals the currently selected goalie allowed in
-- the game
, _gameGoaliesRecorded :: Bool
-- ^ Set when the user confirms that all goalie info has been entered
, _gameGoalieAssigned :: Bool
-- ^ Set to 'True' when the goalie has been selected who will be
-- given the win/loss/tie
2019-08-22 01:18:02 -04:00
} deriving (Eq, Show)
-- | The type of game
data GameType
= HomeGame
| AwayGame
2019-08-20 11:17:24 -04:00
deriving (Eq, Show)
2019-08-20 01:40:59 -04:00
2019-09-08 12:06:38 -04:00
-- | Player creation status
data CreatePlayerState = CreatePlayerState
{ _cpsNumber :: Maybe Int
2019-09-08 12:06:38 -04:00
-- ^ The player's number
2019-09-13 02:26:03 -04:00
, _cpsName :: String
2019-09-08 12:06:38 -04:00
-- ^ The player's name
2019-09-13 02:26:03 -04:00
, _cpsPosition :: String
2019-09-08 12:06:38 -04:00
-- ^ The player's position
2020-02-13 02:31:20 -05:00
, _cpsRookieFlag :: Maybe Bool
-- ^ Indicates whether or not the player is a rookie
2020-02-13 23:18:53 -05:00
, _cpsActiveFlag :: Maybe Bool
-- ^ Indicates whether or not the plauer is active
, _cpsSuccessCallback :: Action ()
2019-09-13 02:26:03 -04:00
-- ^ The function to call on success
, _cpsFailureCallback :: Action ()
2019-09-13 02:26:03 -04:00
-- ^ The function to call on failure
}
2019-09-08 12:06:38 -04:00
2019-10-21 23:53:41 -04:00
-- | Goalie creation status
data CreateGoalieState = CreateGoalieState
2020-02-13 02:31:20 -05:00
{ _cgsNumber :: Maybe Int
2019-10-21 23:53:41 -04:00
-- ^ The goalie's number
2020-02-13 02:31:20 -05:00
, _cgsName :: String
2019-10-21 23:53:41 -04:00
-- ^ The goalie's name
2020-02-13 02:31:20 -05:00
, _cgsRookieFlag :: Maybe Bool
-- ^ Indicates whether or not the goalie is a rookie
2020-02-13 23:18:53 -05:00
, _cgsActiveFlag :: Maybe Bool
-- ^ Indicates whether or not the goalie is active
2019-10-21 23:53:41 -04:00
, _cgsSuccessCallback :: Action ()
-- ^ The function to call on success
, _cgsFailureCallback :: Action ()
-- ^ The function to call on failure
}
2019-10-31 04:14:52 -04:00
-- | Player edit status
2019-11-01 04:25:25 -04:00
data EditPlayerState = EditPlayerState
2019-11-01 02:55:43 -04:00
{ _epsSelectedPlayer :: Maybe Int
-- ^ The index number of the player being edited
2019-11-01 04:25:25 -04:00
, _epsMode :: EditPlayerMode
-- ^ The editing mode
2020-01-28 00:31:55 -05:00
, _epsCallback :: Action ()
-- ^ The action to perform when the edit is complete
2019-11-01 02:55:43 -04:00
}
2019-10-31 04:14:52 -04:00
2019-11-01 04:25:25 -04:00
-- | Player editing mode
data EditPlayerMode
= EPMenu
| EPNumber
| EPName
| EPPosition
| EPYtd
| EPLifetime
2020-03-12 23:19:17 -04:00
| EPDelete
| EPYtdGoals Bool
| EPYtdAssists Bool
2019-11-01 04:25:25 -04:00
| EPYtdPMin
| EPLtGoals Bool
| EPLtAssists Bool
2019-11-01 04:25:25 -04:00
| EPLtPMin
deriving (Eq, Show)
-- | 'Goalie' edit status
data EditGoalieState = EditGoalieState
{ _egsSelectedGoalie :: Maybe Int
-- ^ The index number of the 'Goalie' being edited
, _egsMode :: EditGoalieMode
2020-01-31 00:25:20 -05:00
-- ^ The editing mode
, _egsCallback :: Action ()
-- ^ The action to perform when the edit is complete
}
-- | 'Goalie' editing mode
data EditGoalieMode
= EGMenu
| EGNumber
| EGName
| EGYtd
| EGLifetime
2020-03-12 23:37:42 -04:00
| EGDelete
2020-01-02 00:42:04 -05:00
| EGYtdGames Bool
| EGYtdMins Bool
| EGYtdGoals Bool
| EGYtdShutouts Bool
| EGYtdWins Bool
| EGYtdLosses Bool
| EGYtdTies
2020-01-02 00:42:04 -05:00
| EGLtGames Bool
| EGLtMins Bool
| EGLtGoals Bool
| EGLtShutouts Bool
| EGLtWins Bool
| EGLtLosses Bool
| EGLtTies
deriving (Eq, Show)
2020-01-16 12:42:33 -05:00
-- | Represents the standings edit mode
data EditStandingsMode
= ESMMenu
| ESMHome ESMSubMode
| ESMAway ESMSubMode
deriving (Eq, Show)
-- | Represents the standings edit sub-mode
data ESMSubMode
= ESMSubMenu
| ESMEditWins
| ESMEditLosses
| ESMEditOvertime
| ESMEditGoalsFor
| ESMEditGoalsAgainst
2020-01-16 12:42:33 -05:00
deriving (Eq, Show)
2019-08-16 11:49:04 -04:00
-- | Represents the database
data Database = Database
{ _dbPlayers :: [Player]
2019-08-16 11:49:04 -04:00
-- ^ The list of players
, _dbGoalies :: [Goalie]
2019-08-23 10:35:59 -04:00
-- ^ The list of goalies
, _dbGames :: Int
2019-08-19 09:31:24 -04:00
-- ^ The number of games recorded
, _dbHomeGameStats :: GameStats
-- ^ Statistics for home games
, _dbAwayGameStats :: GameStats
-- ^ Statistics for away games
2019-08-16 11:49:04 -04:00
} deriving (Eq, Show)
2019-08-09 11:06:13 -04:00
-- | Represents a (non-goalie) player
data Player = Player
{ _pNumber :: Int
-- ^ The player's number
, _pName :: String
-- ^ The player's name
, _pPosition :: String
-- ^ The player's position
, _pRookie :: Bool
-- ^ Indicates that the player is a rookie
, _pActive :: Bool
-- ^ Indicates that the player is active
2019-08-09 11:06:13 -04:00
, _pYtd :: PlayerStats
-- ^ The Player's year-to-date stats
, _pLifetime :: PlayerStats
-- ^ The player's lifetime stats
} deriving (Eq, Show)
-- | Represents a (non-goalie) player's stats
data PlayerStats = PlayerStats
{ _psGoals :: Int
-- ^ The number of goals
, _psAssists :: Int
-- ^ The number of assists
, _psPMin :: Int
-- ^ The number of penalty minutes
} deriving (Eq, Show)
2019-08-11 10:24:39 -04:00
-- | Represents a goalie
data Goalie = Goalie
{ _gNumber :: Int
-- ^ The goalie's number
, _gName :: String
-- ^ The goalie's name
, _gRookie :: Bool
-- ^ Indicates that the goalie is a rookie
, _gActive :: Bool
-- ^ Indicates that the goalie is active
2019-08-11 10:24:39 -04:00
, _gYtd :: GoalieStats
-- ^ The goalie's year-to-date stats
, _gLifetime :: GoalieStats
-- ^ The goalie's lifetime stats
} deriving (Eq, Show)
-- | Represents a goalie's stats
data GoalieStats = GoalieStats
{ _gsGames :: Int
-- ^ The number of games played
, _gsMinsPlayed :: Int
-- ^ The number of minutes played
, _gsGoalsAllowed :: Int
-- ^ The number of goals allowed
2019-11-22 03:00:42 -05:00
, _gsShutouts :: Int
-- ^ The number of shutouts the goalie has accumulated
2019-08-11 10:24:39 -04:00
, _gsWins :: Int
-- ^ The number of wins
, _gsLosses :: Int
-- ^ The number of losses
, _gsTies :: Int
-- ^ The number of ties
} deriving (Eq, Show)
2019-08-26 10:20:10 -04:00
-- | Game statistics
data GameStats = GameStats
{ _gmsWins :: Int
2019-08-26 10:20:10 -04:00
-- ^ Games won
, _gmsLosses :: Int
2019-08-26 10:20:10 -04:00
-- ^ Games lost
, _gmsOvertime :: Int
2019-08-26 10:20:10 -04:00
-- ^ Games lost in overtime
, _gmsGoalsFor :: Int
-- ^ Goals for the team
, _gmsGoalsAgainst :: Int
-- ^ Goals against the team
2019-08-26 10:20:10 -04:00
} deriving (Eq, Show)
2019-08-24 16:23:56 -04:00
-- | Defines a user prompt
data Prompt = Prompt
{ promptDrawer :: ProgState -> C.Update ()
2019-10-30 01:28:54 -04:00
-- ^ Draws the prompt to the screen
, promptProcessChar :: Char -> String -> String
-- ^ Modifies the string based on the character entered
, promptAction :: String -> Action ()
2019-08-24 16:23:56 -04:00
-- ^ Action to perform when the value is entered
, promptSpecialKey :: C.Key -> Action ()
-- ^ Action to perform when a special key is pressed
2019-08-24 16:23:56 -04:00
}
2019-10-30 16:57:08 -04:00
-- | 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
, spProcessChar :: Char -> String -> String
-- ^ Processes a character entered by the user
2019-10-30 16:57:08 -04:00
, spCallback :: Maybe Int -> Action ()
-- ^ The function when the selection is made
, spNotFound :: String -> Action ()
-- ^ The function to call when the selection doesn't exist
}
2019-11-26 00:34:01 -05:00
-- | Describes a table cell
data TableCell
= CellText String
-- ^ A cell with text
| CellFill Char
-- ^ A cell filled with the given character
deriving (Eq, Show)
2019-08-19 23:58:18 -04:00
makeLenses ''ProgState
2019-08-22 01:18:02 -04:00
makeLenses ''GameState
2019-09-08 12:06:38 -04:00
makeLenses ''CreatePlayerState
2019-10-21 23:53:41 -04:00
makeLenses ''CreateGoalieState
2019-11-01 02:55:43 -04:00
makeLenses ''EditPlayerState
makeLenses ''EditGoalieState
2019-08-16 11:49:04 -04:00
makeLenses ''Database
2019-08-09 11:06:13 -04:00
makeLenses ''Player
makeLenses ''PlayerStats
2019-08-11 10:24:39 -04:00
makeLenses ''Goalie
makeLenses ''GoalieStats
2019-08-26 10:20:10 -04:00
makeLenses ''GameStats
2019-08-09 11:06:13 -04:00
instance FromJSON Database where
parseJSON = withObject "Database" $ \v -> Database
<$> v .:? "players" .!= []
<*> v .:? "goalies" .!= []
<*> v .:? "games" .!= 0
<*> v .:? "home_game_stats" .!= newGameStats
<*> v .:? "away_game_stats" .!= newGameStats
instance ToJSON Database where
toJSON (Database players goalies games hgs ags) = object
[ "players" .= players
, "goalies" .= goalies
, "games" .= games
, "home_game_stats" .= hgs
, "away_game_stats" .= ags
]
toEncoding (Database players goalies games hgs ags) = pairs $
"players" .= players <>
"goalies" .= goalies <>
"games" .= games <>
"home_game_stats" .= hgs <>
"away_game_stats" .= ags
instance FromJSON Player where
parseJSON = withObject "Player" $ \v -> Player
<$> v .: "number"
<*> v .: "name"
<*> v .: "position"
<*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newPlayerStats
<*> v .:? "lifetime" .!= newPlayerStats
instance ToJSON Player where
toJSON (Player num name pos rk act ytd lt) = object
[ "number" .= num
, "name" .= name
, "position" .= pos
, "rookie" .= rk
, "active" .= act
, "ytd" .= ytd
, "lifetime" .= lt
]
toEncoding (Player num name pos rk act ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"position" .= pos <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <>
"lifetime" .= lt
instance FromJSON PlayerStats where
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
<$> v .:? "goals" .!= 0
<*> v .:? "assists" .!= 0
<*> v .:? "penalty_mins" .!= 0
instance ToJSON PlayerStats where
toJSON (PlayerStats g a pm) = object
[ "goals" .= g
, "assists" .= a
, "penalty_mins" .= pm
]
toEncoding (PlayerStats g a pm) = pairs $
"goals" .= g <>
"assists" .= a <>
"penalty_mins" .= pm
instance FromJSON Goalie where
parseJSON = withObject "Goalie" $ \v -> Goalie
<$> v .: "number"
<*> v .: "name"
<*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newGoalieStats
<*> v .:? "lifetime" .!= newGoalieStats
instance ToJSON Goalie where
toJSON (Goalie num name rk act ytd lt) = object
[ "number" .= num
, "name" .= name
, "ytd" .= ytd
, "rookie" .= rk
, "active" .= act
, "lifetime" .= lt
]
toEncoding (Goalie num name rk act ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <>
"lifetime" .= lt
instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .:? "games" .!= 0
<*> v .:? "mins_played" .!= 0
<*> v .:? "goals_allowed" .!= 0
<*> v .:? "shutouts" .!= 0
<*> v .:? "wins" .!= 0
<*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where
toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g
, "mins_played" .= m
, "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w
, "losses" .= l
, "ties" .= t
]
toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <>
"mins_played" .= m <>
"goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <>
"losses" .= l <>
"ties" .= t
instance FromJSON GameStats where
parseJSON = withObject "GameStats" $ \v -> GameStats
<$> v .: "wins"
<*> v .: "losses"
<*> v .: "overtime"
<*> v .: "goals_for"
<*> v .: "goals_against"
instance ToJSON GameStats where
toJSON (GameStats w l ot gf ga) = object
[ "wins" .= w
, "losses" .= l
, "overtime" .= ot
, "goals_for" .= gf
, "goals_against" .= ga
]
toEncoding (GameStats w l ot gf ga) = pairs $
"wins" .= w <>
"losses" .= l <>
"overtime" .= ot <>
"goals_for" .= gf <>
"goals_against" .= ga
2019-08-28 01:04:03 -04:00
gameStateL :: Lens' ProgMode GameState
gameStateL = lens
(\case
NewGame gs -> gs
_ -> newGameState)
(\_ gs -> NewGame gs)
2019-09-09 11:43:37 -04:00
createPlayerStateL :: Lens' ProgMode CreatePlayerState
createPlayerStateL = lens
(\case
CreatePlayer cps -> cps
_ -> newCreatePlayerState)
(\_ cps -> CreatePlayer cps)
2019-10-24 09:48:47 -04:00
createGoalieStateL :: Lens' ProgMode CreateGoalieState
createGoalieStateL = lens
(\case
CreateGoalie cgs -> cgs
_ -> newCreateGoalieState)
(\_ cgs -> CreateGoalie cgs)
2019-11-01 03:42:51 -04:00
editPlayerStateL :: Lens' ProgMode EditPlayerState
editPlayerStateL = lens
(\case
EditPlayer eps -> eps
_ -> newEditPlayerState)
(\_ eps -> EditPlayer eps)
2019-11-11 15:30:04 -05:00
editGoalieStateL :: Lens' ProgMode EditGoalieState
2019-11-11 20:00:41 -05:00
editGoalieStateL = lens
(\case
EditGoalie egs -> egs
_ -> newEditGoalieState)
(\_ egs -> EditGoalie egs)
2019-11-11 15:30:04 -05:00
2020-01-16 12:42:33 -05:00
editStandingsModeL :: Lens' ProgMode EditStandingsMode
editStandingsModeL = lens
(\case
EditStandings esm -> esm
_ -> ESMMenu)
(\_ esm -> EditStandings esm)
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
esmSubModeL = lens
(\case
ESMMenu -> ESMSubMenu
ESMHome m -> m
ESMAway m -> m)
(\mode subMode -> case mode of
ESMMenu -> ESMMenu
ESMHome _ -> ESMHome subMode
ESMAway _ -> ESMAway subMode)
2019-08-22 01:18:02 -04:00
-- | Constructor for a 'ProgState'
2019-08-19 23:58:18 -04:00
newProgState :: ProgState
newProgState = ProgState
2019-10-11 22:24:27 -04:00
{ _database = newDatabase
2020-01-21 22:20:01 -05:00
, _progMode = TitleScreen
2020-03-11 03:09:47 -04:00
, _dbName = ""
2019-10-11 22:24:27 -04:00
, _inputBuffer = ""
, _scrollOffset = 0
2019-08-19 23:58:18 -04:00
}
2019-08-22 01:18:02 -04:00
-- | Constructor for a 'GameState'
newGameState :: GameState
newGameState = GameState
{ _gameYear = Nothing
, _gameMonth = Nothing
, _gameDay = Nothing
, _gameType = Nothing
, _otherTeam = ""
, _homeScore = Nothing
, _awayScore = Nothing
, _overtimeFlag = Nothing
, _dataVerified = False
, _pointsAccounted = 0
, _goalBy = Nothing
, _assistsBy = []
, _gamePlayerStats = M.empty
, _confirmGoalDataFlag = False
, _gameSelectedPlayer = Nothing
, _gamePMinsRecorded = False
, _gameGoalieStats = M.empty
, _gameSelectedGoalie = Nothing
, _gameGoalieMinsPlayed = Nothing
, _gameGoalsAllowed = Nothing
, _gameGoaliesRecorded = False
, _gameGoalieAssigned = False
2019-08-22 01:18:02 -04:00
}
2019-09-08 12:06:38 -04:00
-- | Constructor for a 'CreatePlayerState'
newCreatePlayerState :: CreatePlayerState
newCreatePlayerState = CreatePlayerState
{ _cpsNumber = Nothing
2019-09-13 02:26:03 -04:00
, _cpsName = ""
, _cpsPosition = ""
2020-02-13 02:31:20 -05:00
, _cpsRookieFlag = Nothing
2020-02-13 23:18:53 -05:00
, _cpsActiveFlag = Nothing
, _cpsSuccessCallback = return ()
, _cpsFailureCallback = return ()
2019-09-08 12:06:38 -04:00
}
2019-10-21 23:53:41 -04:00
-- | Constructor for a 'CreateGoalieState'
newCreateGoalieState :: CreateGoalieState
newCreateGoalieState = CreateGoalieState
{ _cgsNumber = Nothing
, _cgsName = ""
2020-02-13 02:31:20 -05:00
, _cgsRookieFlag = Nothing
2020-02-13 23:18:53 -05:00
, _cgsActiveFlag = Nothing
2019-10-21 23:53:41 -04:00
, _cgsSuccessCallback = return ()
, _cgsFailureCallback = return ()
}
2019-11-01 02:55:43 -04:00
-- | Constructor for an 'EditPlayerState'
newEditPlayerState :: EditPlayerState
newEditPlayerState = EditPlayerState
{ _epsSelectedPlayer = Nothing
2019-11-01 04:25:25 -04:00
, _epsMode = EPMenu
2020-01-28 00:31:55 -05:00
, _epsCallback = return ()
2019-11-01 02:55:43 -04:00
}
-- | Constructor for an 'EditGoalieState' value
newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing
, _egsMode = EGMenu
2020-01-31 00:25:20 -05:00
, _egsCallback = return ()
}
2019-08-16 11:49:04 -04:00
-- | Constructor for a 'Database'
newDatabase :: Database
newDatabase = Database
{ _dbPlayers = []
, _dbGoalies = []
, _dbGames = 0
, _dbHomeGameStats = newGameStats
, _dbAwayGameStats = newGameStats
2019-08-16 11:49:04 -04:00
}
2019-08-09 11:06:13 -04:00
-- | Constructor for a 'Player'
newPlayer
:: Int
-- ^ The player's number
-> String
-- ^ The player's name
-> String
-- ^ The player's position
-> Player
newPlayer num name pos = Player
{ _pNumber = num
, _pName = name
, _pPosition = pos
, _pRookie = True
, _pActive = True
2019-08-09 11:06:13 -04:00
, _pYtd = newPlayerStats
, _pLifetime = newPlayerStats
}
-- | Constructor for a 'PlayerStats' value
newPlayerStats :: PlayerStats
newPlayerStats = PlayerStats
{ _psGoals = 0
, _psAssists = 0
, _psPMin = 0
}
2019-08-11 10:24:39 -04:00
-- | Constructor for a 'Goalie'
newGoalie
:: Int
-- ^ The goalie's number
-> String
-- ^ The goalie's name
-> Goalie
newGoalie num name = Goalie
{ _gNumber = num
, _gName = name
, _gRookie = True
, _gActive = True
2019-08-11 10:24:39 -04:00
, _gYtd = newGoalieStats
, _gLifetime = newGoalieStats
}
-- | Constructor for a 'GoalieStats' value
newGoalieStats :: GoalieStats
newGoalieStats = GoalieStats
{ _gsGames = 0
, _gsMinsPlayed = 0
, _gsGoalsAllowed = 0
2019-11-22 03:00:42 -05:00
, _gsShutouts = 0
2019-08-11 10:24:39 -04:00
, _gsWins = 0
, _gsLosses = 0
, _gsTies = 0
}
2019-08-26 10:20:10 -04:00
-- | Constructor for a 'GameStats' value
newGameStats :: GameStats
newGameStats = GameStats
{ _gmsWins = 0
, _gmsLosses = 0
, _gmsOvertime = 0
, _gmsGoalsFor = 0
, _gmsGoalsAgainst = 0
2019-08-26 10:20:10 -04:00
}
2019-08-27 11:44:45 -04:00
-- | Determines the team's score
teamScore :: GameState -> Maybe Int
teamScore s = case s ^. gameType of
Just HomeGame -> s ^. homeScore
Just AwayGame -> s ^. awayScore
Nothing -> Nothing
2019-08-22 03:06:36 -04:00
2019-08-27 12:06:53 -04:00
-- | Determines the other team's score
otherScore :: GameState -> Maybe Int
otherScore s = case s ^. gameType of
Just HomeGame -> s ^. awayScore
Just AwayGame -> s ^. homeScore
Nothing -> Nothing
2019-09-02 18:50:21 -04:00
-- | Returns the name of the home team (or an empty string if
-- unavailable)
homeTeam :: GameState -> String
homeTeam gs = case gs^.gameType of
Just HomeGame -> myTeam
Just AwayGame -> gs^.otherTeam
Nothing -> ""
-- | Returns the name of the visiting team (or an empty string if
-- unavailable)
awayTeam :: GameState -> String
awayTeam gs = case gs^.gameType of
Just HomeGame -> gs^.otherTeam
Just AwayGame -> myTeam
Nothing -> ""
-- | Checks if the game was won
gameWon :: GameState -> Maybe Bool
gameWon gs = (>) <$> teamScore gs <*> otherScore gs
2019-08-30 00:44:40 -04:00
-- | Checks if the game was lost
gameLost :: GameState -> Maybe Bool
gameLost gs = do
ot <- gs^.overtimeFlag
team <- teamScore gs
other <- otherScore gs
Just $ not ot && other > team
2019-08-30 00:44:40 -04:00
-- | Checks if the game has tied
gameTied :: GameState -> Maybe Bool
gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
2019-08-28 01:47:30 -04:00
-- | Checks for unaccounted points
unaccountedPoints :: GameState -> Maybe Bool
unaccountedPoints gs = do
scored <- teamScore gs
let accounted = gs^.pointsAccounted
Just $ scored > accounted
2019-09-03 14:15:29 -04:00
-- | Calculates the number of games played
gmsGames :: GameStats -> Int
gmsGames gs = gs^.gmsWins + gs^.gmsLosses + gs^.gmsOvertime
2019-09-03 14:15:29 -04:00
2019-08-30 18:57:56 -04:00
-- | Calculates the number of points
gmsPoints :: GameStats -> Int
gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
2019-08-31 09:33:26 -04:00
-- | Adds two 'GameStats' values together
addGameStats :: GameStats -> GameStats -> GameStats
addGameStats s1 s2 = GameStats
{ _gmsWins = s1^.gmsWins + s2^.gmsWins
, _gmsLosses = s1^.gmsLosses + s2^.gmsLosses
, _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
, _gmsGoalsFor = s1^.gmsGoalsFor + s2^.gmsGoalsFor
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
2019-08-31 09:33:26 -04:00
}
2020-04-06 14:46:30 -04:00
-- | Searches through a list of players with a specified criteria
playerSearchWith
:: (Player -> Bool)
-- ^ The search criteria
-> String
-- ^ The search string
-> [Player]
-- ^ The list of players to search
-> [(Int, Player)]
-- ^ The matching players with their index numbers
playerSearchWith criteria sStr =
filter match . zip [0..]
where
match (_, p)
= map toUpper sStr `isInfixOf` map toUpper (p^.pName)
&& criteria p
2019-09-18 01:55:38 -04:00
-- | 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
2020-04-06 14:46:30 -04:00
playerSearch = playerSearchWith $ const True
-- | Searches through a list of players for an active player
activePlayerSearch
:: String
-- ^ The search string
-> [Player]
-- ^ The list of players to search
-> [(Int, Player)]
-- ^ The matching players with their index numbers
activePlayerSearch = playerSearchWith (^.pActive)
2019-09-19 03:11:48 -04:00
-- | 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 =
2020-03-05 05:15:58 -05:00
find match . zip [0..]
2019-11-12 17:01:08 -05:00
where match (_, p) = p^.pName == sStr
2019-09-25 02:28:48 -04:00
-- | Modifies a player with a given name
modifyPlayer
:: (Player -> Player)
-- ^ The modification function
-> String
-- ^ The player's name
-> [Player]
-- ^ The list of players to modify
-> [Player]
-- ^ The modified list
modifyPlayer f n = map
(\p -> if p^.pName == n
then f p
else p)
2019-10-01 00:58:15 -04:00
-- | Provides a short summary string for a player
playerSummary :: Player -> String
2019-10-02 01:31:07 -04:00
playerSummary p =
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
2019-10-09 00:24:34 -04:00
2019-10-15 00:51:42 -04:00
-- | Determines whether or not a player has been active in the current
-- season/year
playerIsActive :: Player -> Bool
playerIsActive = do
stats <- (^.pYtd)
return
$ stats^.psGoals /= 0
|| stats^.psAssists /= 0
|| stats^.psPMin /= 0
2019-10-09 00:35:35 -04:00
-- | Calculates a player's points
psPoints :: PlayerStats -> Int
psPoints s = s^.psGoals + s^.psAssists
2019-10-09 00:24:34 -04:00
-- | Adds two 'PlayerStats' together
addPlayerStats :: PlayerStats -> PlayerStats -> PlayerStats
addPlayerStats s1 s2 = newPlayerStats
& psGoals .~ s1^.psGoals + s2^.psGoals
& psAssists .~ s1^.psAssists + s2^.psAssists
& psPMin .~ s1^.psPMin + s2^.psPMin
2019-10-30 21:57:31 -04:00
2020-04-06 15:01:26 -04:00
-- | Searches a list of goalies with a search criteria
goalieSearchWith
:: (Goalie -> Bool)
-- ^ The search criteria
-> String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> [(Int, Goalie)]
-- ^ The search results with their corresponding index numbers
goalieSearchWith criteria sStr =
filter match . zip [0..]
where
match (_, g)
= map toUpper sStr `isInfixOf` map toUpper (g^.gName)
&& criteria g
2019-10-30 21:57:31 -04:00
-- | 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
2020-04-06 15:01:26 -04:00
goalieSearch = goalieSearchWith $ const True
-- | Searches a list of goalies for an active goalie
activeGoalieSearch
:: String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> [(Int, Goalie)]
-- ^ The search results with their corresponding index numbers
activeGoalieSearch = goalieSearchWith (^.gActive)
2019-10-30 21:57:31 -04:00
-- | 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
2019-10-30 23:18:15 -04:00
goalieSearchExact sStr goalies = let
results = filter (\(_, goalie) -> sStr == goalie^.gName) $
zip [0..] goalies
in case results of
[] -> Nothing
result:_ -> Just result
2019-10-30 21:57:31 -04:00
-- | Provides a description string for a 'Goalie'
goalieSummary :: Goalie -> String
2019-10-30 23:27:38 -04:00
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
-- | Determines whether or not a goalie has been active in the current
-- season
goalieIsActive :: Goalie -> Bool
2019-11-28 05:12:59 -05:00
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
-- | Adds two sets of 'GoalieStats'
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
2019-11-28 05:59:06 -05:00
addGoalieStats g1 g2 = GoalieStats
{ _gsGames = g1^.gsGames + g2^.gsGames
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
, _gsWins = g1^.gsWins + g2^.gsWins
, _gsLosses = g1^.gsLosses + g2^.gsLosses
, _gsTies = g1^.gsTies + g2^.gsTies
}
-- | Determines a goalie's average goals allowed per game.
gsAverage :: GoalieStats -> Rational
2019-12-02 20:48:09 -05:00
gsAverage gs = let
allowed = fromIntegral $ gs^.gsGoalsAllowed
mins = fromIntegral $ gs^.gsMinsPlayed
gLen = fromIntegral gameLength
in if mins == 0
then 0
else allowed / mins * gLen