Merge pull request #11 from mtlstats/refactor

Refactor

src/Mtlstats.hs

@@ -24,13 +24,12 @@ module Mtlstats (initState, mainLoop) where
 import Control.Monad (void)
 import Control.Monad.Extra (whenM)
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State (get)
+import Control.Monad.Trans.State (get, gets)
 import Data.Maybe (fromJust)
 import qualified UI.NCurses as C
 
-import Mtlstats.Events
+import Mtlstats.Control
 import Mtlstats.Types
-import Mtlstats.UI
 
 -- | Initializes the progran
 initState :: C.Curses ProgState
@@ -42,7 +41,18 @@ initState = do
 -- | Main program loop
 mainLoop :: Action ()
 mainLoop = do
-  get >>= lift . draw
+  c <- gets dispatch
+  get >>= lift . draw . drawController c
   w <- lift C.defaultWindow
-  whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleEvent)
+  whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c)
     mainLoop
+
+draw :: C.Update C.CursorMode -> C.Curses ()
+draw u = do
+  void $ C.setCursorMode C.CursorInvisible
+  w  <- C.defaultWindow
+  cm <- C.updateWindow w $ do
+    C.clear
+    u
+  C.render
+  void $ C.setCursorMode cm

src/Mtlstats/Control.hs

