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
commit bdbf7daf4e
59 changed files with 555 additions and 636 deletions

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

View File

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

View File

@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module Main where
import Control.Monad.Trans.State (evalStateT) import Brick.Main (defaultMain)
import UI.NCurses (runCurses) import Control.Monad (void)
import Mtlstats import Mtlstats
import Mtlstats.Types
main :: IO () main :: IO ()
main = runCurses $ initState >>= evalStateT mainLoop main = void $ defaultMain app newProgState

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module Mtlstats.Handlers (ynHandler) where
import Brick.Types (BrickEvent (VtyEvent))
import Data.Char (toUpper) 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 -- | Handler for a yes/no prompt
ynHandler :: C.Event -> Maybe Bool ynHandler :: BrickEvent () () -> Maybe Bool
ynHandler (C.EventCharacter c) = case toUpper c of ynHandler (VtyEvent (EvKey (KChar c) [])) = case toUpper c of
'Y' -> Just True 'Y' -> Just True
'N' -> Just False 'N' -> Just False
_ -> Nothing _ -> Nothing

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -26,10 +26,19 @@ module Mtlstats.Util
, updateMap , updateMap
, slice , slice
, capitalizeName , capitalizeName
, linesToWidget
, linesToWidgetC
, userText
) where ) 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 Data.Char (isSpace, toUpper)
import qualified Data.Map as M 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 -- | Attempt to select the element from a list at a given index
nth nth
@ -101,13 +110,14 @@ slice offset len = take len . drop offset
capitalizeName capitalizeName
:: Char :: Char
-- ^ The character being input -- ^ The character being input
-> String -> Editor String ()
-- ^ The current string -- ^ The current string
-> String -> Editor String ()
-- ^ The resulting string -- ^ The resulting string
capitalizeName ch str = str ++ [ch'] capitalizeName ch e = e & editContentsL %~ insertChar ch'
where where
ch' = if lockFlag str s = e^.to userText
ch' = if lockFlag s
then toUpper ch then toUpper ch
else ch else ch
lockFlag "" = True lockFlag "" = True
@ -118,3 +128,22 @@ capitalizeName ch str = str ++ [ch']
lockFlag' (c:cs) lockFlag' (c:cs)
| isSpace c = lockFlag' cs | isSpace c = lockFlag' cs
| otherwise = False | 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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module ActionsSpec (spec) where
import Control.Monad (replicateM) import Control.Monad (replicateM)
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
import Test.Hspec import Test.Hspec
( Spec ( Spec
, context , context
@ -37,9 +37,11 @@ import Test.Hspec
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.NewGameSpec as NewGame import qualified Actions.NewGameSpec as NewGame
import qualified Actions.EditStandingsSpec as EditStandings import qualified Actions.EditStandingsSpec as EditStandings
import SpecHelpers
import qualified TypesSpec as TS import qualified TypesSpec as TS
spec :: Spec spec :: Spec
@ -49,8 +51,6 @@ spec = describe "Mtlstats.Actions" $ do
resetYtdSpec resetYtdSpec
clearRookiesSpec clearRookiesSpec
resetStandingsSpec resetStandingsSpec
addCharSpec
removeCharSpec
createPlayerSpec createPlayerSpec
createGoalieSpec createGoalieSpec
editSpec editSpec
@ -63,8 +63,6 @@ spec = describe "Mtlstats.Actions" $ do
resetCreatePlayerStateSpec resetCreatePlayerStateSpec
resetCreateGoalieStateSpec resetCreateGoalieStateSpec
backHomeSpec backHomeSpec
scrollUpSpec
scrollDownSpec
NewGame.spec NewGame.spec
EditStandings.spec EditStandings.spec
@ -206,29 +204,6 @@ resetStandingsSpec = describe "resetStandings" $ do
it "should be reset" $ it "should be reset" $
ps^.database.dbAwayGameStats `shouldBe` newGameStats 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 :: Spec
createPlayerSpec = describe "createPlayer" $ createPlayerSpec = describe "createPlayer" $
it "should change the mode appropriately" $ let it "should change the mode appropriately" $ let
@ -424,8 +399,7 @@ backHomeSpec = describe "backHome" $ do
let let
input = newProgState input = newProgState
& progMode.gameStateL .~ newGameState & progMode.gameStateL .~ newGameState
& inputBuffer .~ "foo" & editorW .~ mkEditor "foo"
& scrollOffset .~ 123
result = backHome input result = backHome input
it "should set the program mode back to MainMenu" $ it "should set the program mode back to MainMenu" $
@ -434,34 +408,4 @@ backHomeSpec = describe "backHome" $ do
_ -> False _ -> False
it "should clear the input buffer" $ it "should clear the input buffer" $
result^.inputBuffer `shouldBe` "" result^.editorW.to userText `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

View File

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

View File

@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe Copyright (C) Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module HandlersSpec (spec) where
import Test.Hspec (Spec, context, describe, it, shouldBe) 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 import Mtlstats.Handlers
@ -37,10 +39,18 @@ ynHandlerSpec = describe "ynHandler" $ mapM_
it ("should be " ++ show expected) $ it ("should be " ++ show expected) $
ynHandler event `shouldBe` expected) ynHandler event `shouldBe` expected)
-- description, event, expected -- description, event, expected
[ ( "Y pressed", C.EventCharacter 'Y', Just True ) [ ( "Y pressed", capitalY, Just True )
, ( "y pressed", C.EventCharacter 'y', Just True ) , ( "y pressed", lowerY, Just True )
, ( "N pressed", C.EventCharacter 'N', Just False ) , ( "N pressed", capitalN, Just False )
, ( "n pressed", C.EventCharacter 'n', Just False ) , ( "n pressed", lowerN, Just False )
, ( "x pressed", C.EventCharacter 'x', Nothing ) , ( "x pressed", lowerX, Nothing )
, ( "other event", C.EventResized, 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) []

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

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