Merge pull request #4 from mtlstats/player

Implemented Player type
This commit is contained in:
Jonathan Lamothe 2019-08-10 10:47:10 -04:00 committed by GitHub
commit a988dfa22c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 212 additions and 1 deletions

View File

@ -21,6 +21,11 @@ description: Please see the README on GitHub at <https://github.com/jlam
dependencies:
- base >= 4.7 && < 5
- aeson >= 1.4.4.0 && < 1.5
- microlens-th >= 0.4.2.3 && < 0.5
- raw-strings-qq >= 1.1 && < 1.2
- bytestring
- microlens
library:
source-dirs: src

134
src/Mtlstats/Types.hs Normal file
View File

@ -0,0 +1,134 @@
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Mtlstats.Types (
-- * Types
Player (..),
PlayerStats (..),
-- * Lenses
-- ** Player Lenses
pNumber,
pName,
pPosition,
pYtd,
pLifetime,
-- ** PlayerStats Lenses
psGoals,
psAssists,
psPMin,
-- * Constructors
newPlayer,
newPlayerStats,
-- * Helper functions
pPoints
) where
import Data.Aeson
( FromJSON
, ToJSON
, object
, pairs
, parseJSON
, toEncoding
, toJSON
, withObject
, (.:)
, (.=)
)
import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses)
-- | 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
, _pYtd :: PlayerStats
-- ^ The Player's year-to-date stats
, _pLifetime :: PlayerStats
-- ^ The player's lifetime stats
} deriving (Eq, Show)
instance FromJSON Player where
parseJSON = withObject "Player" $ \v -> Player
<$> v .: "number"
<*> v .: "name"
<*> v .: "position"
<*> v .: "ytd"
<*> v .: "lifetime"
instance ToJSON Player where
toJSON (Player num name pos ytd lt) = object
[ "number" .= num
, "name" .= name
, "position" .= pos
, "ytd" .= ytd
, "lifetime" .= lt
]
toEncoding (Player num name pos ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"position" .= pos <>
"ytd" .= ytd <>
"lifetime" .= lt
-- | 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)
instance FromJSON PlayerStats where
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
<$> v .: "goals"
<*> v .: "assists"
<*> v .: "penalty_mins"
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
makeLenses ''Player
makeLenses ''PlayerStats
-- | 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
, _pYtd = newPlayerStats
, _pLifetime = newPlayerStats
}
-- | Constructor for a 'PlayerStats' value
newPlayerStats :: PlayerStats
newPlayerStats = PlayerStats
{ _psGoals = 0
, _psAssists = 0
, _psPMin = 0
}
-- | Calculates a player's points
pPoints :: PlayerStats -> Int
pPoints s = s^.psGoals + s^.psAssists

View File

@ -1,4 +1,6 @@
import Test.Hspec (hspec)
import qualified TypesSpec as Types
main :: IO ()
main = hspec $ return ()
main = hspec Types.spec

70
test/TypesSpec.hs Normal file
View File

@ -0,0 +1,70 @@
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module TypesSpec (spec) where
import Data.Aeson (decode, encode)
import Data.ByteString.Lazy (ByteString)
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.RawString.QQ (r)
import Mtlstats.Types
spec :: Spec
spec = describe "Mtlstats.Types" $ do
pPointsSpec
playerSpec
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 )
]
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
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
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
}
}|]