made lensSpec more generic

test/TypesSpec.hs

@@ -82,13 +82,16 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
 gameStateLSpec :: Spec
 gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   -- getters
-  [ ( MainMenu,              newGameState )
+  [ ( "missing state", MainMenu,              newGameState )
-  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "home game",     NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "away game",     NewGame $ gs AwayGame, gs AwayGame  )
   ]
   -- setters
-  [ ( MainMenu,              gs HomeGame  )
+  [ ( "set home",     MainMenu,              gs HomeGame  )
-  , ( NewGame $ gs HomeGame, gs AwayGame  )
+  , ( "home to away", NewGame $ gs HomeGame, gs AwayGame  )
-  , ( NewGame $ gs HomeGame, newGameState )
+  , ( "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)]
+  -> [(String, s, a)]
-  -> [(s, a)]
+  -> [(String, s, a)]
   -> Spec
-lensSpec l gs ss = do
+lensSpec lens getters setters = do
 
   context "getters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $
-      it ("should be " ++ show x) $
+      compareTest (s^.lens) x)
-        s ^. l `shouldBe` x)
+    getters
-    gs
 
   context "setters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $ let
-      it ("should set to " ++ show x) $
+      s' = s & lens .~ x
-        (s & l .~ x) ^. l `shouldBe` x)
+      in compareTest (s'^.lens) x)
-    ss
+    setters
 
 player :: Player
 player = newPlayer 1 "Joe" "centre"