JSON encoding/decoding of players

package.yaml

@@ -21,7 +21,10 @@ 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:

src/Mtlstats/Types.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
 
 module Mtlstats.Types (
   -- * Types
@@ -22,6 +22,18 @@ module Mtlstats.Types (
   pPoints
 ) where
 
+import Data.Aeson
+  ( FromJSON
+  , ToJSON
+  , object
+  , pairs
+  , parseJSON
+  , toEncoding
+  , toJSON
+  , withObject
+  , (.:)
+  , (.=)
+  )
 import Lens.Micro ((^.))
 import Lens.Micro.TH (makeLenses)
 
@@ -39,6 +51,29 @@ data Player = Player
   -- ^ 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
@@ -49,6 +84,23 @@ data PlayerStats = PlayerStats
   -- ^ 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
 

test/TypesSpec.hs

@@ -1,13 +1,20 @@
+{-# 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" pPointsSpec
+spec = describe "Mtlstats.Types" $ do
+  pPointsSpec
+  playerSpec
 
+pPointsSpec :: Spec
 pPointsSpec = describe "pPoints" $ mapM_
   (\(goals, assists, points) -> let
     desc = "goals: " ++ show goals ++
@@ -24,3 +31,40 @@ pPointsSpec = describe "pPoints" $ mapM_
   , ( 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
+    }
+  }|]