prompt for confirmation of game input

src/Mtlstats/Control.hs

@@ -24,11 +24,13 @@ module Mtlstats.Control (dispatch) where
 import Control.Monad (when)
 import Control.Monad.Trans.State (modify)
 import Data.Char (toUpper)
+import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (.~))
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Format
+import Mtlstats.Handlers
 import Mtlstats.Menu
 import Mtlstats.Prompt
 import Mtlstats.Report
@@ -38,121 +40,157 @@ import Mtlstats.Types
 -- run
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-
+  MainMenu  -> mainMenuC
-  MainMenu -> Controller
+  NewSeason -> newSeasonC
-    { drawController   = const $ drawMenu mainMenu
-    , handleController = menuHandler mainMenu
-    }
-
-  NewSeason -> Controller
-    { drawController   = const $ drawMenu newSeasonMenu
-    , handleController = \e -> do
-      menuHandler newSeasonMenu e
-      return True
-    }
-
   NewGame gs
+    | null $ gs^.gameYear     -> gameYearC
+    | null $ gs^.gameMonth    -> gameMonthC
+    | null $ gs^.gameDay      -> gameDayC
+    | null $ gs^.gameType     -> gameTypeC
+    | null $ gs^.otherTeam    -> otherTeamC
+    | null $ gs^.homeScore    -> homeScoreC
+    | null $ gs^.awayScore    -> awayScoreC
+    | null $ gs^.overtimeFlag -> overtimeFlagC
+    | not $ gs^.dataVerified  -> verifyDataC
+    | otherwise               -> reportC
 
-    | null $ gs^.gameYear -> Controller
+mainMenuC :: Controller
-      { drawController = \s -> do
+mainMenuC = Controller
-        header s
+  { drawController   = const $ drawMenu mainMenu
-        drawPrompt gameYearPrompt s
+  , handleController = menuHandler mainMenu
-      , handleController = \e -> do
+  }
-        promptHandler gameYearPrompt e
-        return True
-      }
 
-    | null $ gs^.gameMonth -> Controller
+newSeasonC :: Controller
-      { drawController = \s -> do
+newSeasonC = Controller
-        header s
+  { drawController   = const $ drawMenu newSeasonMenu
-        drawMenu gameMonthMenu
+  , handleController = \e -> do
-      , handleController = \e -> do
+    menuHandler newSeasonMenu e
-        menuHandler gameMonthMenu e
+    return True
-        return True
+  }
-      }
 
-    | null $ gs^.gameDay -> Controller
+gameYearC :: Controller
-      { drawController = \s -> do
+gameYearC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt gameDayPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameYearPrompt s
-        promptHandler gameDayPrompt e
+  , handleController = \e -> do
-        modify validateGameDate
+    promptHandler gameYearPrompt e
-        return True
+    return True
-      }
+  }
 
-    | null $ gs^.gameType -> Controller
+gameMonthC :: Controller
-      { drawController = \s -> do
+gameMonthC = Controller
-        header s
+  { drawController = \s -> do
-        drawMenu gameTypeMenu
+    header s
-      , handleController = \e -> do
+    drawMenu gameMonthMenu
-        menuHandler gameTypeMenu e
+  , handleController = \e -> do
-        return True
+    menuHandler gameMonthMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.otherTeam -> Controller
+gameDayC :: Controller
-      { drawController = \s -> do
+gameDayC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt otherTeamPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameDayPrompt s
-        promptHandler otherTeamPrompt e
+  , handleController = \e -> do
-        return True
+    promptHandler gameDayPrompt e
-      }
+    modify validateGameDate
+    return True
+  }
 
-    | null $ gs^.homeScore -> Controller
+gameTypeC :: Controller
-      { drawController = \s -> do
+gameTypeC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt homeScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawMenu gameTypeMenu
-        promptHandler homeScorePrompt e
+  , handleController = \e -> do
-        return True
+    menuHandler gameTypeMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.awayScore -> Controller
+otherTeamC :: Controller
-      { drawController = \s -> do
+otherTeamC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt awayScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt otherTeamPrompt s
-        promptHandler awayScorePrompt e
+  , handleController = \e -> do
-        modify overtimeCheck
+    promptHandler otherTeamPrompt e
+    return True
+  }
+
+homeScoreC :: Controller
+homeScoreC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt homeScorePrompt s
+  , handleController = \e -> do
+    promptHandler homeScorePrompt e
+    return True
+  }
+
+awayScoreC :: Controller
+awayScoreC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt awayScorePrompt s
+  , handleController = \e -> do
+    promptHandler awayScorePrompt e
+    modify overtimeCheck
+    return True
+  }
+
+overtimeFlagC :: Controller
+overtimeFlagC = Controller
+  { drawController = \s -> do
+    header s
+    C.drawString "Did the game go into overtime?  (Y/N)"
+    return C.CursorInvisible
+  , handleController = \e -> do
+    modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
+    return True
+  }
+
+verifyDataC :: Controller
+verifyDataC = Controller
+  { drawController = \s -> do
+    let gs = s^.progMode.gameStateL
+    header s
+    C.drawString "\n"
+    C.drawString $ "      Date: " ++ date gs ++ "\n"
+    C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
+    C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
+    C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
+    C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
+    C.drawString $ "  Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
+    C.drawString "Is the above information correct?  (Y/N)"
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True  -> do
+        modify $ progMode.gameStateL.dataVerified .~ True
         modify updateGameStats
-        return True
+      Just False -> modify $ progMode.gameStateL .~ newGameState
-      }
+      Nothing    -> return ()
+    return True
+  }
 
-    | null $ gs^.overtimeFlag -> Controller
+reportC :: Controller
-      { drawController = \s -> do
+reportC = Controller
-        header s
+  { drawController = \s -> do
-        C.drawString "Did the game go into overtime?  (Y/N)"
+    (_, cols) <- C.windowSize
-        return C.CursorInvisible
+    C.drawString $ report (fromInteger $ pred cols) s
-      , handleController = \e -> do
+    return C.CursorInvisible
-        overtimePrompt e
+  , handleController = \e -> do
-        modify updateGameStats
+    when
-        return True
+      (case e of
-      }
+        C.EventCharacter _  -> True
-
+        C.EventSpecialKey _ -> True
-    | otherwise -> Controller
+        _                   -> False) $
-      { drawController = \s -> do
+      modify $ progMode .~ MainMenu
-        (_, cols) <- C.windowSize
+    return True
-        C.drawString $ report (fromInteger $ pred cols) s
+  }
-        return C.CursorInvisible
-      , handleController = \e -> do
-        when
-          (case e of
-            C.EventCharacter _  -> True
-            C.EventSpecialKey _ -> True
-            _                   -> False) $
-          modify $ progMode .~ MainMenu
-        return True
-      }
 
 header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
-
-overtimePrompt :: C.Event -> Action ()
-overtimePrompt (C.EventCharacter c) = modify $
-  progMode.gameStateL.overtimeFlag .~ case toUpper c of
-    'Y' -> Just True
-    'N' -> Just False
-    _   -> Nothing
-overtimePrompt _ = return ()