From 4519ba4732bef242794dac4f58fcb1e26837681c Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jlamothe1980@gmail.com>
Date: Thu, 24 Oct 2019 01:10:42 -0400
Subject: [PATCH] made lensSpec more generic

---
 test/TypesSpec.hs | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs
index 8b09dfe..807a0e1 100644
--- a/test/TypesSpec.hs
+++ b/test/TypesSpec.hs
@@ -82,13 +82,16 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
 gameStateLSpec :: Spec
 gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   -- getters
-  [ ( MainMenu,              newGameState )
-  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  [ ( "missing state", MainMenu,              newGameState )
+  , ( "home game",     NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "away game",     NewGame $ gs AwayGame, gs AwayGame  )
   ]
   -- setters
-  [ ( MainMenu,              gs HomeGame  )
-  , ( NewGame $ gs HomeGame, gs AwayGame  )
-  , ( NewGame $ gs HomeGame, newGameState )
+  [ ( "set home",     MainMenu,              gs HomeGame  )
+  , ( "home to away", NewGame $ gs HomeGame, gs AwayGame  )
+  , ( "away to home", NewGame $ gs AwayGame, gs HomeGame  )
+  , ( "clear home",   NewGame $ gs HomeGame, newGameState )
+  , ( "clear away",   NewGame $ gs AwayGame, newGameState )
   ]
   where gs t = newGameState & gameType ?~ t
 
@@ -180,24 +183,23 @@ jsonSpec x j = do
       decode (encode x) `shouldBe` Just x
 
 lensSpec
-  :: (Eq a, Show s, Show a)
+  :: Comparable a
   => Lens' s a
-  -> [(s, a)]
-  -> [(s, a)]
+  -> [(String, s, a)]
+  -> [(String, s, a)]
   -> Spec
-lensSpec l gs ss = do
+lensSpec lens getters setters = do
 
   context "getters" $ mapM_
-    (\(s, x) -> context (show s) $
-      it ("should be " ++ show x) $
-        s ^. l `shouldBe` x)
-    gs
+    (\(label, s, x) -> context label $
+      compareTest (s^.lens) x)
+    getters
 
   context "setters" $ mapM_
-    (\(s, x) -> context (show s) $
-      it ("should set to " ++ show x) $
-        (s & l .~ x) ^. l `shouldBe` x)
-    ss
+    (\(label, s, x) -> context label $ let
+      s' = s & lens .~ x
+      in compareTest (s'^.lens) x)
+    setters
 
 player :: Player
 player = newPlayer 1 "Joe" "centre"