commit
6cb348a4a8
|
@ -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,22 +40,36 @@ import Mtlstats.Types
|
|||
-- run
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
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
|
||||
|
||||
MainMenu -> Controller
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
NewSeason -> Controller
|
||||
newSeasonC :: Controller
|
||||
newSeasonC = Controller
|
||||
{ drawController = const $ drawMenu newSeasonMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler newSeasonMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
NewGame gs
|
||||
|
||||
| null $ gs^.gameYear -> Controller
|
||||
gameYearC :: Controller
|
||||
gameYearC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameYearPrompt s
|
||||
|
@ -62,7 +78,8 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.gameMonth -> Controller
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameMonthMenu
|
||||
|
@ -71,7 +88,8 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.gameDay -> Controller
|
||||
gameDayC :: Controller
|
||||
gameDayC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameDayPrompt s
|
||||
|
@ -81,7 +99,8 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.gameType -> Controller
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameTypeMenu
|
||||
|
@ -90,7 +109,8 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.otherTeam -> Controller
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt otherTeamPrompt s
|
||||
|
@ -99,7 +119,8 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.homeScore -> Controller
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt homeScorePrompt s
|
||||
|
@ -108,29 +129,54 @@ dispatch s = case s^.progMode of
|
|||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.awayScore -> Controller
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = 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
|
||||
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
|
||||
overtimePrompt e
|
||||
modify updateGameStats
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
| otherwise -> Controller
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ " Date: " ++ gameDate 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
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(_, cols) <- C.windowSize
|
||||
C.drawString $ report (fromInteger $ pred cols) s
|
||||
|
@ -148,11 +194,3 @@ dispatch s = case s^.progMode of
|
|||
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 ()
|
||||
|
|
|
@ -0,0 +1,33 @@
|
|||
{- |
|
||||
|
||||
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.Handlers (ynHandler) where
|
||||
|
||||
import Data.Char (toUpper)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
-- | Handler for a yes/no prompt
|
||||
ynHandler :: C.Event -> Maybe Bool
|
||||
ynHandler (C.EventCharacter c) = case toUpper c of
|
||||
'Y' -> Just True
|
||||
'N' -> Just False
|
||||
_ -> Nothing
|
||||
ynHandler _ = Nothing
|
|
@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
|
||||
-}
|
||||
|
||||
module Mtlstats.Report (report) where
|
||||
module Mtlstats.Report (report, gameDate) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
|
@ -40,6 +40,7 @@ report width s = unlines $ fromMaybe [] $ do
|
|||
db = s^.database
|
||||
gs = s^.progMode.gameStateL
|
||||
gNum = db^.dbGames
|
||||
date = gameDate gs
|
||||
hTeam = homeTeam gs
|
||||
aTeam = awayTeam gs
|
||||
hStats = db^.dbHomeGameStats
|
||||
|
@ -47,10 +48,6 @@ report width s = unlines $ fromMaybe [] $ do
|
|||
tStats = addGameStats hStats aStats
|
||||
hScore <- gs^.homeScore
|
||||
aScore <- gs^.awayScore
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
year <- show <$> gs^.gameYear
|
||||
let date = month ++ " " ++ day ++ " " ++ year
|
||||
Just
|
||||
[ overlay
|
||||
("GAME NUMBER " ++ padNum 2 gNum)
|
||||
|
@ -81,6 +78,13 @@ report width s = unlines $ fromMaybe [] $ do
|
|||
++ showStats tStats
|
||||
]
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
year <- show <$> gs^.gameYear
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
Just $ month ++ " " ++ day ++ " " ++ year
|
||||
|
||||
showStats :: GameStats -> String
|
||||
showStats gs
|
||||
= right 2 (show $ gmsGames gs)
|
||||
|
|
|
@ -52,6 +52,7 @@ module Mtlstats.Types (
|
|||
homeScore,
|
||||
awayScore,
|
||||
overtimeFlag,
|
||||
dataVerified,
|
||||
-- ** Database Lenses
|
||||
dbPlayers,
|
||||
dbGoalies,
|
||||
|
@ -169,6 +170,8 @@ data GameState = GameState
|
|||
-- ^ The away team's score
|
||||
, _overtimeFlag :: Maybe Bool
|
||||
-- ^ Indicates whether or not the game went into overtime
|
||||
, _dataVerified :: Bool
|
||||
-- ^ Set to 'True' when the user confirms the entered data
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | The program mode
|
||||
|
@ -438,6 +441,7 @@ newGameState = GameState
|
|||
, _homeScore = Nothing
|
||||
, _awayScore = Nothing
|
||||
, _overtimeFlag = Nothing
|
||||
, _dataVerified = False
|
||||
}
|
||||
|
||||
-- | Constructor for a 'Database'
|
||||
|
|
|
@ -0,0 +1,46 @@
|
|||
{-
|
||||
|
||||
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 HandlersSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Handlers
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Handlers"
|
||||
ynHandlerSpec
|
||||
|
||||
ynHandlerSpec :: Spec
|
||||
ynHandlerSpec = describe "ynHandler" $ mapM_
|
||||
(\(desc, event, expected) ->
|
||||
context desc $
|
||||
it ("should be " ++ show expected) $
|
||||
ynHandler event `shouldBe` expected)
|
||||
-- description, event, expected
|
||||
[ ( "Y pressed", C.EventCharacter 'Y', Just True )
|
||||
, ( "y pressed", C.EventCharacter 'y', Just True )
|
||||
, ( "N pressed", C.EventCharacter 'N', Just False )
|
||||
, ( "n pressed", C.EventCharacter 'n', Just False )
|
||||
, ( "x pressed", C.EventCharacter 'x', Nothing )
|
||||
, ( "other event", C.EventResized, Nothing )
|
||||
]
|
|
@ -0,0 +1,47 @@
|
|||
{-
|
||||
|
||||
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 ReportSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (?~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Report"
|
||||
gameDateSpec
|
||||
|
||||
gameDateSpec :: Spec
|
||||
gameDateSpec = describe "gameDate" $ do
|
||||
|
||||
context "valid gameDate" $
|
||||
it "should format the date" $ let
|
||||
gs = newGameState
|
||||
& gameYear ?~ 1980
|
||||
& gameMonth ?~ 6
|
||||
& gameDay ?~ 25
|
||||
in gameDate gs `shouldBe` "JUN 25 1980"
|
||||
|
||||
context "invalid date" $
|
||||
it "should return an empty string" $
|
||||
gameDate newGameState `shouldBe` ""
|
|
@ -23,6 +23,8 @@ import Test.Hspec (hspec)
|
|||
|
||||
import qualified ActionsSpec as Actions
|
||||
import qualified FormatSpec as Format
|
||||
import qualified HandlersSpec as Handlers
|
||||
import qualified ReportSpec as Report
|
||||
import qualified TypesSpec as Types
|
||||
|
||||
main :: IO ()
|
||||
|
@ -30,3 +32,5 @@ main = hspec $ do
|
|||
Types.spec
|
||||
Actions.spec
|
||||
Format.spec
|
||||
Handlers.spec
|
||||
Report.spec
|
||||
|
|
Loading…
Reference in New Issue
Block a user