Merge pull request #9 from mtlstats/other-team

Other team prompt

src/Mtlstats/Events.hs

@@ -45,6 +45,9 @@ handleEvent e = gets (view progMode) >>= \case
     | null $ gs ^. gameType -> do
       menuHandler gameTypeMenu e
       return True
+    | null $ gs ^. otherTeam -> do
+      promptHandler otherTeamPrompt e
+      return True
     | null $ gs ^. homeScore -> do
       promptHandler homeScorePrompt e
       return True

src/Mtlstats/Prompt.hs

@@ -23,8 +23,10 @@ module Mtlstats.Prompt (
   -- * Prompt Functions
   drawPrompt,
   promptHandler,
+  strPrompt,
   numPrompt,
   -- * Individual prompts
+  otherTeamPrompt,
   homeScorePrompt,
   awayScorePrompt
 ) where
@@ -63,6 +65,20 @@ promptHandler p (C.EventSpecialKey (C.KeyFunction k)) =
   promptFunctionKey p k
 promptHandler _ _ = return ()
 
+-- | Builds a string prompt
+strPrompt
+  :: String
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+strPrompt pStr act = Prompt
+  { promptDrawer      = drawSimplePrompt pStr
+  , promptCharCheck   = const True
+  , promptAction      = act
+  , promptFunctionKey = const $ return ()
+  }
+
 -- | Builds a numeric prompt
 numPrompt
   :: String
@@ -71,12 +87,16 @@ numPrompt
   -- ^ The callback function for the result
   -> Prompt
 numPrompt pStr act = Prompt
-  { promptDrawer      = \s -> C.drawString $ pStr ++ s ^. inputBuffer
+  { promptDrawer      = drawSimplePrompt pStr
   , promptCharCheck   = isDigit
   , promptAction      = \inStr -> forM_ (readMaybe inStr) act
   , promptFunctionKey = const $ return ()
   }
 
+otherTeamPrompt :: Prompt
+otherTeamPrompt = strPrompt "Other team: " $
+  modify . (progMode . otherTeamL .~)
+
 homeScorePrompt :: Prompt
 homeScorePrompt = numPrompt "Home score: " $
   modify . (progMode . homeScoreL ?~)
@@ -84,3 +104,6 @@ homeScorePrompt = numPrompt "Home score: " $
 awayScorePrompt :: Prompt
 awayScorePrompt = numPrompt "Away score: " $
   modify . (progMode . awayScoreL ?~)
+
+drawSimplePrompt :: String -> ProgState -> C.Update ()
+drawSimplePrompt pStr s = C.drawString $ pStr ++ s ^. inputBuffer

src/Mtlstats/Types.hs

@@ -41,10 +41,12 @@ module Mtlstats.Types (
   inputBuffer,
   -- ** GameState Lenses
   gameType,
+  otherTeam,
   homeScore,
   awayScore,
   -- ** ProgMode Lenses
   gameTypeL,
+  otherTeamL,
   homeScoreL,
   awayScoreL,
   -- ** Database Lenses
@@ -123,6 +125,8 @@ data ProgState = ProgState
 data GameState = GameState
   { _gameType  :: Maybe GameType
   -- ^ The type of game (home/away)
+  , _otherTeam :: String
+  -- ^ The name of the other team
   , _homeScore :: Maybe Int
   -- ^ The home team's score
   , _awayScore :: Maybe Int
@@ -341,6 +345,15 @@ gameTypeL = lens
     NewGame gs -> NewGame $ gs & gameType .~ gt
     _          -> NewGame $ newGameState & gameType .~ gt)
 
+otherTeamL :: Lens' ProgMode String
+otherTeamL = lens
+  (\case
+    NewGame gs -> gs ^. otherTeam
+    _          -> "")
+  (\m ot -> case m of
+    NewGame gs -> NewGame $ gs & otherTeam .~ ot
+    _          -> NewGame $ newGameState & otherTeam .~ ot)
+
 homeScoreL :: Lens' ProgMode (Maybe Int)
 homeScoreL = lens
   (\case
@@ -371,6 +384,7 @@ newProgState = ProgState
 newGameState :: GameState
 newGameState = GameState
   { _gameType  = Nothing
+  , _otherTeam = ""
   , _homeScore = Nothing
   , _awayScore = Nothing
   }

src/Mtlstats/UI.hs

@@ -41,6 +41,7 @@ draw s = do
       NewSeason -> drawMenu newSeasonMenu
       NewGame gs
         | null $ gs ^. gameType  -> drawMenu gameTypeMenu
+        | null $ gs ^. otherTeam -> drawPrompt otherTeamPrompt s
         | null $ gs ^. homeScore -> drawPrompt homeScorePrompt s
         | null $ gs ^. awayScore -> drawPrompt awayScorePrompt s
         | otherwise              -> undefined

test/TypesSpec.hs

@@ -39,6 +39,7 @@ spec = describe "Mtlstats.Types" $ do
   goalieSpec
   databaseSpec
   gameTypeLSpec
+  otherTeamLSpec
   homeScoreLSpec
   awayScoreLSpec
   teamScoreSpec
@@ -130,6 +131,33 @@ gameTypeLSpec = describe "gameTypeL" $ do
             in m ^. gameTypeL `shouldBe` Just t)
         [HomeGame, AwayGame]
 
+otherTeamLSpec :: Spec
+otherTeamLSpec = describe "otherTeamL" $ do
+
+  context "getter" $ do
+
+    context "unexpected mode" $
+      it "should return an empty string" $
+        MainMenu ^. otherTeamL `shouldBe` ""
+
+    context "expected mode" $
+      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
 
   context "getter" $ do