@@ -0,0 +1,157 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control (dispatch) where
+
+import Control.Monad (when)
+import Control.Monad.Trans.State (modify)
+import Data.Char (toUpper)
+import Lens.Micro ((^.), (.~))
+import qualified UI.NCurses as C
+
+import Mtlstats.Actions
+import Mtlstats.Format
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Report
+import Mtlstats.Types
+
+-- | Reads the program state and returs the apropriate controller to
+-- run
+dispatch :: ProgState -> Controller
+dispatch s = case s^.progMode of
+
+  MainMenu -> Controller
+    { 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 -> Controller
+      { drawController = \s -> do
+        header s
+        drawPrompt gameYearPrompt s
+      , handleController = \e -> do
+        promptHandler gameYearPrompt e
+        return True
+      }
+
+    | null $ gs^.gameMonth -> Controller
+      { drawController = \s -> do
+        header s
+        drawMenu gameMonthMenu
+      , handleController = \e -> do
+        menuHandler gameMonthMenu e
+        return True
+      }
+
+    | null $ gs^.gameDay -> Controller
+      { drawController = \s -> do
+        header s
+        drawPrompt gameDayPrompt s
+      , handleController = \e -> do
+        promptHandler gameDayPrompt e
+        modify validateGameDate
+        return True
+      }
+
+    | null $ gs^.gameType -> Controller
+      { drawController = \s -> do
+        header s
+        drawMenu gameTypeMenu
+      , handleController = \e -> do
+        menuHandler gameTypeMenu e
+        return True
+      }
+
+    | null $ gs^.otherTeam -> Controller
+      { drawController = \s -> do
+        header s
+        drawPrompt otherTeamPrompt s
+      , handleController = \e -> do
+        promptHandler otherTeamPrompt e
+        return True
+      }
+
+    | null $ gs^.homeScore -> Controller
+      { drawController = \s -> do
+        header s
+        drawPrompt homeScorePrompt s
+      , handleController = \e -> do
+        promptHandler homeScorePrompt e
+        return True
+      }
+
+    | null $ gs^.awayScore -> Controller
+      { drawController = \s -> do
+        header s
+        drawPrompt awayScorePrompt s
+      , handleController = \e -> do
+        promptHandler awayScorePrompt e
+        modify overtimeCheck
+        modify updateGameStats
+        return True
+      }
+
+    | null $ gs^.overtimeFlag -> Controller
+      { drawController = \s -> do
+        header s
+        C.drawString "Did the game go into overtime?  (Y/N)"
+        return C.CursorInvisible
+      , handleController = \e -> do
+        overtimePrompt e
+        modify updateGameStats
+        return True
+      }
+
+    | otherwise -> Controller
+      { drawController = \s -> do
+        C.drawString $ report 72 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 ()

src/Mtlstats/Events.hs

@@ -1,89 +0,0 @@
-{- |
-
-mtlstats
-Copyright (C) 2019 Rhéal Lamothe
-<rheal.lamothe@gmail.com>
-
-This program is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program.  If not, see <https://www.gnu.org/licenses/>.
-
--}
-
-{-# LANGUAGE LambdaCase #-}
-
-module Mtlstats.Events (handleEvent) where
-
-import Control.Monad (when)
-import Control.Monad.Trans.State (gets, modify)
-import Data.Char (toUpper)
-import Lens.Micro ((^.), (.~))
-import Lens.Micro.Extras (view)
-import qualified UI.NCurses as C
-
-import Mtlstats.Actions
-import Mtlstats.Menu
-import Mtlstats.Prompt
-import Mtlstats.Types
-
--- | Event handler
-handleEvent
-  :: C.Event
-  -- ^ The event being handled
-  -> Action Bool
-handleEvent e = gets (view progMode) >>= \case
-  MainMenu  -> menuHandler mainMenu e
-  NewSeason -> menuHandler newSeasonMenu e >> return True
-  NewGame gs
-    | null $ gs^.gameYear -> do
-      promptHandler gameYearPrompt e
-      return True
-    | null $ gs^.gameMonth -> do
-      menuHandler gameMonthMenu e
-      return True
-    | null $ gs^.gameDay -> do
-      promptHandler gameDayPrompt e
-      modify validateGameDate
-      return True
-    | 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
-    | null $ gs^.awayScore -> do
-      promptHandler awayScorePrompt e
-      modify overtimeCheck
-      modify updateGameStats
-      return True
-    | null $ gs^.overtimeFlag -> do
-      overtimePrompt e
-        >>= modify . (progMode.gameStateL.overtimeFlag .~)
-      modify updateGameStats
-      return True
-    | otherwise -> do
-      when
-        (case e of
-          C.EventCharacter _  -> True
-          C.EventSpecialKey _ -> True
-          _                   -> False) $
-        modify $ progMode .~ MainMenu
-      return True
-
-overtimePrompt :: C.Event -> Action (Maybe Bool)
-overtimePrompt (C.EventCharacter c) = case toUpper c of
-  'Y' -> return (Just True)
-  'N' -> return (Just False)
-  _   -> return Nothing

src/Mtlstats/Menu.hs

@@ -67,8 +67,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
 -- | The new season menu
 newSeasonMenu :: Menu ()
 newSeasonMenu = Menu "*** SEASON TYPE ***" ()
-  [ MenuItem '1' "Regular Season" $
-    modify $ resetYtd . startNewGame
+  [ MenuItem '1' "Regular Season" $ do
+    modify resetYtd
+    modify startNewGame
   , MenuItem '2' "Playoffs" $
     modify startNewGame
   ]

src/Mtlstats/Types.hs

@@ -23,6 +23,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Types (
   -- * Types
+  Controller (..),
   Action,
   ProgState (..),
   GameState (..),
@@ -125,12 +126,20 @@ import Data.Aeson
   )
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
-import UI.NCurses (Curses, Update)
+import qualified UI.NCurses as C
 
 import Mtlstats.Config
 
+-- | Controls the program flow
+data Controller = Controller
+  { drawController   :: ProgState -> C.Update C.CursorMode
+  -- ^ The drawing phase
+  , handleController :: C.Event -> Action Bool
+  -- ^ The event handler
+  }
+
 -- | Action which maintains program state
-type Action a = StateT ProgState Curses a
+type Action a = StateT ProgState C.Curses a
 
 -- | Represents the program state
 data ProgState = ProgState
@@ -384,7 +393,7 @@ instance ToJSON GameStats where
 
 -- | Defines a user prompt
 data Prompt = Prompt
-  { promptDrawer      :: ProgState -> Update ()
+  { promptDrawer      :: ProgState -> C.Update ()
   -- ^ Draws the prompt to thr screen
   , promptCharCheck   :: Char -> Bool
   -- ^ Determines whether or not the character is valid

src/Mtlstats/UI.hs

@@ -1,69 +0,0 @@
-{- |
-
-mtlstats
-Copyright (C) 2019 Rhéal Lamothe
-<rheal.lamothe@gmail.com>
-
-This program is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program.  If not, see <https://www.gnu.org/licenses/>.
-
--}
-
-module Mtlstats.UI (draw) where
-
-import Control.Monad (void)
-import Lens.Micro ((^.))
-import qualified UI.NCurses as C
-
-import Mtlstats.Format
-import Mtlstats.Menu
-import Mtlstats.Prompt
-import Mtlstats.Report
-import Mtlstats.Types
-
--- | Drawing function
-draw :: ProgState -> C.Curses ()
-draw s = do
-  void $ C.setCursorMode C.CursorInvisible
-  w <- C.defaultWindow
-  cm <- C.updateWindow w $ do
-    C.clear
-    case s ^. progMode of
-      MainMenu  -> drawMenu mainMenu
-      NewSeason -> drawMenu newSeasonMenu
-      NewGame gs
-        | null $ gs^.gameYear     -> header s >> drawPrompt gameYearPrompt s
-        | null $ gs^.gameMonth    -> header s >> drawMenu gameMonthMenu
-        | null $ gs^.gameDay      -> header s >> drawPrompt gameDayPrompt s
-        | null $ gs^.gameType     -> header s >> drawMenu gameTypeMenu
-        | null $ gs^.otherTeam    -> header s >> drawPrompt otherTeamPrompt s
-        | null $ gs^.homeScore    -> header s >> drawPrompt homeScorePrompt s
-        | null $ gs^.awayScore    -> header s >> drawPrompt awayScorePrompt s
-        | null $ gs^.overtimeFlag -> header s >> overtimePrompt
-        | otherwise               -> showReport s
-  C.render
-  void $ C.setCursorMode cm
-
-header :: ProgState -> C.Update ()
-header s = C.drawString $
-  "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
-
-overtimePrompt :: C.Update C.CursorMode
-overtimePrompt = do
-  C.drawString "Did the game go into overtime?  (Y/N)"
-  return C.CursorInvisible
-
-showReport :: ProgState -> C.Update C.CursorMode
-showReport s = do
-  C.drawString $ report 72 s
-  return C.CursorInvisible