implemented gameTypeL

src/Mtlstats/Types.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
+{-# LANGUAGE LambdaCase, OverloadedStrings, TemplateHaskell #-}
 
 module Mtlstats.Types (
   -- * Types
@@ -40,6 +40,8 @@ module Mtlstats.Types (
   gameType,
   homeScore,
   awayScore,
+  -- ** ProgMode Lenses
+  gameTypeL,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -94,7 +96,7 @@ import Data.Aeson
   , (.:)
   , (.=)
   )
-import Lens.Micro ((^.))
+import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 
 -- | Represents the program state
@@ -301,6 +303,15 @@ makeLenses ''PlayerStats
 makeLenses ''Goalie
 makeLenses ''GoalieStats
 
+gameTypeL :: Lens' ProgMode (Maybe GameType)
+gameTypeL = lens
+  (\case
+    NewGame gs -> gs ^. gameType
+    _          -> Nothing)
+  (\m gt -> case m of
+    NewGame gs -> NewGame $ gs & gameType .~ gt
+    _          -> NewGame $ newGameState & gameType .~ gt)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState

test/TypesSpec.hs

@@ -25,7 +25,7 @@ module TypesSpec (spec) where
 
 import Data.Aeson (decode, encode)
 import Data.ByteString.Lazy (ByteString)
-import Lens.Micro ((&), (.~), (?~))
+import Lens.Micro ((&), (^.), (.~), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.RawString.QQ (r)
 import Mtlstats.Types
@@ -39,6 +39,7 @@ spec = describe "Mtlstats.Types" $ do
   playerSpec
   goalieSpec
   databaseSpec
+  gameTypeLSpec
   Menu.spec
 
 pPointsSpec :: Spec
@@ -114,6 +115,41 @@ databaseSpec = describe "Database" $ do
     it "should encode" $
       decode (encode db) `shouldBe` Just db
 
+gameTypeLSpec :: Spec
+gameTypeLSpec = describe "gameTypeL" $ do
+
+  context "getter" $ do
+
+    context "unexpected mode" $
+      it "return Nothing" $
+        MainMenu ^. gameTypeL `shouldBe` Nothing
+
+    mapM_
+      (\t -> context (show t) $
+        it ("should return " ++ show t) $ let
+          gs = 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]
+
 player :: Player
 player = newPlayer 1 "Joe" "centre"
   & pYtd . psGoals        .~ 2