created generic lens spec

test/TypesSpec.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, RankNTypes #-}
 
 module TypesSpec (spec) where
 
@@ -27,7 +27,7 @@ import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.HashMap.Strict as HM
-import Lens.Micro ((&), (^.), (.~), (?~))
+import Lens.Micro (Lens', (&), (^.), (.~), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Types
@@ -81,119 +81,51 @@ pPointsSpec = describe "pPoints" $ mapM_
   ]
 
 gameTypeLSpec :: Spec
-gameTypeLSpec = describe "gameTypeL" $ do
+gameTypeLSpec = describe "gameTypeL" $ lensSpec gameTypeL
-
+  [ ( MainMenu,   Nothing       )
-  context "getter" $ do
+  , ( m HomeGame, Just HomeGame )
-
+  , ( m AwayGame, Just AwayGame )
-    context "unexpected mode" $
+  ]
-      it "should return Nothing" $
+  [ ( MainMenu,   Just HomeGame )
-        MainMenu ^. gameTypeL `shouldBe` Nothing
+  , ( MainMenu,   Just AwayGame )
-
+  , ( m HomeGame, Just AwayGame )
-    mapM_
+  , ( m AwayGame, Just HomeGame )
-      (\t -> context (show t) $
+  , ( m HomeGame, Nothing       )
-        it ("should return " ++ show t) $ let
+  ]
-          gs = newGameState & gameType ?~ t
+  where m t = NewGame $ 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]
 
 otherTeamLSpec :: Spec
-otherTeamLSpec = describe "otherTeamL" $ do
+otherTeamLSpec = describe "otherTeamL" $ lensSpec otherTeamL
-
+  [ ( MainMenu, ""    )
-  context "getter" $ do
+  , ( m "foo",  "foo" )
-
+  ]
-    context "unexpected mode" $
+  [ ( MainMenu, "foo" )
-      it "should return an empty string" $
+  , ( m "foo",  "bar" )
-        MainMenu ^. otherTeamL `shouldBe` ""
+  , ( m "foo",  ""    )
-
+  ]
-    context "expected mode" $
+  where m t = NewGame $ newGameState & otherTeam .~ t
-      it "should return \"foo\"" $ let
-        m = NewGame $ newGameState & otherTeam .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      it "should set the value" $ let
-        m = MainMenu & otherTeamL .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
-
-    context "expected mode" $
-      it "should set the value" $ let
-        m = NewGame newGameState & otherTeamL .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
 
 homeScoreLSpec :: Spec
-homeScoreLSpec = describe "homeScoreL" $ do
+homeScoreLSpec = describe "homeScoreL" $ lensSpec homeScoreL
-
+  [ ( MainMenu, Nothing )
-  context "getter" $ do
+  , ( m 1,      Just 1  )
-
+  ]
-    context "unexpected mode" $
+  [ ( MainMenu, Just 1  )
-      it "should return Nothing" $
+  , ( m 1,      Just 2  )
-        MainMenu ^. homeScoreL `shouldBe` Nothing
+  , ( m 1,      Nothing )
-
+  ]
-    context "expected mode" $
+  where m s = NewGame $ newGameState & homeScore ?~ s
-      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 home score" $ let
-        m = MainMenu & homeScoreL ?~ 0
-        in m ^. homeScoreL `shouldBe` Just 0
-
-    context "expected mode" $
-      it "should set home score" $ let
-        m = NewGame newGameState & homeScoreL ?~ 0
-        in m ^. homeScoreL `shouldBe` Just 0
 
 awayScoreLSpec :: Spec
-awayScoreLSpec = describe "awayScoreL" $ do
+awayScoreLSpec = describe "awayScoreL" $ lensSpec awayScoreL
-
+  [ ( MainMenu, Nothing )
-  context "getter" $ do
+  , ( m 1,      Just 1  )
-
+  ]
-    context "unexpected mode" $
+  [ ( MainMenu, Just 1  )
-      it "should return Nothing" $
+  , ( m 1,      Just 2  )
-        MainMenu ^. awayScoreL `shouldBe` Nothing
+  , ( m 1,      Nothing )
-
+  ]
-    context "expected mode" $
+  where m s = NewGame $ newGameState & awayScore ?~ s
-      it "should return 0" $ let
-        gs = newGameState & awayScore ?~ 0
-        m  = NewGame gs
-        in m ^. awayScoreL `shouldBe` Just 0
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      it "should set the away score" $ let
-        m = MainMenu & awayScoreL ?~ 0
-        in m ^. awayScoreL `shouldBe` Just 0
-
-    context "expected mode" $
-      it "should set the away score" $ let
-        m = NewGame newGameState & awayScoreL ?~ 0
-        in m ^. awayScoreL `shouldBe` Just 0
 
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
@@ -254,6 +186,26 @@ jsonSpec x j = do
     it "should encode" $
       decode (encode x) `shouldBe` Just x
 
+lensSpec
+  :: (Eq a, Show s, Show a)
+  => Lens' s a
+  -> [(s, a)]
+  -> [(s, a)]
+  -> Spec
+lensSpec l gs ss = do
+
+  context "getters" $ mapM_
+    (\(s, x) -> context (show s) $
+      it ("should be " ++ show x) $
+        s ^. l `shouldBe` x)
+    gs
+
+  context "setters" $ mapM_
+    (\(s, x) -> context (show s) $
+      it ("should set to " ++ show x) $
+        (s & l .~ x) ^. l `shouldBe` x)
+    ss
+
 player :: Player
 player = newPlayer 1 "Joe" "centre"
   & pYtd      .~ playerStats 1