fingerprint/mtlstats
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request 'switch from ncurses to brick' (#1) from brick into dev 

Reviewed-on: #1
This commit is contained in:
Jonathan Lamothe 2023-06-02 15:28:41 -04:00
parent f869209ec6 e0efe2657f
commit bdbf7daf4e
59 changed files with 555 additions and 636 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
.travis.yml
View File

@ -1,40 +0,0 @@
# This is the simple Travis configuration, which is intended for use
# on applications which do not require cross-platform and
# multiple-GHC-version support. For more information and other
# options, see:
#
# https://docs.haskellstack.org/en/stable/travis_ci/
#
# Copy these contents into the root directory of your Github project in a file
# named .travis.yml
# Choose a build environment
dist: xenial
# Do not choose a language; we provide our own build tools.
language: generic
# Caching so the next build will be fast too.
cache:
directories:
- $HOME/.stack
# Ensure necessary system libraries are present
addons:
apt:
packages:
- libgmp-dev
before_install:
# Download and unpack the stack executable
- mkdir -p ~/.local/bin
- export PATH=$HOME/.local/bin:$PATH
- travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
install:
# Build dependencies
- stack --no-terminal --install-ghc test --only-dependencies
script:
# Build the package, its tests, and its docs and run the tests
- stack --no-terminal test --haddock --no-haddock-deps

3
ChangeLog.md
View File

@ -1,5 +1,8 @@
# Changelog for mtlstats
## current
- updated code to use brick instead of ncurses
## 0.16.1
- Don't automatically start a new game on new season

10
Vagrantfile vendored
View File

@ -1,10 +0,0 @@
# -*- mode: ruby -*-
# vi: set ft=ruby :
Vagrant.configure("2") do |config|
config.vm.box = "ubuntu/xenial64"
config.vm.provision "shell", path: "vagrant/provision.sh"
config.vm.provider :virtualbox do |v|
v.customize ["modifyvm", :id, "--memory", 4096]
end
end

9
app/Main.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,10 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Main where
import Control.Monad.Trans.State (evalStateT)
import UI.NCurses (runCurses)
import Brick.Main (defaultMain)
import Control.Monad (void)
import Mtlstats
import Mtlstats.Types
main :: IO ()
main = runCurses $ initState >>= evalStateT mainLoop
main = void $ defaultMain app newProgState

26
package.yaml
View File

@ -1,10 +1,9 @@
name: mtlstats
version: 0.16.1
github: "mtlstats/mtlstats"
license: GPL-3
license: GPL-3.0-or-later
author: "Jonathan Lamothe"
maintainer: "jlamothe1980@gmail.com"
copyright: "Rhéal Lamothe"
copyright: "1984, 1985, 2019-2021, 2023 Rhéal Lamothe"
extra-source-files:
- README.md
@ -21,17 +20,20 @@ description: Please see the README on GitHub at <https://github.com/mtls
dependencies:
- base >= 4.7 && < 5
- aeson >= 1.4.4.0 && < 1.5
- aeson >= 2.0.3.0 && < 2.1
- bytestring >= 0.11.4.0 && < 0.12
- brick >= 1.4 && < 1.5
- containers >= 0.6.0.1 && < 0.7
- easy-file >= 0.2.2 && < 0.3
- extra >= 1.6.17 && < 1.7
- extra >= 1.7.13 && < 1.8
- microlens >= 0.4.12.0 && < 0.5
- microlens-mtl >= 0.2.0.3 && < 0.3
- microlens-th >= 0.4.2.3 && < 0.5
- ncurses >= 0.2.16 && < 0.3
- random >= 1.1 && < 1.2
- time >= 1.8.0.2 && < 1.9
- transformers >= 0.5.6.2 && < 0.6
- bytestring
- microlens
- mtl >= 2.2.2 && < 2.3
- random >= 1.2.1.1 && < 1.3
- text-zipper >= 0.12 && < 0.13
- time >= 1.11.1.1 && < 1.12
- vty >= 5.37 && < 5.38
ghc-options:
- -Wall
@ -61,5 +63,5 @@ tests:
- -with-rtsopts=-N
dependencies:
- mtlstats
- hspec >= 2.7.1 && < 2.8
- hspec >= 2.9.7 && < 2.10
- unordered-containers

65
src/Mtlstats.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -19,40 +19,45 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats (initState, mainLoop) where
module Mtlstats (app) where
import Control.Monad (void)
import Control.Monad.Extra (whenM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (get, gets)
import Data.Maybe (fromJust)
import qualified UI.NCurses as C
import Brick.AttrMap (AttrMap, forceAttrMap)
import Brick.Main (App (..), halt, showFirstCursor)
import Brick.Types (BrickEvent (VtyEvent), Widget)
import Brick.Util (on)
import Brick.Widgets.Core (fill)
import Control.Monad.State.Class (gets)
import Graphics.Vty.Attributes.Color (blue, white)
import Graphics.Vty.Input.Events
( Event (EvKey)
, Modifier (MCtrl)
, Key (KChar)
)
import Mtlstats.Control
import Mtlstats.Types
-- | Initializes the progran
initState :: C.Curses ProgState
initState = do
C.setEcho False
void $ C.setCursorMode C.CursorInvisible
return newProgState
-- | The main application
app :: App ProgState () ()
app = App
{ appDraw = draw
, appChooseCursor = showFirstCursor
, appHandleEvent = handler
, appStartEvent = return ()
, appAttrMap = const myAttrMap
}
-- | Main program loop
mainLoop :: Action ()
mainLoop = do
draw :: ProgState -> [Widget ()]
draw s =
[ drawController (dispatch s) s
, fill ' '
]
handler :: Handler ()
handler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt
handler e = do
c <- gets dispatch
get >>= lift . draw . drawController c
w <- lift C.defaultWindow
whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c)
mainLoop
handleController c e
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
myAttrMap :: AttrMap
myAttrMap = forceAttrMap (white `on` blue)

47
src/Mtlstats/Actions.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Mtlstats.Actions
( startNewSeason
@ -27,8 +27,6 @@ module Mtlstats.Actions
, clearRookies
, resetStandings
, startNewGame
, addChar
, removeChar
, createPlayer
, createGoalie
, edit
@ -41,18 +39,21 @@ module Mtlstats.Actions
, resetCreatePlayerState
, resetCreateGoalieState
, backHome
, scrollUp
, scrollDown
, clearEditor
, loadDatabase
, saveDatabase
) where
import Brick.Main (viewportScroll)
import Brick.Widgets.Edit (Editor, applyEdit)
import Control.Exception (IOException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify)
import Control.Monad.State.Class (modify)
import Data.Aeson (decodeFileStrict, encodeFile)
import Data.Maybe (fromMaybe)
import Data.Text.Zipper (gotoBOF, killToEOF)
import Lens.Micro ((^.), (&), (.~), (%~))
import Lens.Micro.Mtl ((.=), use)
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
@ -93,16 +94,6 @@ startNewGame
= (progMode .~ NewGame newGameState)
. (database . dbGames %~ succ)
-- | Adds a character to the input buffer
addChar :: Char -> ProgState -> ProgState
addChar c = inputBuffer %~ (++[c])
-- | Removes a character from the input buffer (if possible)
removeChar :: ProgState -> ProgState
removeChar = inputBuffer %~ \case
"" -> ""
str -> init str
-- | Starts player creation mode
createPlayer :: ProgState -> ProgState
createPlayer = let
@ -206,17 +197,13 @@ resetCreateGoalieState = progMode.createGoalieStateL
-- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState
backHome
= (progMode .~ MainMenu)
. (inputBuffer .~ "")
. (scrollOffset .~ 0)
= (progMode .~ MainMenu)
. (editorW %~ clearEditor)
. (scroller .~ viewportScroll ())
-- | Scrolls the display up
scrollUp :: ProgState -> ProgState
scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down
scrollDown :: ProgState -> ProgState
scrollDown = scrollOffset %~ succ
-- | Clears an editor
clearEditor :: Editor String () -> Editor String ()
clearEditor = applyEdit $ killToEOF . gotoBOF
-- | Loads the database
loadDatabase :: Action ()
@ -226,18 +213,18 @@ loadDatabase = do
(catch
(decodeFileStrict dbFile)
(\(_ :: IOException) -> return Nothing))
>>= mapM_ (modify . (database .~))
>>= mapM_ (database .=)
-- | Saves the database
saveDatabase :: Action ()
saveDatabase = do
db <- gets (^.database)
db <- use database
dbFile <- dbSetup
liftIO $ encodeFile dbFile db
dbSetup :: Action String
dbSetup = do
fn <- gets (^.dbName)
fn <- use dbName
liftIO $ do
dir <- getAppUserDataDirectory appName
createDirectoryIfMissing True dir

2
src/Mtlstats/Actions/EditStandings.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
src/Mtlstats/Actions/NewGame.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
src/Mtlstats/Actions/NewGame/GoalieInput.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
src/Mtlstats/Config.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
src/Mtlstats/Control.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

33
src/Mtlstats/Control/CreateGoalie.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,15 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.CreateGoalie (createGoalieC) where
import Control.Monad.Trans.State (gets, modify)
import Brick.Widgets.Core (str)
import Control.Monad.State.Class (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Lens.Micro.Mtl ((.=))
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
import Mtlstats.Util
-- | Handles goalie creation
createGoalieC :: CreateGoalieState -> Controller
@ -48,33 +50,28 @@ getGoalieNameC = promptController goalieNamePrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
{ drawController = const $
str "Is this goalie a rookie? (Y/N)"
, handleController = \e ->
modify $ case ynHandler e of
Just True -> progMode.createGoalieStateL
%~ (cgsRookieFlag ?~ True)
. (cgsActiveFlag ?~ True)
rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
return True
{ drawController = const $ str "Is this goalie active? (Y/N)"
, handleController = \e ->
progMode.createGoalieStateL.cgsActiveFlag .= ynHandler e
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
{ drawController = \s -> let
cgs = s^.progMode.createGoalieStateL
in linesToWidget
$ labelTable
[ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber )
, ( "Goalie name", cgs^.cgsName )
@ -84,7 +81,6 @@ confirmCreateGoalieC = Controller
++ [ ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cgs <- gets (^.progMode.createGoalieStateL)
let
@ -103,5 +99,4 @@ confirmCreateGoalieC = Controller
. (egsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

33
src/Mtlstats/Control/CreatePlayer.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,15 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.CreatePlayer (createPlayerC) where
import Control.Monad.Trans.State (gets, modify)
import Brick.Widgets.Core (str)
import Control.Monad.State.Class (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Lens.Micro.Mtl ((.=), use)
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
import Mtlstats.Util
-- | Handles player creation
createPlayerC :: CreatePlayerState -> Controller
@ -52,33 +54,26 @@ getPlayerPosC = promptController playerPosPrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this player a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
{ drawController = const $ str "Is this player a rookie? (Y/N)"
, handleController = \e ->
modify $ case ynHandler e of
Just True -> progMode.createPlayerStateL
%~ (cpsRookieFlag ?~ True)
. (cpsActiveFlag ?~ True)
rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is the player active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
return True
{ drawController = const $ str "Is the player active? (Y/N)"
, handleController = \e ->
progMode.createPlayerStateL.cpsActiveFlag .= ynHandler e
}
confirmCreatePlayerC :: Controller
confirmCreatePlayerC = Controller
{ drawController = \s -> do
let cps = s^.progMode.createPlayerStateL
C.drawString $ unlines
{ drawController = \s -> let cps = s^.progMode.createPlayerStateL
in linesToWidget
$ labelTable
[ ( "Player number", maybe "?" show $ cps^.cpsNumber )
, ( "Player name", cps^.cpsName )
@ -89,9 +84,8 @@ confirmCreatePlayerC = Controller
++ [ ""
, "Create player: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cps <- gets (^.progMode.createPlayerStateL)
cps <- use $ progMode.createPlayerStateL
let
success = cps^.cpsSuccessCallback
failure = cps^.cpsFailureCallback
@ -108,5 +102,4 @@ confirmCreatePlayerC = Controller
. (epsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

63
src/Mtlstats/Control/EditGoalie.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -23,10 +23,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.EditGoalie (editGoalieC) where
import Control.Monad.Trans.State (gets, modify)
import Brick.Types (Widget)
import Brick.Widgets.Core (str, vBox)
import Control.Monad.State.Class (modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (.~), (%~))
import UI.NCurses as C
import Lens.Micro ((^.))
import Lens.Micro.Mtl ((.=), (%=), use)
import Mtlstats.Actions
import Mtlstats.Handlers
@ -90,33 +92,19 @@ lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
deleteC :: Action () -> Controller
deleteC _ = Controller
{ drawController = \s -> do
C.drawString $ let
hdr = fromMaybe [] $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
modify edit
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
Nothing -> return ()
return True
{ drawController = \s -> let
hdr = fromMaybe "" $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
in str $ hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
, handleController = \e -> case ynHandler e of
Just True -> do
use (progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
(\gid -> database.dbGoalies %= dropNth gid)
modify edit
Just False -> progMode.editGoalieStateL.egsMode .= EGMenu
Nothing -> return ()
}
ytdGamesC :: Bool -> Action () -> Controller
@ -173,8 +161,11 @@ ltLossesC = curry $ promptController .
ltTiesC :: Action () -> Controller
ltTiesC = promptController . editGoalieLtTiesPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
g <- nth gid $ s^.database.dbGoalies
Just $ goalieDetails g ++ "\n"
header :: ProgState -> Widget () -> Widget ()
header s w = vBox
[ str $ fromMaybe "" $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
g <- nth gid $ s^.database.dbGoalies
Just $ goalieDetails g
, w
]

63
src/Mtlstats/Control/EditPlayer.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,10 +21,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.EditPlayer (editPlayerC) where
import Control.Monad.Trans.State (gets, modify)
import Brick.Types (Widget)
import Brick.Widgets.Core (emptyWidget, str, vBox)
import Control.Monad.State.Class (modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (.~), (%~))
import qualified UI.NCurses as C
import Lens.Micro ((^.))
import Lens.Micro.Mtl ((.=), (%=), use)
import Mtlstats.Actions
import Mtlstats.Handlers
@ -81,33 +83,19 @@ lifetimeC _ = menuControllerWith header editPlayerLtMenu
deleteC :: Action () -> Controller
deleteC _ = Controller
{ drawController = \s -> do
C.drawString $ let
hdr = fromMaybe [] $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ "Player: " ++ playerDetails player ++ "\n\n"
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
modify edit
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
Nothing -> return ()
return True
{ drawController = \s -> let
hdr = fromMaybe [] $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ "Player: " ++ playerDetails player ++ "\n"
in str $ hdr ++ "Are you sure you want to delete this player? (Y/N)"
, handleController = \e -> case ynHandler e of
Just True -> do
use (progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
(\pid -> database.dbPlayers %= dropNth pid)
modify edit
Just False -> progMode.editPlayerStateL.epsMode .= EPMenu
Nothing -> return ()
}
ytdGoalsC :: Bool -> Action () -> Controller
@ -132,8 +120,11 @@ ltAssistsC batchMode callback = promptController $
ltPMinC :: Action () -> Controller
ltPMinC = promptController . editPlayerLtPMinPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerDetails player ++ "\n"
header :: ProgState -> Widget () -> Widget ()
header s w = vBox
[ fromMaybe emptyWidget $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ str $ playerDetails player
, w
]

24
src/Mtlstats/Control/EditStandings.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -23,8 +23,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.EditStandings (editStandingsC) where
import Brick.Types (Widget)
import Brick.Widgets.Core (vBox)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
@ -33,6 +34,7 @@ import Mtlstats.Prompt
import Mtlstats.Prompt.EditStandings
import Mtlstats.Types
import Mtlstats.Types.Menu
import Mtlstats.Util
-- | Controller for the edit standings menu
editStandingsC :: EditStandingsMode -> Controller
@ -65,17 +67,19 @@ menuC = menuControllerWith header
promptC :: Prompt -> Controller
promptC = promptControllerWith header
header :: ProgState -> C.Update ()
header = do
db <- (^.database)
let
home = db^.dbHomeGameStats
away = db^.dbAwayGameStats
table = numTable [" W", " L", " OT", " GF", " GA"]
header :: ProgState -> Widget () -> Widget ()
header s w = let
db = s^.database
home = db^.dbHomeGameStats
away = db^.dbAwayGameStats
table = numTable [" W", " L", " OT", " GF", " GA"]
[ ( "HOME", valsFor home )
, ( "ROAD", valsFor away )
]
return $ C.drawString $ unlines $ table ++ [""]
in vBox
[ linesToWidget $ table ++ [""]
, w
]
valsFor :: GameStats -> [Int]
valsFor gs =

190
src/Mtlstats/Control/NewGame.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,11 +21,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.NewGame (newGameC) where
import Brick.Main (vScrollBy, vScrollToBeginning)
import Brick.Types
( BrickEvent (VtyEvent)
, ViewportType (Vertical)
, Widget
)
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.Core (str, vBox, viewport)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (get, gets, modify)
import Control.Monad.State.Class (get, gets, modify)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Graphics.Vty.Input.Events
( Event (EvKey)
, Key (KDown, KHome, KEnter, KUp)
)
import Lens.Micro ((^.), (.~))
import qualified UI.NCurses as C
import Lens.Micro.Mtl ((.=), use)
import Mtlstats.Actions
import Mtlstats.Actions.NewGame
@ -81,32 +93,30 @@ awayScoreC = promptControllerWith header awayScorePrompt
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
{ drawController = \s -> header s $
str "Did the game go into overtime? (Y/N)"
, handleController = \e ->
progMode.gameStateL.overtimeFlag .= ynHandler e
}
verifyDataC :: Controller
verifyDataC = Controller
{ drawController = \s -> do
let gs = s^.progMode.gameStateL
header s
C.drawString "\n"
C.drawString $ unlines $ labelTable
{ drawController = \s -> let
gs = s^.progMode.gameStateL
in header s $ linesToWidget $
[""] ++
labelTable
[ ( "Date", gameDate gs )
, ( "Game type", show $ fromJust $ gs^.gameType )
, ( "Other team", gs^.otherTeam )
, ( "Home score", show $ fromJust $ gs^.homeScore )
, ( "Away score", show $ fromJust $ gs^.awayScore )
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
]
C.drawString "\nIs the above information correct? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
] ++
[ ""
, "Is the above information correct? (Y/N)"
]
, handleController = \e ->
case ynHandler e of
Just True -> modify
$ (progMode.gameStateL.dataVerified .~ True)
@ -114,7 +124,6 @@ verifyDataC = Controller
. awardShutouts
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
goalInput :: GameState -> Controller
@ -131,7 +140,6 @@ recordGoalC = Controller
, handleController = \e -> do
(game, goal) <- gets gameGoal
promptHandler (recordGoalPrompt game goal) e
return True
}
recordAssistC :: Controller
@ -142,114 +150,100 @@ recordAssistC = Controller
, handleController = \e -> do
(game, goal, assist) <- gets gameGoalAssist
promptHandler (recordAssistPrompt game goal assist) e
return True
}
confirmGoalDataC :: Controller
confirmGoalDataC = Controller
{ drawController = \s -> do
let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg = unlines $
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
(\pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players))
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
C.drawString msg
return C.CursorInvisible
{ drawController = \s -> let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg =
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
( \pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players)
)
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
in linesToWidget msg
, handleController = \e -> do
case ynHandler e of
Just True -> modify recordGoalAssists
Just False -> modify resetGoalData
Nothing -> return ()
return True
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
{ drawController = \s -> header s $
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
, handleController = promptHandler pMinPlayerPrompt
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
{ drawController = \s -> header s $ vBox
[ str $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
Just $ playerSummary player
, drawPrompt assignPMinsPrompt s
]
, handleController = promptHandler assignPMinsPrompt
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(displayReport (fromInteger $ pred cols) s)
return C.CursorInvisible
{ drawController = viewport () Vertical . hCenter . linesToWidget .
displayReport reportCols
, handleController = \e -> do
scr <- use scroller
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventCharacter '\n' -> do
get >>= liftIO . writeFile reportFilename . exportReport reportCols
modify backHome
VtyEvent (EvKey k []) -> case k of
KUp -> vScrollBy scr (-1)
KDown -> vScrollBy scr 1
KHome -> vScrollToBeginning scr
KEnter -> do
get >>= liftIO . writeFile reportFilename . exportReport reportCols
modify backHome
_ -> return ()
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
header :: ProgState -> Widget () -> Widget ()
header s w = vBox
[ str $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
, w
]
monthHeader :: ProgState -> C.Update ()
monthHeader s = do
(_, cols) <- C.windowSize
header s
let
table = labelTable $ zip (map show ([1..] :: [Int]))
[ "JANUARY"
, "FEBRUARY"
, "MARCH"
, "APRIL"
, "MAY"
, "JUNE"
, "JULY"
, "AUGUST"
, "SEPTEMBER"
, "OCTOBER"
, "NOVEMBER"
, "DECEMBER"
]
C.drawString $ unlines $
map (centre $ fromIntegral $ pred cols) $
monthHeader :: ProgState -> Widget () -> Widget ()
monthHeader s w = let
table = labelTable $ zip (map show ([1..] :: [Int]))
[ "JANUARY"
, "FEBRUARY"
, "MARCH"
, "APRIL"
, "MAY"
, "JUNE"
, "JULY"
, "AUGUST"
, "SEPTEMBER"
, "OCTOBER"
, "NOVEMBER"
, "DECEMBER"
]
in header s $ vBox
[ linesToWidgetC $
["MONTH:", ""] ++ table ++ [""]
, w
]
gameGoal :: ProgState -> (Int, Int)
gameGoal s =

11
src/Mtlstats/Control/NewGame/GoalieInput.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,9 +21,10 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
import Brick.Types (Widget)
import Brick.Widgets.Core (str, vBox)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
@ -52,11 +53,11 @@ goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: Controller
selectGameGoalieC = menuStateController gameGoalieMenu
header :: ProgState -> C.Update ()
header s = C.drawString $ unlines
header :: ProgState -> Widget () -> Widget ()
header s w = vBox $ map str
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
, fromMaybe "" $ do
n <- s^.progMode.gameStateL.gameSelectedGoalie
g <- nth n $ s^.database.dbGoalies
Just $ goalieSummary g
]
] ++ [w]

41
src/Mtlstats/Control/TitleScreen.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -23,34 +23,31 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.TitleScreen (titleScreenC) where
import Control.Monad.Trans.State (modify)
import Brick.Types (BrickEvent (VtyEvent))
import Control.Monad.State.Class (modify)
import Data.Char (chr)
import qualified UI.NCurses as C
import Graphics.Vty.Input.Events (Event (EvKey))
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Types
import Mtlstats.Util
titleScreenC :: Controller
titleScreenC = Controller
{ drawController = const $ do
(_, cols) <- C.windowSize
C.drawString $ unlines $ map (centre $ fromIntegral $ pred cols)
$ [ ""
, "MONTREAL CANADIENS STATISTICS"
]
++ titleText
++ [ ""
, "Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe"
, "<rheal.lamothe@gmail.com>"
, ""
, "Press any key to continue..."
]
return C.CursorInvisible
{ drawController = const $ linesToWidgetC
$ [ ""
, "MONTREAL CANADIENS STATISTICS"
]
++ titleText
++ [ ""
, "Copyright (C) 1984, 1985, 2019-2021, 2023 Rhéal Lamothe"
, "<rheal.lamothe@gmail.com>"
, ""
, "Press any key to continue..."
]
, handleController = \case
C.EventCharacter _ -> modify backHome >> return True
C.EventSpecialKey _ -> modify backHome >> return True
_ -> return True
VtyEvent (EvKey _ _) -> modify backHome
_ -> return ()
}
titleText :: [String]
@ -60,7 +57,7 @@ titleText = box $ map (map blockify) $ foldl joinBlocks (repeat "")
box :: [String] -> [String]
box strs
= [[tl] ++ replicate width horiz ++ [tr]]
++ map (\str -> [vert] ++ str ++ [vert]) strs
++ map (\s -> [vert] ++ s ++ [vert]) strs
++ [[bl] ++ replicate width horiz ++ [br]]
where
width = length $ head strs

2
src/Mtlstats/Format.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

9
src/Mtlstats/Handlers.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -21,12 +21,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Handlers (ynHandler) where
import Brick.Types (BrickEvent (VtyEvent))
import Data.Char (toUpper)
import qualified UI.NCurses as C
import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar))
-- | Handler for a yes/no prompt
ynHandler :: C.Event -> Maybe Bool
ynHandler (C.EventCharacter c) = case toUpper c of
ynHandler :: BrickEvent () () -> Maybe Bool
ynHandler (VtyEvent (EvKey (KChar c) [])) = case toUpper c of
'Y' -> Just True
'N' -> Just False
_ -> Nothing

2
src/Mtlstats/Helpers/Goalie.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
src/Mtlstats/Helpers/Player.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

6
src/Mtlstats/Helpers/Position.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -28,12 +28,12 @@ module Mtlstats.Helpers.Position
, getPositions
) where
import Control.Monad.Trans.State (gets)
import Data.Char (toUpper)
import Data.List (isInfixOf)
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import Lens.Micro ((^.), to)
import Lens.Micro.Mtl (use)
import Mtlstats.Types
import Mtlstats.Util
@ -78,7 +78,7 @@ posCallback
posCallback callback = \case
Nothing -> callback ""
Just n -> do
ps <- gets (^.database.to getPositions)
ps <- use (database.to getPositions)
let pos = fromMaybe "" $ nth n ps
callback pos

52
src/Mtlstats/Menu.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -34,40 +34,37 @@ module Mtlstats.Menu (
editMenu
) where
import Control.Monad.Trans.State (gets, modify)
import Brick.Main (halt)
import Brick.Types (BrickEvent (VtyEvent), Widget)
import Control.Monad.State.Class (gets, modify)
import Data.Char (toUpper)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar))
import Lens.Micro ((^.), (?~))
import qualified UI.NCurses as C
import Mtlstats.Actions
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Actions.EditStandings
import Mtlstats.Format
import Mtlstats.Types
import Mtlstats.Types.Menu
import Mtlstats.Util
-- | Generates a simple 'Controller' for a Menu
menuController :: Menu () -> Controller
menuController = menuControllerWith $ const $ return ()
menuController = menuControllerWith $ const id
-- | Generate a simple 'Controller' for a 'Menu' with a header
menuControllerWith
:: (ProgState -> C.Update ())
-- ^ Generates the header
:: (ProgState -> Widget () -> Widget())
-- ^ Function to attach the header
-> Menu ()
-- ^ The menu
-> Controller
-- ^ The resulting controller
menuControllerWith header menu = Controller
{ drawController = \s -> do
header s
drawMenu menu
, handleController = \e -> do
menuHandler menu e
return True
{ drawController = \s -> header s $ drawMenu menu
, handleController = menuHandler menu
}
-- | Generate and create a controller for a menu based on the current
@ -82,38 +79,33 @@ menuStateController menuFunc = Controller
, handleController = \e -> do
menu <- gets menuFunc
menuHandler menu e
return True
}
-- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode
drawMenu m = do
(_, cols) <- C.windowSize
let
width = fromIntegral $ pred cols
menuText = map (centre width) $ lines $ show m
C.drawString $ unlines menuText
return C.CursorInvisible
drawMenu :: Menu a -> Widget ()
drawMenu m = let
menuLines = lines $ show m
in linesToWidgetC menuLines
-- | The event handler for a 'Menu'
menuHandler :: Menu a -> C.Event -> Action a
menuHandler m (C.EventCharacter c) =
menuHandler :: Menu a -> Handler a
menuHandler m (VtyEvent (EvKey (KChar c) [])) =
case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
i:_ -> i^.miAction
[] -> return $ m^.menuDefault
menuHandler m _ = return $ m^.menuDefault
-- | The main menu
mainMenu :: Menu Bool
mainMenu = Menu "MASTER MENU" True
mainMenu :: Menu ()
mainMenu = Menu "MASTER MENU" ()
[ MenuItem 'A' "NEW SEASON" $
modify startNewSeason >> return True
modify startNewSeason
, MenuItem 'B' "NEW GAME" $
modify startNewGame >> return True
modify startNewGame
, MenuItem 'C' "EDIT MENU" $
modify edit >> return True
modify edit
, MenuItem 'E' "EXIT" $
saveDatabase >> return False
saveDatabase >> halt
]
-- | The new season menu

4
src/Mtlstats/Menu/EditGoalie.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -25,7 +25,7 @@ module Mtlstats.Menu.EditGoalie
, editGoalieLtMenu
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((.~), (%~))
import Mtlstats.Actions

4
src/Mtlstats/Menu/EditPlayer.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -25,7 +25,7 @@ module Mtlstats.Menu.EditPlayer
, editPlayerLtMenu
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((.~), (%~))
import Mtlstats.Actions

4
src/Mtlstats/Menu/EditStandings.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -25,7 +25,7 @@ module Mtlstats.Menu.EditStandings
, editAwayStandingsMenu
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Mtlstats.Actions
import Mtlstats.Actions.EditStandings

122
src/Mtlstats/Prompt.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -19,11 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt (
-- * Prompt Functions
drawPrompt,
promptHandler,
promptControllerWith,
promptController,
@ -51,14 +48,21 @@ module Mtlstats.Prompt (
playerToEditPrompt
) where
import Brick.Types (BrickEvent (VtyEvent), Widget)
import Brick.Widgets.Core (hBox, str, vBox)
import Brick.Widgets.Edit (editContentsL, renderEditor)
import Control.Monad (when)
import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify)
import Control.Monad.State.Class (gets, modify)
import Data.Char (isAlphaNum, isDigit, toUpper)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Extras (view)
import Data.Text.Zipper (deletePrevChar, insertChar)
import Graphics.Vty.Input.Events
( Event (EvKey)
, Key (KBS, KChar, KEnter, KFun)
)
import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
import Lens.Micro.Mtl ((%=), use)
import Text.Read (readMaybe)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
@ -66,41 +70,31 @@ import Mtlstats.Helpers.Position
import Mtlstats.Types
import Mtlstats.Util
-- | Draws the prompt to the screen
drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
drawPrompt p s = do
promptDrawer p s
return C.CursorVisible
-- | Event handler for a prompt
promptHandler :: Prompt -> C.Event -> Action ()
promptHandler p (C.EventCharacter '\n') = do
val <- gets $ view inputBuffer
modify $ inputBuffer .~ ""
promptHandler :: Prompt -> Handler ()
promptHandler p (VtyEvent (EvKey KEnter [])) = do
val <- use $ editorW.to userText
editorW %= clearEditor
promptAction p val
promptHandler p (C.EventCharacter c) =
modify $ inputBuffer %~ promptProcessChar p c
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
modify removeChar
promptHandler p (C.EventSpecialKey k) =
promptSpecialKey p k
promptHandler p (VtyEvent (EvKey (KChar c) [])) =
editorW %= promptProcessChar p c
promptHandler _ (VtyEvent (EvKey KBS [])) =
editorW.editContentsL %= deletePrevChar
promptHandler p (VtyEvent (EvKey k m)) =
promptSpecialKey p k m
promptHandler _ _ = return ()
-- | Builds a controller out of a prompt with a header
promptControllerWith
:: (ProgState -> C.Update ())
:: (ProgState -> Widget () -> Widget ())
-- ^ The header
-> Prompt
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptControllerWith header prompt = Controller
{ drawController = \s -> do
header s
drawPrompt prompt s
, handleController = \e -> do
promptHandler prompt e
return True
{ drawController = \s -> header s $ drawPrompt prompt s
, handleController = promptHandler prompt
}
-- | Builds a controller out of a prompt
@ -109,7 +103,7 @@ promptController
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptController = promptControllerWith (const $ return ())
promptController = promptControllerWith $ const id
-- | Builds a string prompt
strPrompt
@ -119,10 +113,10 @@ strPrompt
-- ^ The callback function for the result
-> Prompt
strPrompt pStr act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptProcessChar = \ch -> (++ [ch])
{ drawPrompt = drawSimplePrompt pStr
, promptProcessChar = \ch -> editContentsL %~ insertChar ch
, promptAction = act
, promptSpecialKey = const $ return ()
, promptSpecialKey = \_ _ -> return ()
}
-- | Creates an upper case string prompt
@ -133,7 +127,7 @@ ucStrPrompt
-- ^ The callback function for the result
-> Prompt
ucStrPrompt pStr act = (strPrompt pStr act)
{ promptProcessChar = \ch -> (++ [toUpper ch]) }
{ promptProcessChar = \ch -> editContentsL %~ insertChar ch }
-- | Creates a prompt which forces capitalization of input to
-- accomodate a player or goalie name
@ -179,12 +173,12 @@ numPromptWithFallback
-- ^ The callback function for the result
-> Prompt
numPromptWithFallback pStr fallback act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptProcessChar = \ch str -> if isDigit ch
then str ++ [ch]
else str
{ drawPrompt = drawSimplePrompt pStr
, promptProcessChar = \ch existing -> if isDigit ch
then existing & editContentsL %~ insertChar ch
else existing
, promptAction = maybe fallback act . readMaybe
, promptSpecialKey = const $ return ()
, promptSpecialKey = \_ _ -> return ()
}
-- | Prompts for a database name
@ -196,7 +190,7 @@ dbNamePrompt
-> Prompt
dbNamePrompt pStr act = (strPrompt pStr act)
{ promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
then (++[toUpper ch])
then editContentsL %~ insertChar (toUpper ch)
else id
}
@ -215,18 +209,23 @@ newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
-- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
{ promptDrawer = \s -> do
let sStr = s^.inputBuffer
C.drawString $ spPrompt params ++ sStr
(row, col) <- C.cursorPosition
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
C.drawString $ unlines $ map
{ drawPrompt = \s -> let
sStr = s^.editorW.to userText
pStr = spPrompt params
results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
fmtRes = map
(\(n, (_, x)) -> let
desc = spElemDesc params x
in "F" ++ show n ++ ") " ++ desc)
in str $ "F" ++ show n ++ ") " ++ desc)
results
C.moveCursor row col
in vBox $
[ hBox
[ str pStr
, renderEditor linesToWidget True (s^.editorW)
]
, str " "
, str $ spSearchHeader params
] ++ fmtRes
, promptProcessChar = spProcessChar params
, promptAction = \sStr -> if null sStr
then spCallback params Nothing
@ -235,16 +234,16 @@ selectPrompt params = Prompt
case spSearchExact params sStr db of
Nothing -> spNotFound params sStr
Just n -> spCallback params $ Just n
, promptSpecialKey = \case
C.KeyFunction rawK -> do
sStr <- gets (^.inputBuffer)
db <- gets (^.database)
, promptSpecialKey = \key _ -> case key of
KFun rawK -> do
sStr <- use $ editorW . to userText
db <- use database
let
n = pred $ fromInteger rawK
n = pred rawK
results = spSearch params sStr db
when (n < maxFunKeys) $
whenJust (nth n results) $ \(sel, _) -> do
modify $ inputBuffer .~ ""
editorW %= clearEditor
spCallback params $ Just sel
_ -> return ()
}
@ -397,7 +396,7 @@ selectPositionPrompt pStr callback = selectPrompt SelectParams
, spSearch = posSearch
, spSearchExact = posSearchExact
, spElemDesc = id
, spProcessChar = \ch -> (++ [toUpper ch])
, spProcessChar = \c -> editContentsL %~ insertChar (toUpper c)
, spCallback = posCallback callback
, spNotFound = callback
}
@ -406,5 +405,8 @@ playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
drawSimplePrompt :: String -> ProgState -> C.Update ()
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
drawSimplePrompt :: String -> Renderer
drawSimplePrompt pStr s = hBox
[ str pStr
, renderEditor linesToWidget True (s^.editorW)
]

4
src/Mtlstats/Prompt/EditGoalie.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -39,7 +39,7 @@ module Mtlstats.Prompt.EditGoalie
, editGoalieLtTiesPrompt
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions

4
src/Mtlstats/Prompt/EditPlayer.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -31,7 +31,7 @@ module Mtlstats.Prompt.EditPlayer
, editPlayerLtPMinPrompt
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions

4
src/Mtlstats/Prompt/EditStandings.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -32,7 +32,7 @@ module Mtlstats.Prompt.EditStandings
, editAwayGoalsAgainstPrompt
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((.~), (%~))
import Mtlstats.Prompt

4
src/Mtlstats/Prompt/NewGame.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -35,7 +35,7 @@ module Mtlstats.Prompt.NewGame
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Control.Monad.State.Class (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~))
import Mtlstats.Actions.NewGame

4
src/Mtlstats/Prompt/NewGame/GoalieInput.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -27,7 +27,7 @@ module Mtlstats.Prompt.NewGame.GoalieInput
, goalsAllowedPrompt
) where
import Control.Monad.Trans.State (modify)
import Control.Monad.State.Class (modify)
import Lens.Micro ((?~))
import Mtlstats.Actions.NewGame.GoalieInput

2
src/Mtlstats/Report.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

62
src/Mtlstats/Types.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -24,7 +24,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Types (
-- * Types
Controller (..),
Renderer,
Action,
Handler,
ProgState (..),
ProgMode (..),
GameState (..),
@ -51,8 +53,8 @@ module Mtlstats.Types (
database,
progMode,
dbName,
inputBuffer,
scrollOffset,
editorW,
scroller,
-- ** ProgMode Lenses
gameStateL,
createPlayerStateL,
@ -195,7 +197,9 @@ module Mtlstats.Types (
gsAverage
) where
import Control.Monad.Trans.State (StateT)
import Brick.Main (ViewportScroll, viewportScroll)
import Brick.Types (BrickEvent, EventM, Widget)
import Brick.Widgets.Edit (Editor, editor)
import Data.Aeson
( FromJSON
, ToJSON
@ -213,35 +217,41 @@ import Data.Aeson
import Data.Char (toUpper)
import Data.List (find, isInfixOf)
import qualified Data.Map as M
import Graphics.Vty.Input.Events (Key, Modifier)
import Lens.Micro (Lens', lens, (&), (^.), (.~))
import Lens.Micro.TH (makeLenses)
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
{ drawController :: Renderer
-- ^ The drawing routine
, handleController :: Handler ()
-- ^ The event handler
}
-- | Renders a view based on a "ProgState"
type Renderer = ProgState -> Widget ()
-- | Action which maintains program state
type Action a = StateT ProgState C.Curses a
type Action a = EventM () ProgState a
-- | Handles an event
type Handler a = BrickEvent () () -> Action a
-- | Represents the program state
data ProgState = ProgState
{ _database :: Database
{ _database :: Database
-- ^ The data to be saved
, _progMode :: ProgMode
, _progMode :: ProgMode
-- ^ The program's mode
, _dbName :: String
, _dbName :: String
-- ^ The name of the database file
, _inputBuffer :: String
-- ^ Buffer for user input
, _scrollOffset :: Int
-- ^ The scrolling offset for the display
, _editorW :: Editor String ()
-- ^ Editor widget
, _scroller :: ViewportScroll ()
-- ^ Scroller for the reports
}
-- | The program mode
@ -532,13 +542,13 @@ data GameStats = GameStats
-- | Defines a user prompt
data Prompt = Prompt
{ promptDrawer :: ProgState -> C.Update ()
{ drawPrompt :: ProgState -> Widget ()
-- ^ Draws the prompt to the screen
, promptProcessChar :: Char -> String -> String
-- ^ Modifies the string based on the character entered
, promptProcessChar :: Char -> Editor String () -> Editor String ()
-- ^ Modifies an editor based on the character entered
, promptAction :: String -> Action ()
-- ^ Action to perform when the value is entered
, promptSpecialKey :: C.Key -> Action ()
, promptSpecialKey :: Key -> [Modifier] -> Action ()
-- ^ Action to perform when a special key is pressed
}
@ -554,7 +564,7 @@ data SelectParams a = SelectParams
-- ^ Search function looking for an exact match
, spElemDesc :: a -> String
-- ^ Provides a string description of an element
, spProcessChar :: Char -> String -> String
, spProcessChar :: Char -> Editor String () -> Editor String ()
-- ^ Processes a character entered by the user
, spCallback :: Maybe Int -> Action ()
-- ^ The function when the selection is made
@ -786,11 +796,11 @@ esmSubModeL = lens
-- | Constructor for a 'ProgState'
newProgState :: ProgState
newProgState = ProgState
{ _database = newDatabase
, _progMode = TitleScreen
, _dbName = ""
, _inputBuffer = ""
, _scrollOffset = 0
{ _database = newDatabase
, _progMode = TitleScreen
, _dbName = ""
, _editorW = editor () (Just 1) ""
, _scroller = viewportScroll ()
}
-- | Constructor for a 'GameState'

2
src/Mtlstats/Types/Menu.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

39
src/Mtlstats/Util.hs
View File

@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -26,10 +26,19 @@ module Mtlstats.Util
, updateMap
, slice
, capitalizeName
, linesToWidget
, linesToWidgetC
, userText
) where
import Brick.Types (Widget)
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.Core (str, vBox)
import Brick.Widgets.Edit (Editor, editContentsL, getEditContents)
import Data.Char (isSpace, toUpper)
import qualified Data.Map as M
import Data.Text.Zipper (insertChar)
import Lens.Micro ((^.), (&), (%~), to)
-- | Attempt to select the element from a list at a given index
nth
@ -101,13 +110,14 @@ slice offset len = take len . drop offset
capitalizeName
:: Char
-- ^ The character being input
-> String
-> Editor String ()
-- ^ The current string
-> String
-> Editor String ()
-- ^ The resulting string
capitalizeName ch str = str ++ [ch']
capitalizeName ch e = e & editContentsL %~ insertChar ch'
where
ch' = if lockFlag str
s = e^.to userText
ch' = if lockFlag s
then toUpper ch
else ch
lockFlag "" = True
@ -118,3 +128,22 @@ capitalizeName ch str = str ++ [ch']
lockFlag' (c:cs)
| isSpace c = lockFlag' cs
| otherwise = False
-- | Converts a list of lines to a widget
linesToWidget :: [String] -> Widget ()
linesToWidget = vBox . map (str . keepBlank)
-- | Converts a list of lines to a widget with each line horizontally
-- centered
linesToWidgetC :: [String] -> Widget ()
linesToWidgetC = vBox . map (hCenter . str . keepBlank)
-- | Fetches the text from an editor widget
userText :: Editor String () -> String
userText w = case getEditContents w of
(x:_) -> x
[] -> ""
keepBlank :: String -> String
keepBlank "" = " "
keepBlank s = s

2
stack.yaml
View File

@ -17,7 +17,7 @@
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-14.0
resolver: lts-20.22
# User packages to be built.
# Various formats can be used as shown in the example below.

10
stack.yaml.lock
View File

@ -7,13 +7,13 @@ packages:
- completed:
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
pantry-tree:
size: 674
sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7
size: 674
original:
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
snapshots:
- completed:
size: 523443
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/0.yaml
sha256: 283773e7120f5446d961eab35ea95c9af9c24187cc178537bd29273200a05171
original: lts-14.0
sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725
size: 650255
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml
original: lts-20.22

2
test/Actions/EditStandingsSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

8
test/Actions/NewGame/GoalieInputSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -215,7 +215,7 @@ setGameGoalieSpec = describe "setGameGoalie" $ mapM_
let
ps' = setGameGoalie goalieId ps
[joe', bob'] = ps'^.database.dbGoalies
(joe', bob') = getFirstTwo $ ps'^.database.dbGoalies
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
context "Joe" $ joe' `TS.compareTest` expectedJoe
@ -380,3 +380,7 @@ setGameGoalieSpec = describe "setGameGoalie" $ mapM_
incSO = gsShutouts %~ succ
incLoss = gsLosses %~ succ
incOT = gsTies %~ succ
getFirstTwo :: [a] -> (a, a)
getFirstTwo (x:y:_) = (x, y)
getFirstTwo _ = error "insufficient members of list"

2
test/Actions/NewGameSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

68
test/ActionsSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -24,7 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where
import Control.Monad (replicateM)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
import Test.Hspec
( Spec
, context
@ -37,9 +37,11 @@ import Test.Hspec
import Mtlstats.Actions
import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.NewGameSpec as NewGame
import qualified Actions.EditStandingsSpec as EditStandings
import SpecHelpers
import qualified TypesSpec as TS
spec :: Spec
@ -49,8 +51,6 @@ spec = describe "Mtlstats.Actions" $ do
resetYtdSpec
clearRookiesSpec
resetStandingsSpec
addCharSpec
removeCharSpec
createPlayerSpec
createGoalieSpec
editSpec
@ -63,8 +63,6 @@ spec = describe "Mtlstats.Actions" $ do
resetCreatePlayerStateSpec
resetCreateGoalieStateSpec
backHomeSpec
scrollUpSpec
scrollDownSpec
NewGame.spec
EditStandings.spec
@ -206,29 +204,6 @@ resetStandingsSpec = describe "resetStandings" $ do
it "should be reset" $
ps^.database.dbAwayGameStats `shouldBe` newGameStats
addCharSpec :: Spec
addCharSpec = describe "addChar" $
it "should add the character to the input buffer" $ let
s = newProgState
& inputBuffer .~ "foo"
& addChar 'd'
in s ^. inputBuffer `shouldBe` "food"
removeCharSpec :: Spec
removeCharSpec = describe "removeChar" $ do
context "empty" $
it "should remove the character from the input buffer" $ let
s = removeChar newProgState
in s ^. inputBuffer `shouldBe` ""
context "not empty" $
it "should remove the character from the input buffer" $ let
s = newProgState
& inputBuffer .~ "foo"
& removeChar
in s ^. inputBuffer `shouldBe` "fo"
createPlayerSpec :: Spec
createPlayerSpec = describe "createPlayer" $
it "should change the mode appropriately" $ let
@ -424,8 +399,7 @@ backHomeSpec = describe "backHome" $ do
let
input = newProgState
& progMode.gameStateL .~ newGameState
& inputBuffer .~ "foo"
& scrollOffset .~ 123
& editorW .~ mkEditor "foo"
result = backHome input
it "should set the program mode back to MainMenu" $
@ -434,34 +408,4 @@ backHomeSpec = describe "backHome" $ do
_ -> False
it "should clear the input buffer" $
result^.inputBuffer `shouldBe` ""
it "should reset the scroll offset" $
result^.scrollOffset `shouldBe` 0
scrollUpSpec :: Spec
scrollUpSpec = describe "scrollUp" $ do
context "scrolled down" $
it "should decrease the scroll offset by one" $ let
ps = newProgState & scrollOffset .~ 10
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 9
context "at top" $
it "should keep the scroll offset at zero" $ let
ps = scrollUp newProgState
in ps^.scrollOffset `shouldBe` 0
context "above top" $
it "should return the scroll offset to zero" $ let
ps = newProgState & scrollOffset .~ (-10)
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 0
scrollDownSpec :: Spec
scrollDownSpec = describe "scrollDown" $
it "should increase the scroll offset" $ let
ps = newProgState & scrollOffset .~ 10
ps' = scrollDown ps
in ps'^.scrollOffset `shouldBe` 11
result^.editorW.to userText `shouldBe` ""

2
test/FormatSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

26
test/HandlersSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -22,7 +22,9 @@ 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 Brick.Types (BrickEvent (VtyEvent))
import Graphics.Vty.Input.Events (Event (EvKey, EvResize), Key (KChar))
import Mtlstats.Handlers
@ -37,10 +39,18 @@ ynHandlerSpec = describe "ynHandler" $ mapM_
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 )
[ ( "Y pressed", capitalY, Just True )
, ( "y pressed", lowerY, Just True )
, ( "N pressed", capitalN, Just False )
, ( "n pressed", lowerN, Just False )
, ( "x pressed", lowerX, Nothing )
, ( "other event", otherEvent, Nothing )
]
where
capitalY = chE 'Y'
lowerY = chE 'y'
capitalN = chE 'N'
lowerN = chE 'n'
lowerX = chE 'x'
otherEvent = VtyEvent $ EvResize 0 0
chE c = VtyEvent $ EvKey (KChar c) []

2
test/Helpers/GoalieSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
test/Helpers/PlayerSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
test/Helpers/PositionSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
test/HelpersSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
test/ReportSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

2
test/Spec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

29
test/SpecHelpers.hs Normal file
View File

@ -0,0 +1,29 @@
{-
mtlstats
Copyright (C) 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 SpecHelpers where
import Brick.Widgets.Edit (Editor, editContentsL, editor)
import Data.Text.Zipper (gotoEOL)
import Lens.Micro ((&), (%~))
mkEditor :: String -> Editor String ()
mkEditor str = editor () (Just 1) str & editContentsL %~ gotoEOL

2
test/Types/MenuSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify

4
test/TypesSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -34,8 +34,8 @@ import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import qualified Data.Map.Lazy as M
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import qualified GHC.Exts as HM
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomIO, randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)

6
test/UtilSpec.hs
View File

@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@ -26,6 +26,8 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Util
import SpecHelpers
spec :: Spec
spec = describe "Mtlstats.Util" $ do
nthSpec
@ -114,7 +116,7 @@ capitalizeNameSpec :: Spec
capitalizeNameSpec = describe "capitalizeName" $ mapM_
(\(label, ch, str, expected) -> context label $
it ("should be " ++ expected) $
capitalizeName ch str `shouldBe` expected)
userText (capitalizeName ch $ mkEditor str) `shouldBe` expected)
-- label, character, string, expected
[ ( "initial lower", 'a', "", "A" )
, ( "initial upper", 'A', "", "A" )

8
vagrant/as_user.sh
View File

@ -1,8 +0,0 @@
#!/bin/sh
echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc
mkdir /vagrant/data
ln -s /vagrant/data ~vagrant/.mtlstats
cd /vagrant
stack install

10
vagrant/provision.sh
View File

@ -1,10 +0,0 @@
#!/bin/sh
apt-get update
apt-get upgrade
apt-get -y install libghc-ncurses-dev
wget -qO- https://get.haskellstack.org/ | sh
export HOME=/home/vagrant
sudo -u vagrant /vagrant/vagrant/as_user.sh