mtlstats/test/TypesSpec.hs

281 lines
7.1 KiB
Haskell
Raw Normal View History

2019-08-20 11:31:03 -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-27 22:10:03 -04:00
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
2019-08-10 10:01:36 -04:00
2019-08-09 11:06:13 -04:00
module TypesSpec (spec) where
2019-08-26 23:55:02 -04:00
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
2019-08-10 10:01:36 -04:00
import Data.ByteString.Lazy (ByteString)
2019-08-26 23:55:02 -04:00
import qualified Data.HashMap.Strict as HM
2019-08-27 22:10:03 -04:00
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
2019-08-09 11:06:13 -04:00
import Test.Hspec (Spec, context, describe, it, shouldBe)
2019-08-26 23:55:02 -04:00
2019-08-09 11:06:13 -04:00
import Mtlstats.Types
2019-08-21 00:21:22 -04:00
import qualified Types.MenuSpec as Menu
2019-08-09 11:06:13 -04:00
spec :: Spec
2019-08-10 10:01:36 -04:00
spec = describe "Mtlstats.Types" $ do
playerSpec
2019-08-11 10:24:39 -04:00
goalieSpec
2019-08-26 10:20:10 -04:00
gameStatsSpec
2019-08-16 11:49:04 -04:00
databaseSpec
2019-08-28 01:04:03 -04:00
gameStateLSpec
teamScoreSpec
2019-08-27 12:06:53 -04:00
otherScoreSpec
2019-08-28 01:47:30 -04:00
gameTiedSpec
2019-08-28 01:46:09 -04:00
pPointsSpec
2019-08-21 00:21:22 -04:00
Menu.spec
2019-08-09 11:06:13 -04:00
playerSpec :: Spec
2019-08-26 23:55:02 -04:00
playerSpec = describe "Player" $ jsonSpec player playerJSON
2019-08-26 23:55:02 -04:00
goalieSpec :: Spec
goalieSpec = describe "Goalie" $ jsonSpec goalie goalieJSON
2019-08-26 10:20:10 -04:00
gameStatsSpec :: Spec
gameStatsSpec = describe "GameStats" $
jsonSpec (gameStats 1) (gameStatsJSON 1)
2019-08-26 23:55:02 -04:00
databaseSpec :: Spec
databaseSpec = describe "Database" $ jsonSpec db dbJSON
2019-08-28 01:04:03 -04:00
gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters
[ ( MainMenu, newGameState )
, ( NewGame $ gs HomeGame, gs HomeGame )
]
-- setters
[ ( MainMenu, gs HomeGame )
, ( NewGame $ gs HomeGame, gs AwayGame )
, ( NewGame $ gs HomeGame, newGameState )
]
where gs t = newGameState & gameType ?~ t
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
2019-08-27 11:44:45 -04:00
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
2019-08-27 11:44:45 -04:00
context "unknown game type" $
it "should return Nothing" $
2019-08-27 11:44:45 -04:00
teamScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 1" $
teamScore (s HomeGame) `shouldBe` Just 1
context "AwayGame" $
it "should return 2" $
teamScore (s AwayGame) `shouldBe` Just 2
2019-08-27 12:06:53 -04:00
otherScoreSpec :: Spec
otherScoreSpec = describe "otherScore" $ do
let
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
context "unknown game type" $
it "should return Nothing" $
otherScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 2" $
otherScore (s HomeGame) `shouldBe` Just 2
context "AwayGame" $
it "should return 1" $
otherScore (s AwayGame) `shouldBe` Just 1
2019-08-26 23:55:02 -04:00
jsonSpec
:: (Eq a, Show a, FromJSON a, ToJSON a)
=> a
-> Value
-> Spec
jsonSpec x j = do
describe "decode" $
it "should decode" $
decode (encode j) `shouldBe` Just x
describe "toJSON" $
it "should encode" $
decode (encode $ toJSON x) `shouldBe` Just x
describe "toEncoding" $
it "should encode" $
decode (encode x) `shouldBe` Just x
2019-08-27 22:10:03 -04:00
lensSpec
:: (Eq a, Show s, Show a)
=> Lens' s a
-> [(s, a)]
-> [(s, a)]
-> Spec
lensSpec l gs ss = do
context "getters" $ mapM_
(\(s, x) -> context (show s) $
it ("should be " ++ show x) $
s ^. l `shouldBe` x)
gs
context "setters" $ mapM_
(\(s, x) -> context (show s) $
it ("should set to " ++ show x) $
(s & l .~ x) ^. l `shouldBe` x)
ss
2019-08-10 10:01:36 -04:00
player :: Player
player = newPlayer 1 "Joe" "centre"
2019-08-26 23:55:02 -04:00
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
playerJSON :: Value
playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 )
]
playerStats :: Int -> PlayerStats
playerStats n = newPlayerStats
& psGoals .~ n
& psAssists .~ n + 1
& psPMin .~ n + 2
playerStatsJSON :: Int -> Value
playerStatsJSON n = Object $ HM.fromList
[ ( "goals", toJSON n )
, ( "assists", toJSON $ n + 1 )
, ( "penalty_mins", toJSON $ n + 2 )
]
2019-08-10 10:01:36 -04:00
2019-08-11 10:24:39 -04:00
goalie :: Goalie
goalie = newGoalie 1 "Joe"
2019-08-26 23:55:02 -04:00
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
goalieJSON :: Value
goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
goalieStats :: Int -> GoalieStats
goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
& gsGoalsAgainst .~ n + 3
& gsWins .~ n + 4
& gsLosses .~ n + 5
& gsTies .~ n + 6
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 )
]
2019-08-11 10:24:39 -04:00
2019-08-26 10:20:10 -04:00
gameStats :: Int -> GameStats
gameStats n = GameStats
{ _gmsWins = n
, _gmsLosses = n + 1
, _gmsOvertime = n + 2
}
gameStatsJSON :: Int -> Value
gameStatsJSON n = Object $ HM.fromList
[ ( "wins", toJSON n )
, ( "losses", toJSON $ n + 1 )
, ( "overtime", toJSON $ n + 2 )
]
2019-08-16 11:49:04 -04:00
db :: Database
db = newDatabase
& dbPlayers .~ [player]
& dbGoalies .~ [goalie]
& dbGames .~ 1
& dbHomeGameStats .~ gameStats 1
& dbAwayGameStats .~ gameStats 2
2019-08-16 11:49:04 -04:00
2019-08-26 23:55:02 -04:00
dbJSON :: Value
dbJSON = Object $ HM.fromList
[ ( "players", toJSON [playerJSON] )
, ( "goalies", toJSON [goalieJSON] )
, ( "games", toJSON (1 :: Int) )
, ( "home_game_stats", gameStatsJSON 1 )
, ( "away_game_stats", gameStatsJSON 2 )
2019-08-26 23:55:02 -04:00
]
2019-08-28 01:46:09 -04:00
2019-08-28 01:47:30 -04:00
gameTiedSpec = describe "gameTied" $ mapM_
(\(home, away, expected) -> let
desc = "home score: " ++ show home ++
", away score: " ++ show away
gs = newGameState
& homeScore .~ home
& awayScore .~ away
in context desc $
it ("should be " ++ show expected) $
gameTied gs `shouldBe` expected)
[ ( Nothing, Nothing, False )
, ( Nothing, Just 1, False )
, ( Just 1, Nothing, False )
, ( Just 1, Just 1, True )
, ( Just 1, Just 2, False )
]
2019-08-28 01:46:09 -04:00
pPointsSpec :: Spec
pPointsSpec = describe "pPoints" $ mapM_
(\(goals, assists, points) -> let
desc = "goals: " ++ show goals ++
", assists: " ++ show assists
stats = newPlayerStats &
psGoals .~ goals &
psAssists .~ assists
in context desc $
it ("should be " ++ show points) $
pPoints stats `shouldBe` points)
-- goals, assists, points
[ ( 0, 0, 0 )
, ( 1, 0, 1 )
, ( 0, 1, 1 )
, ( 2, 3, 5 )
]