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-10 10:01:36 -04:00
|
|
|
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
|
|
|
|
|
2019-08-09 11:06:13 -04:00
|
|
|
module TypesSpec (spec) where
|
|
|
|
|
2019-08-10 10:01:36 -04:00
|
|
|
import Data.Aeson (decode, encode)
|
|
|
|
import Data.ByteString.Lazy (ByteString)
|
2019-08-22 13:05:25 -04:00
|
|
|
import Lens.Micro ((&), (^.), (.~), (?~))
|
2019-08-09 11:06:13 -04:00
|
|
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
2019-08-10 10:01:36 -04:00
|
|
|
import Text.RawString.QQ (r)
|
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
|
|
|
|
pPointsSpec
|
2019-08-22 03:06:36 -04:00
|
|
|
teamPointsSpec
|
2019-08-10 10:01:36 -04:00
|
|
|
playerSpec
|
2019-08-11 10:24:39 -04:00
|
|
|
goalieSpec
|
2019-08-16 11:49:04 -04:00
|
|
|
databaseSpec
|
2019-08-22 13:05:25 -04:00
|
|
|
gameTypeLSpec
|
2019-08-22 14:19:43 -04:00
|
|
|
homeScoreLSpec
|
2019-08-21 00:21:22 -04:00
|
|
|
Menu.spec
|
2019-08-09 11:06:13 -04:00
|
|
|
|
2019-08-10 10:01:36 -04:00
|
|
|
pPointsSpec :: Spec
|
2019-08-09 11:06:13 -04:00
|
|
|
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 )
|
|
|
|
]
|
2019-08-10 10:01:36 -04:00
|
|
|
|
2019-08-22 03:06:36 -04:00
|
|
|
teamPointsSpec :: Spec
|
|
|
|
teamPointsSpec = describe "teamPoints" $ do
|
|
|
|
let
|
|
|
|
m t = NewGame $ newGameState
|
2019-08-22 10:25:23 -04:00
|
|
|
& gameType ?~ t
|
|
|
|
& homeScore ?~ 1
|
|
|
|
& awayScore ?~ 2
|
2019-08-22 03:06:36 -04:00
|
|
|
s t = newProgState
|
|
|
|
& progMode .~ m t
|
|
|
|
|
|
|
|
context "unexpected state" $
|
|
|
|
it "should return Nothing" $
|
|
|
|
teamPoints newProgState `shouldBe` Nothing
|
|
|
|
|
|
|
|
context "HomeGame" $
|
|
|
|
it "should return 1" $
|
|
|
|
teamPoints (s HomeGame) `shouldBe` Just 1
|
|
|
|
|
|
|
|
context "AwayGame" $
|
|
|
|
it "should return 2" $
|
|
|
|
teamPoints (s AwayGame) `shouldBe` Just 2
|
|
|
|
|
2019-08-10 10:01:36 -04:00
|
|
|
playerSpec :: Spec
|
|
|
|
playerSpec = describe "Player" $ do
|
|
|
|
|
|
|
|
describe "decode" $
|
|
|
|
it "should decode" $
|
|
|
|
decode playerJSON `shouldBe` Just player
|
|
|
|
|
|
|
|
describe "encode" $
|
|
|
|
it "should encode" $
|
|
|
|
decode (encode player) `shouldBe` Just player
|
|
|
|
|
2019-08-11 10:24:39 -04:00
|
|
|
goalieSpec :: Spec
|
|
|
|
goalieSpec = describe "Goalie" $ do
|
|
|
|
|
|
|
|
describe "decode" $
|
|
|
|
it "should decode" $
|
|
|
|
decode goalieJSON `shouldBe` Just goalie
|
|
|
|
|
|
|
|
describe "encode" $
|
|
|
|
it "should encode" $
|
|
|
|
decode (encode goalie) `shouldBe` Just goalie
|
|
|
|
|
2019-08-16 11:49:04 -04:00
|
|
|
databaseSpec :: Spec
|
|
|
|
databaseSpec = describe "Database" $ do
|
|
|
|
|
|
|
|
describe "decode" $
|
|
|
|
it "should decode" $
|
|
|
|
decode dbJSON `shouldBe` Just db
|
|
|
|
|
|
|
|
describe "encode" $
|
|
|
|
it "should encode" $
|
|
|
|
decode (encode db) `shouldBe` Just db
|
|
|
|
|
2019-08-22 13:05:25 -04:00
|
|
|
gameTypeLSpec :: Spec
|
|
|
|
gameTypeLSpec = describe "gameTypeL" $ do
|
|
|
|
|
|
|
|
context "getter" $ do
|
|
|
|
|
|
|
|
context "unexpected mode" $
|
|
|
|
it "return Nothing" $
|
|
|
|
MainMenu ^. gameTypeL `shouldBe` Nothing
|
|
|
|
|
|
|
|
mapM_
|
|
|
|
(\t -> context (show t) $
|
|
|
|
it ("should return " ++ show t) $ let
|
|
|
|
gs = newGameState & gameType ?~ t
|
|
|
|
m = NewGame gs
|
|
|
|
in m ^. gameTypeL `shouldBe` Just t)
|
|
|
|
[HomeGame, AwayGame]
|
|
|
|
|
|
|
|
context "setter" $ do
|
|
|
|
|
|
|
|
context "unexpected mode" $
|
|
|
|
mapM_
|
|
|
|
(\t -> context (show t) $
|
|
|
|
it ("should set to " ++ show t) $ let
|
|
|
|
m = MainMenu & gameTypeL ?~ t
|
|
|
|
in m ^. gameTypeL `shouldBe` Just t)
|
|
|
|
[HomeGame, AwayGame]
|
|
|
|
|
|
|
|
context "expected mode" $
|
|
|
|
mapM_
|
|
|
|
(\t -> context (show t) $
|
|
|
|
it ("should set to " ++ show t) $ let
|
|
|
|
m = NewGame newGameState & gameTypeL ?~ t
|
|
|
|
in m ^. gameTypeL `shouldBe` Just t)
|
|
|
|
[HomeGame, AwayGame]
|
|
|
|
|
2019-08-22 14:19:43 -04:00
|
|
|
homeScoreLSpec = describe "homeScoreL" $ do
|
|
|
|
|
|
|
|
context "getter" $ do
|
|
|
|
|
|
|
|
context "unexpected mode" $
|
|
|
|
it "should return Nothing" $
|
|
|
|
MainMenu ^. homeScoreL `shouldBe` Nothing
|
|
|
|
|
|
|
|
context "expected mode" $
|
|
|
|
it "should return 0" $ let
|
|
|
|
gs = newGameState & homeScore ?~ 0
|
|
|
|
m = NewGame gs
|
|
|
|
in m ^. homeScoreL `shouldBe` Just 0
|
|
|
|
|
|
|
|
context "setter" $ do
|
|
|
|
|
|
|
|
context "unexpected mode" $
|
|
|
|
it "should set the points" $ let
|
|
|
|
m = MainMenu & homeScoreL ?~ 0
|
|
|
|
in m ^. homeScoreL `shouldBe` Just 0
|
|
|
|
|
|
|
|
context "expected mode" $
|
|
|
|
it "should set the points" $ let
|
|
|
|
m = NewGame newGameState & homeScoreL ?~ 0
|
|
|
|
in m ^. homeScoreL `shouldBe` Just 0
|
|
|
|
|
2019-08-10 10:01:36 -04:00
|
|
|
player :: Player
|
|
|
|
player = newPlayer 1 "Joe" "centre"
|
|
|
|
& pYtd . psGoals .~ 2
|
|
|
|
& pYtd . psAssists .~ 3
|
|
|
|
& pYtd . psPMin .~ 4
|
|
|
|
& pLifetime . psGoals .~ 5
|
|
|
|
& pLifetime . psAssists .~ 6
|
|
|
|
& pLifetime . psPMin .~ 7
|
|
|
|
|
2019-08-11 10:24:39 -04:00
|
|
|
goalie :: Goalie
|
|
|
|
goalie = newGoalie 1 "Joe"
|
|
|
|
& gYtd . gsGames .~ 2
|
|
|
|
& gYtd . gsMinsPlayed .~ 3
|
|
|
|
& gYtd . gsGoalsAllowed .~ 4
|
|
|
|
& gYtd . gsGoalsAgainst .~ 5
|
|
|
|
& gYtd . gsWins .~ 6
|
|
|
|
& gYtd . gsLosses .~ 7
|
|
|
|
& gYtd . gsTies .~ 8
|
|
|
|
& gLifetime . gsGames .~ 9
|
|
|
|
& gLifetime . gsMinsPlayed .~ 10
|
|
|
|
& gLifetime . gsGoalsAllowed .~ 11
|
|
|
|
& gLifetime . gsGoalsAgainst .~ 12
|
|
|
|
& gLifetime . gsWins .~ 13
|
|
|
|
& gLifetime . gsLosses .~ 14
|
|
|
|
& gLifetime . gsTies .~ 15
|
|
|
|
|
2019-08-16 11:49:04 -04:00
|
|
|
db :: Database
|
|
|
|
db = newDatabase
|
|
|
|
& dbPlayers .~ [player]
|
|
|
|
& dbGoalies .~ [goalie]
|
2019-08-19 09:31:24 -04:00
|
|
|
& dbGames .~ 1
|
2019-08-16 11:49:04 -04:00
|
|
|
|
2019-08-10 10:01:36 -04:00
|
|
|
playerJSON :: ByteString
|
|
|
|
playerJSON = [r|
|
|
|
|
{ "number": 1
|
|
|
|
, "name": "Joe"
|
|
|
|
, "position": "centre"
|
|
|
|
, "ytd":
|
|
|
|
{ "goals": 2
|
|
|
|
, "assists": 3
|
|
|
|
, "penalty_mins": 4
|
|
|
|
}
|
|
|
|
, "lifetime":
|
|
|
|
{ "goals": 5
|
|
|
|
, "assists": 6
|
|
|
|
, "penalty_mins": 7
|
|
|
|
}
|
|
|
|
}|]
|
2019-08-11 10:24:39 -04:00
|
|
|
|
|
|
|
goalieJSON :: ByteString
|
|
|
|
goalieJSON = [r|
|
|
|
|
{ "number": 1
|
|
|
|
, "name": "Joe"
|
|
|
|
, "ytd":
|
|
|
|
{ "games": 2
|
|
|
|
, "mins_played": 3
|
|
|
|
, "goals_allowed": 4
|
|
|
|
, "goals_against": 5
|
|
|
|
, "wins": 6
|
|
|
|
, "losses": 7
|
|
|
|
, "ties": 8
|
|
|
|
}
|
|
|
|
, "lifetime":
|
|
|
|
{ "games": 9
|
|
|
|
, "mins_played": 10
|
|
|
|
, "goals_allowed": 11
|
|
|
|
, "goals_against": 12
|
|
|
|
, "wins": 13
|
|
|
|
, "losses": 14
|
|
|
|
, "ties": 15
|
|
|
|
}
|
|
|
|
}|]
|
2019-08-16 11:49:04 -04:00
|
|
|
|
|
|
|
dbJSON :: ByteString
|
|
|
|
dbJSON = [r|
|
|
|
|
{ "players":
|
|
|
|
[ |] <> playerJSON <> [r| ]
|
|
|
|
, "goalies":
|
|
|
|
[ |] <> goalieJSON <> [r| ]
|
2019-08-19 09:31:24 -04:00
|
|
|
, "games": 1
|
2019-08-16 11:49:04 -04:00
|
|
|
}|]
|