switch from ncurses to brick #1
|
@ -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
|
||||||
|
|
20
package.yaml
20
package.yaml
|
@ -20,17 +20,19 @@ 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
|
- time >= 1.11.1.1 && < 1.12
|
||||||
- transformers >= 0.5.6.2 && < 0.6
|
- vty >= 5.37 && < 5.38
|
||||||
- bytestring
|
|
||||||
- microlens
|
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
@ -60,5 +62,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
|
||||||
|
|
|
@ -19,40 +19,34 @@ 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 (..), showFirstCursor)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Brick.Util (on)
|
||||||
import Control.Monad.Trans.State (get, gets)
|
import Graphics.Vty.Attributes.Color (blue, white)
|
||||||
import Data.Maybe (fromJust)
|
import Lens.Micro (to)
|
||||||
import qualified UI.NCurses as C
|
import Lens.Micro.Mtl (use)
|
||||||
|
|
||||||
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 = \s -> [drawController (dispatch s) s]
|
||||||
void $ C.setCursorMode C.CursorInvisible
|
, appChooseCursor = showFirstCursor
|
||||||
return newProgState
|
, appHandleEvent = handler
|
||||||
|
, appStartEvent = return ()
|
||||||
|
, appAttrMap = const myAttrMap
|
||||||
|
}
|
||||||
|
|
||||||
-- | Main program loop
|
handler :: Handler ()
|
||||||
mainLoop :: Action ()
|
handler e = do
|
||||||
mainLoop = do
|
c <- use (to dispatch)
|
||||||
c <- gets dispatch
|
handleController c e
|
||||||
get >>= lift . draw . drawController c
|
|
||||||
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
|
--jl
|
||||||
cm <- C.updateWindow w $ do
|
|
||||||
C.clear
|
|
||||||
u
|
|
||||||
C.render
|
|
||||||
void $ C.setCursorMode cm
|
|
||||||
|
|
|
@ -41,18 +41,18 @@ module Mtlstats.Actions
|
||||||
, resetCreatePlayerState
|
, resetCreatePlayerState
|
||||||
, resetCreateGoalieState
|
, resetCreateGoalieState
|
||||||
, backHome
|
, backHome
|
||||||
, scrollUp
|
|
||||||
, scrollDown
|
|
||||||
, loadDatabase
|
, loadDatabase
|
||||||
, saveDatabase
|
, saveDatabase
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Brick.Main (viewportScroll)
|
||||||
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 Lens.Micro ((^.), (&), (.~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
|
import Lens.Micro.Mtl ((.=), use)
|
||||||
import System.EasyFile
|
import System.EasyFile
|
||||||
( createDirectoryIfMissing
|
( createDirectoryIfMissing
|
||||||
, getAppUserDataDirectory
|
, getAppUserDataDirectory
|
||||||
|
@ -208,15 +208,7 @@ backHome :: ProgState -> ProgState
|
||||||
backHome
|
backHome
|
||||||
= (progMode .~ MainMenu)
|
= (progMode .~ MainMenu)
|
||||||
. (inputBuffer .~ "")
|
. (inputBuffer .~ "")
|
||||||
. (scrollOffset .~ 0)
|
. (scroller .~ viewportScroll ())
|
||||||
|
|
||||||
-- | Scrolls the display up
|
|
||||||
scrollUp :: ProgState -> ProgState
|
|
||||||
scrollUp = scrollOffset %~ max 0 . pred
|
|
||||||
|
|
||||||
-- | Scrolls the display down
|
|
||||||
scrollDown :: ProgState -> ProgState
|
|
||||||
scrollDown = scrollOffset %~ succ
|
|
||||||
|
|
||||||
-- | Loads the database
|
-- | Loads the database
|
||||||
loadDatabase :: Action ()
|
loadDatabase :: Action ()
|
||||||
|
@ -226,18 +218,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
|
||||||
|
|
|
@ -21,15 +21,16 @@ 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 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 +49,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
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
|
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 +80,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 +98,4 @@ confirmCreateGoalieC = Controller
|
||||||
. (egsCallback .~ success)
|
. (egsCallback .~ success)
|
||||||
Just False -> failure
|
Just False -> failure
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -21,15 +21,16 @@ 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 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 +53,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
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
|
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,7 +83,6 @@ 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 <- gets (^.progMode.createPlayerStateL)
|
||||||
let
|
let
|
||||||
|
@ -108,5 +101,4 @@ confirmCreatePlayerC = Controller
|
||||||
. (epsCallback .~ success)
|
. (epsCallback .~ success)
|
||||||
Just False -> failure
|
Just False -> failure
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -23,10 +23,11 @@ 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 (gets, modify)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
import Lens.Micro ((^.), (.~), (%~))
|
||||||
import UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
|
@ -90,33 +91,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
|
|
||||||
|
|
||||||
hdr = fromMaybe [] $ do
|
|
||||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
goalie <- nth gid $ s^.database.dbGoalies
|
goalie <- nth gid $ s^.database.dbGoalies
|
||||||
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
|
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
|
||||||
|
in str $ hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
|
||||||
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
|
, handleController = \e -> case ynHandler e of
|
||||||
|
|
||||||
return C.CursorInvisible
|
|
||||||
|
|
||||||
, handleController = \e -> do
|
|
||||||
|
|
||||||
case ynHandler e of
|
|
||||||
|
|
||||||
Just True -> do
|
Just True -> do
|
||||||
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
|
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
|
||||||
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
|
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
|
||||||
modify edit
|
modify edit
|
||||||
|
|
||||||
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
|
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
return True
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
ytdGamesC :: Bool -> Action () -> Controller
|
ytdGamesC :: Bool -> Action () -> Controller
|
||||||
|
@ -173,8 +160,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
|
||||||
|
[ str $ fromMaybe "" $ do
|
||||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
g <- nth gid $ s^.database.dbGoalies
|
g <- nth gid $ s^.database.dbGoalies
|
||||||
Just $ goalieDetails g ++ "\n"
|
Just $ goalieDetails g
|
||||||
|
, w
|
||||||
|
]
|
||||||
|
|
|
@ -21,10 +21,11 @@ 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 (gets, modify)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
import Lens.Micro ((^.), (.~), (%~))
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
|
@ -81,33 +82,19 @@ lifetimeC _ = menuControllerWith header editPlayerLtMenu
|
||||||
deleteC :: Action () -> Controller
|
deleteC :: Action () -> Controller
|
||||||
deleteC _ = Controller
|
deleteC _ = Controller
|
||||||
|
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> let
|
||||||
|
|
||||||
C.drawString $ let
|
|
||||||
|
|
||||||
hdr = fromMaybe [] $ do
|
hdr = fromMaybe [] $ do
|
||||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
Just $ "Player: " ++ playerDetails player ++ "\n\n"
|
Just $ "Player: " ++ playerDetails player ++ "\n"
|
||||||
|
in str $ hdr ++ "Are you sure you want to delete this player? (Y/N)"
|
||||||
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
|
, handleController = \e -> case ynHandler e of
|
||||||
|
|
||||||
return C.CursorInvisible
|
|
||||||
|
|
||||||
, handleController = \e -> do
|
|
||||||
|
|
||||||
case ynHandler e of
|
|
||||||
|
|
||||||
Just True -> do
|
Just True -> do
|
||||||
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
|
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
|
||||||
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
|
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
|
||||||
modify edit
|
modify edit
|
||||||
|
|
||||||
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
|
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
return True
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
ytdGoalsC :: Bool -> Action () -> Controller
|
ytdGoalsC :: Bool -> Action () -> Controller
|
||||||
|
@ -132,8 +119,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
|
||||||
|
[ fromMaybe emptyWidget $ do
|
||||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
Just $ playerDetails player ++ "\n"
|
Just $ str $ playerDetails player
|
||||||
|
, w
|
||||||
|
]
|
||||||
|
|
|
@ -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 (str, 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
|
||||||
|
@ -65,17 +66,16 @@ 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 $ map str (table ++ [""]) ++ [w]
|
||||||
|
|
||||||
valsFor :: GameStats -> [Int]
|
valsFor :: GameStats -> [Int]
|
||||||
valsFor gs =
|
valsFor gs =
|
||||||
|
|
|
@ -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
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
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 $ vBox $ map str $
|
||||||
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 )
|
||||||
|
] ++
|
||||||
|
[ ""
|
||||||
|
, "Is the above information correct? (Y/N)"
|
||||||
]
|
]
|
||||||
C.drawString "\nIs the above information correct? (Y/N)"
|
, handleController = \e ->
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
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,96 +150,81 @@ 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 = unlines $
|
msg =
|
||||||
[ " 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 vBox $ map str 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 . vBox . map str .
|
||||||
(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 True
|
_ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
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
|
|
||||||
header s
|
|
||||||
|
|
||||||
let
|
|
||||||
table = labelTable $ zip (map show ([1..] :: [Int]))
|
table = labelTable $ zip (map show ([1..] :: [Int]))
|
||||||
[ "JANUARY"
|
[ "JANUARY"
|
||||||
, "FEBRUARY"
|
, "FEBRUARY"
|
||||||
|
@ -246,10 +239,8 @@ monthHeader s = do
|
||||||
, "NOVEMBER"
|
, "NOVEMBER"
|
||||||
, "DECEMBER"
|
, "DECEMBER"
|
||||||
]
|
]
|
||||||
|
in header s $ vBox $ map (hCenter . str)
|
||||||
C.drawString $ unlines $
|
(["MONTH:", ""] ++ table ++ [""]) ++ [w]
|
||||||
map (centre $ fromIntegral $ pred cols) $
|
|
||||||
["MONTH:", ""] ++ table ++ [""]
|
|
||||||
|
|
||||||
gameGoal :: ProgState -> (Int, Int)
|
gameGoal :: ProgState -> (Int, Int)
|
||||||
gameGoal s =
|
gameGoal s =
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -23,19 +23,19 @@ 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 Brick.Widgets.Center (hCenter)
|
||||||
|
import Brick.Widgets.Core (str, vBox)
|
||||||
|
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
|
||||||
|
|
||||||
titleScreenC :: Controller
|
titleScreenC :: Controller
|
||||||
titleScreenC = Controller
|
titleScreenC = Controller
|
||||||
{ drawController = const $ do
|
{ drawController = const $ vBox $ map (hCenter . str)
|
||||||
(_, cols) <- C.windowSize
|
|
||||||
C.drawString $ unlines $ map (centre $ fromIntegral $ pred cols)
|
|
||||||
$ [ ""
|
$ [ ""
|
||||||
, "MONTREAL CANADIENS STATISTICS"
|
, "MONTREAL CANADIENS STATISTICS"
|
||||||
]
|
]
|
||||||
|
@ -46,11 +46,9 @@ titleScreenC = Controller
|
||||||
, ""
|
, ""
|
||||||
, "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 +58,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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -34,40 +34,39 @@ 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 Brick.Widgets.Center (hCenter)
|
||||||
|
import Brick.Widgets.Core (str, vBox)
|
||||||
|
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 +81,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 hCenter $ vBox $ map str 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,20 @@ module Mtlstats.Prompt (
|
||||||
playerToEditPrompt
|
playerToEditPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
|
||||||
|
import Brick.Widgets.Core (hBox, showCursor, str)
|
||||||
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 Graphics.Text.Width (safeWcswidth)
|
||||||
|
import Graphics.Vty.Input.Events
|
||||||
|
( Event (EvKey)
|
||||||
|
, Key (KChar, KEnter, KEsc, KFun)
|
||||||
|
)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import Lens.Micro.Extras (view)
|
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 +69,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 inputBuffer
|
||||||
modify $ inputBuffer .~ ""
|
inputBuffer .= ""
|
||||||
promptAction p val
|
promptAction p val
|
||||||
promptHandler p (C.EventCharacter c) =
|
promptHandler p (VtyEvent (EvKey (KChar c) [])) =
|
||||||
modify $ inputBuffer %~ promptProcessChar p c
|
modify $ inputBuffer %~ promptProcessChar p c
|
||||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
promptHandler _ (VtyEvent (EvKey KEsc [])) =
|
||||||
modify removeChar
|
modify removeChar
|
||||||
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 +102,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 +112,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 -> (++ [ch])
|
||||||
, promptAction = act
|
, promptAction = act
|
||||||
, promptSpecialKey = const $ return ()
|
, promptSpecialKey = \_ _ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Creates an upper case string prompt
|
-- | Creates an upper case string prompt
|
||||||
|
@ -179,12 +172,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 ++ [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
|
||||||
|
@ -215,18 +208,21 @@ 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^.inputBuffer
|
||||||
C.drawString $ spPrompt params ++ sStr
|
pStr = spPrompt params ++ sStr
|
||||||
(row, col) <- C.cursorPosition
|
pWidth = safeWcswidth pStr
|
||||||
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
|
results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
||||||
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
fmtRes = map
|
||||||
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 hBox $
|
||||||
|
[ showCursor () (Location (0, pWidth)) $ str pStr
|
||||||
|
, 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,12 +231,12 @@ 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 inputBuffer
|
||||||
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
|
||||||
|
@ -406,5 +402,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 = let
|
||||||
|
fullStr = pStr ++ s^.inputBuffer
|
||||||
|
strWidth = safeWcswidth fullStr
|
||||||
|
in showCursor () (Location (0, strWidth)) $ str fullStr
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 (..),
|
||||||
|
@ -52,7 +54,7 @@ module Mtlstats.Types (
|
||||||
progMode,
|
progMode,
|
||||||
dbName,
|
dbName,
|
||||||
inputBuffer,
|
inputBuffer,
|
||||||
scrollOffset,
|
scroller,
|
||||||
-- ** ProgMode Lenses
|
-- ** ProgMode Lenses
|
||||||
gameStateL,
|
gameStateL,
|
||||||
createPlayerStateL,
|
createPlayerStateL,
|
||||||
|
@ -195,7 +197,8 @@ 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 Data.Aeson
|
import Data.Aeson
|
||||||
( FromJSON
|
( FromJSON
|
||||||
, ToJSON
|
, ToJSON
|
||||||
|
@ -213,22 +216,28 @@ 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
|
||||||
|
@ -240,8 +249,8 @@ data ProgState = ProgState
|
||||||
-- ^ The name of the database file
|
-- ^ The name of the database file
|
||||||
, _inputBuffer :: String
|
, _inputBuffer :: String
|
||||||
-- ^ Buffer for user input
|
-- ^ Buffer for user input
|
||||||
, _scrollOffset :: Int
|
, _scroller :: ViewportScroll ()
|
||||||
-- ^ The scrolling offset for the display
|
-- ^ Scroller for the reports
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | The program mode
|
-- | The program mode
|
||||||
|
@ -532,13 +541,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 -> String -> String
|
||||||
-- ^ Modifies the string based on the character entered
|
-- ^ Modifies the string 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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -790,7 +799,7 @@ newProgState = ProgState
|
||||||
, _progMode = TitleScreen
|
, _progMode = TitleScreen
|
||||||
, _dbName = ""
|
, _dbName = ""
|
||||||
, _inputBuffer = ""
|
, _inputBuffer = ""
|
||||||
, _scrollOffset = 0
|
, _scroller = viewportScroll ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'GameState'
|
-- | Constructor for a 'GameState'
|
||||||
|
|
|
@ -26,8 +26,11 @@ module Mtlstats.Util
|
||||||
, updateMap
|
, updateMap
|
||||||
, slice
|
, slice
|
||||||
, capitalizeName
|
, capitalizeName
|
||||||
|
, linesToWidget
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Brick.Types (Widget)
|
||||||
|
import Brick.Widgets.Core (str, vBox)
|
||||||
import Data.Char (isSpace, toUpper)
|
import Data.Char (isSpace, toUpper)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
@ -105,9 +108,9 @@ capitalizeName
|
||||||
-- ^ The current string
|
-- ^ The current string
|
||||||
-> String
|
-> String
|
||||||
-- ^ The resulting string
|
-- ^ The resulting string
|
||||||
capitalizeName ch str = str ++ [ch']
|
capitalizeName ch s = s ++ [ch']
|
||||||
where
|
where
|
||||||
ch' = if lockFlag str
|
ch' = if lockFlag s
|
||||||
then toUpper ch
|
then toUpper ch
|
||||||
else ch
|
else ch
|
||||||
lockFlag "" = True
|
lockFlag "" = True
|
||||||
|
@ -118,3 +121,6 @@ capitalizeName ch str = str ++ [ch']
|
||||||
lockFlag' (c:cs)
|
lockFlag' (c:cs)
|
||||||
| isSpace c = lockFlag' cs
|
| isSpace c = lockFlag' cs
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
|
|
||||||
|
linesToWidget :: [String] -> Widget ()
|
||||||
|
linesToWidget = vBox . map str
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -0,0 +1,19 @@
|
||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- completed:
|
||||||
|
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
||||||
|
pantry-tree:
|
||||||
|
sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7
|
||||||
|
size: 674
|
||||||
|
original:
|
||||||
|
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725
|
||||||
|
size: 650255
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml
|
||||||
|
original: lts-20.22
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
@ -425,7 +423,6 @@ backHomeSpec = describe "backHome" $ do
|
||||||
input = newProgState
|
input = newProgState
|
||||||
& progMode.gameStateL .~ newGameState
|
& progMode.gameStateL .~ newGameState
|
||||||
& inputBuffer .~ "foo"
|
& inputBuffer .~ "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" $
|
||||||
|
@ -435,33 +432,3 @@ backHomeSpec = describe "backHome" $ do
|
||||||
|
|
||||||
it "should clear the input buffer" $
|
it "should clear the input buffer" $
|
||||||
result^.inputBuffer `shouldBe` ""
|
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
|
|
||||||
|
|
|
@ -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) []
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user