-- The menu screen, showing other screens available in hledger-ui.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Hledger.UI.MenuScreen
 (msNew
 ,msUpdate
 ,msDraw
 ,msHandle
 ,msSetSelectedScreen
 )
where

import Brick
import Brick.Widgets.List
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import System.Console.ANSI
import System.FilePath (takeFileName)

import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.Editor (runIadd, runEditor, endPosition)
import Brick.Widgets.Edit (getEditContents, handleEditorEvent)


msDraw :: UIState -> [Widget Name]
msDraw :: UIState -> [Widget Name]
msDraw UIState{aopts :: UIState -> UIOpts
aopts=_uopts :: UIOpts
_uopts@UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
_rspec}}
              ,ajournal :: UIState -> Journal
ajournal=Journal
j
              ,aScreen :: UIState -> Screen
aScreen=MS MenuScreenState
sst
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } = forall a. String -> a -> a
dbgui String
"msDraw" forall a b. (a -> b) -> a -> b
$
    case Mode
mode of
      Mode
Help              -> [Widget Name
helpDialog, Widget Name
maincontent]
      Mode
_                 -> [Widget Name
maincontent]
  where
    maincontent :: Widget Name
maincontent = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
      forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout forall {n}. Widget n
toplabel Widget Name
bottomlabel forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> MenuScreenItem -> Widget Name
msDrawItem Bool
True (MenuScreenState
sst forall s a. s -> Getting a s a -> a
^. Lens' MenuScreenState (GenericList Name Vector MenuScreenItem)
mssList)
      where
        toplabel :: Widget n
toplabel =
              forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"filename") forall {n}. Widget n
files
          forall n. Widget n -> Widget n -> Widget n
<+> (if BalancingOpts -> Bool
ignore_assertions_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts
               then forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query") (forall n. String -> Widget n
str String
" ignoring balance assertions")
               else forall n. String -> Widget n
str String
"")
          where
            files :: Widget n
files = case Journal -> [String]
journalFilePaths Journal
j of
                           [] -> forall n. String -> Widget n
str String
""
                           String
f:[String]
_ -> forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
f
                           -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
                           -- f:fs  -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")

        bottomlabel :: Widget Name
bottomlabel = case Mode
mode of
                        Minibuffer Text
label Editor String Name
ed -> Text -> Editor String Name -> Widget Name
minibuffer Text
label Editor String Name
ed
                        Mode
_                   -> Widget Name
quickhelp
          where
            quickhelp :: Widget Name
quickhelp = [(String, Widget Name)] -> Widget Name
borderKeysStr' [
               (String
"DOWN/UP", forall n. String -> Widget n
str String
"select")
              ,(String
"RIGHT", forall n. String -> Widget n
str String
"enter screen")
              -- ,("t", renderToggle (tree_ ropts) "list" "tree")
              -- ,("t", str "tree")
              -- ,("l", str "list")
              -- ,("-+", str "depth")
              -- ,("H", renderToggle (not ishistorical) "end-bals" "changes")
              -- ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
              --,("/", "filter")
              --,("DEL", "unfilter")
              --,("ESC", "cancel/top")
              ,(String
"a", forall n. String -> Widget n
str String
"add txn")
--               ,("g", "reload")
              ,(String
"?", forall n. String -> Widget n
str String
"help")
              ,(String
"q", forall n. String -> Widget n
str String
"quit")
              ]

msDraw UIState
_ =  forall a. String -> a -> a
dbgui String
"msDraw" forall a b. (a -> b) -> a -> b
$ forall a. String -> a
errorWrongScreenType String
"draw function"  -- PARTIAL:

-- msDrawItem :: (Int,Int) -> Bool -> MenuScreenItem -> Widget Name
-- msDrawItem (_acctwidth, _balwidth) _selected MenuScreenItem{..} =
msDrawItem :: Bool -> MenuScreenItem -> Widget Name
msDrawItem :: Bool -> MenuScreenItem -> Widget Name
msDrawItem Bool
_selected MenuScreenItem{Text
ScreenName
msItemScreen :: MenuScreenItem -> ScreenName
msItemScreenName :: MenuScreenItem -> Text
msItemScreen :: ScreenName
msItemScreenName :: Text
..} =
  forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
    forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
msItemScreenName

-- XXX clean up like asHandle
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle BrickEvent Name AppEvent
ev = do
  UIState
ui0 <- EventM Name UIState UIState
get'
  forall s. String -> EventM Name s ()
dbguiEv String
"msHandle"
  case UIState
ui0 of
    ui :: UIState
ui@UIState{
       aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
      ,ajournal :: UIState -> Journal
ajournal=Journal
j
      ,aMode :: UIState -> Mode
aMode=Mode
mode
      ,aScreen :: UIState -> Screen
aScreen=MS MenuScreenState
sst
      } -> do
      let
        -- save the currently selected account, in case we leave this screen and lose the selection
        mselscr :: Maybe ScreenName
mselscr = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst of
                    Just (Int
_, MenuScreenItem{Text
ScreenName
msItemScreen :: ScreenName
msItemScreenName :: Text
msItemScreen :: MenuScreenItem -> ScreenName
msItemScreenName :: MenuScreenItem -> Text
..}) -> forall a. a -> Maybe a
Just ScreenName
msItemScreen
                    Maybe (Int, MenuScreenItem)
Nothing -> forall a. Maybe a
Nothing
        nonblanks :: Vector MenuScreenItem
nonblanks = forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuScreenItem -> Text
msItemScreenName) forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst
        lastnonblankidx :: Int
lastnonblankidx = forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector MenuScreenItem
nonblanks forall a. Num a => a -> a -> a
- Int
1)
      Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay

      case Mode
mode of
        Minibuffer Text
_ Editor String Name
ed ->
          case BrickEvent Name AppEvent
ev of
            VtyEvent (EvKey Key
KEsc   []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui
            VtyEvent (EvKey Key
KEnter []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$
                case String -> UIState -> Either String UIState
setFilter String
s forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui of
                  Left String
bad -> Text -> Maybe String -> UIState -> UIState
showMinibuffer Text
"Cannot compile regular expression" (forall a. a -> Maybe a
Just String
bad) UIState
ui
                  Right UIState
ui' -> UIState
ui'
              where s :: String
s = String -> String
chomp forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor String Name
ed
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            VtyEvent Event
e -> do
              Editor String Name
ed' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Editor String Name
ed forall a b. (a -> b) -> a -> b
$ forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
              UIState -> EventM Name UIState ()
put' UIState
ui{aMode :: Mode
aMode=Text -> Editor String Name -> Mode
Minibuffer Text
"filter" Editor String Name
ed'}
            AppEvent AppEvent
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseDown{} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseUp{}   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

        Mode
Help ->
          case BrickEvent Name AppEvent
ev of
            -- VtyEvent (EvKey (KChar 'q') []) -> halt
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle BrickEvent Name AppEvent
ev

        Mode
Normal ->
          case BrickEvent Name AppEvent
ev of
            VtyEvent (EvKey (KChar Char
'q') []) -> forall a s. EventM a s ()
halt
            -- EvKey (KChar 'l') [MCtrl] -> do
            VtyEvent (EvKey Key
KEsc        []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
            VtyEvent (EvKey (KChar Char
c)   []) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Mode -> UIState -> UIState
setMode Mode
Help UIState
ui
            -- XXX AppEvents currently handled only in Normal mode
            -- XXX be sure we don't leave unconsumed events piling up
            AppEvent (DateChange Day
old Day
_) | Period -> Bool
isStandardPeriod Period
p Bool -> Bool -> Bool
&& Period
p Period -> Day -> Bool
`periodContainsDate` Day
old ->
              UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
              where
                p :: Period
p = UIState -> Period
reportPeriod UIState
ui
            BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
            VtyEvent (EvKey (KChar Char
'a') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'A') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'E') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
endPosition (Journal -> String
journalFilePath Journal
j)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui

--             VtyEvent (EvKey (KChar 'B') []) -> put' $ regenerateScreens j d $ toggleConversionOp ui
--             VtyEvent (EvKey (KChar 'V') []) -> put' $ regenerateScreens j d $ toggleValue ui
--             VtyEvent (EvKey (KChar '0') []) -> put' $ regenerateScreens j d $ setDepth (Just 0) ui
--             VtyEvent (EvKey (KChar '1') []) -> put' $ regenerateScreens j d $ setDepth (Just 1) ui
--             VtyEvent (EvKey (KChar '2') []) -> put' $ regenerateScreens j d $ setDepth (Just 2) ui
--             VtyEvent (EvKey (KChar '3') []) -> put' $ regenerateScreens j d $ setDepth (Just 3) ui
--             VtyEvent (EvKey (KChar '4') []) -> put' $ regenerateScreens j d $ setDepth (Just 4) ui
--             VtyEvent (EvKey (KChar '5') []) -> put' $ regenerateScreens j d $ setDepth (Just 5) ui
--             VtyEvent (EvKey (KChar '6') []) -> put' $ regenerateScreens j d $ setDepth (Just 6) ui
--             VtyEvent (EvKey (KChar '7') []) -> put' $ regenerateScreens j d $ setDepth (Just 7) ui
--             VtyEvent (EvKey (KChar '8') []) -> put' $ regenerateScreens j d $ setDepth (Just 8) ui
--             VtyEvent (EvKey (KChar '9') []) -> put' $ regenerateScreens j d $ setDepth (Just 9) ui
--             VtyEvent (EvKey (KChar '-') []) -> put' $ regenerateScreens j d $ decDepth ui
--             VtyEvent (EvKey (KChar '_') []) -> put' $ regenerateScreens j d $ decDepth ui
--             VtyEvent (EvKey (KChar c)   []) | c `elem` ['+','='] -> put' $ regenerateScreens j d $ incDepth ui
--             VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui

--             -- display mode/query toggles
--             VtyEvent (EvKey (KChar 'H') []) -> modify' (regenerateScreens j d . toggleHistorical) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> msCenterAndContinue
--             VtyEvent (EvKey (KChar 'F') []) -> modify' (regenerateScreens j d . toggleForecast d)

            -- VtyEvent (EvKey (KDown)     [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui
            -- VtyEvent (EvKey (KUp)       [MShift]) -> put' $ regenerateScreens j d $ growReportPeriod d ui
            -- VtyEvent (EvKey (KRight)    [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui
            -- VtyEvent (EvKey (KLeft)     [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan ui
            VtyEvent (EvKey (KChar Char
'/') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Text -> Maybe String -> UIState -> UIState
showMinibuffer Text
"filter" forall a. Maybe a
Nothing UIState
ui
            VtyEvent (EvKey Key
k           []) | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KBS, Key
KDel] -> (UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
resetFilter UIState
ui)

            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui

            -- RIGHT enters selected screen if there is one
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents
                      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) ->
              Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d (forall a. a -> Maybe a -> a
fromMaybe ScreenName
Accounts Maybe ScreenName
mselscr) UIState
ui

            -- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
            -- just use it to move the selection
            MouseDown Name
_n Button
BLeft [Modifier]
_mods Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> a -> Bool
==Text
"") Text
clickedname -> do
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=MenuScreenState -> Screen
MS MenuScreenState
sst}  -- XXX does this do anything ?
              where
                item :: Maybe MenuScreenItem
item = forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall a. Vector a -> Int -> Maybe a
!? Int
y
                clickedname :: Text
clickedname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MenuScreenItem -> Text
msItemScreenName Maybe MenuScreenItem
item
                -- mclickedscr  = msItemScreen <$> item
            -- and on MouseUp, enter the subscreen
            MouseUp Name
_n (Just Button
BLeft) Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} ->  -- | not $ (=="") clickedname ->
              case Maybe ScreenName
mclickedscr of
                Just ScreenName
scr -> Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d ScreenName
scr UIState
ui
                Maybe ScreenName
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
              where
                item :: Maybe MenuScreenItem
item = forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall a. Vector a -> Int -> Maybe a
!? Int
y
                -- clickedname = maybe "" msItemScreenName item
                mclickedscr :: Maybe ScreenName
mclickedscr  = MenuScreenItem -> ScreenName
msItemScreen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MenuScreenItem
item

            -- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents, forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement Maybe (Int, MenuScreenItem)
mnextelement -> do
              forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)forall s a. s -> Getting a s a -> a
^.forall n1 (t :: * -> *) e n2.
Lens (GenericList n1 t e) (GenericList n2 t e) n1 n2
listNameL) Int
1
              where mnextelement :: Maybe (Int, MenuScreenItem)
mnextelement = forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)

            -- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
            -- pushing the selection when necessary.
            MouseDown Name
name Button
btn [Modifier]
_mods Location
_loc | Button
btn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
              let scrollamt :: Int
scrollamt = if Button
btnforall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
              GenericList Name Vector MenuScreenItem
list' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall a b. (a -> b) -> a -> b
$ forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name (forall {n}. GenericList n Vector MenuScreenItem -> Int
msListSize (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)) Int
scrollamt
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=MenuScreenState -> Screen
MS MenuScreenState
sst{_mssList :: GenericList Name Vector MenuScreenItem
_mssList=GenericList Name Vector MenuScreenItem
list'}}

            -- if page down or end leads to a blank padding item, stop at last non-blank
            VtyEvent e :: Event
e@(EvKey Key
k           []) | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KPageDown, Key
KEnd] -> do
              GenericList Name Vector MenuScreenItem
l <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
              if forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList Name Vector MenuScreenItem
l
              then do
                let l' :: GenericList Name Vector MenuScreenItem
l' = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
lastnonblankidx GenericList Name Vector MenuScreenItem
l
                forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector MenuScreenItem
l'
                UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=MenuScreenState -> Screen
MS MenuScreenState
sst{_mssList :: GenericList Name Vector MenuScreenItem
_mssList=GenericList Name Vector MenuScreenItem
l'}}
              else
                UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=MenuScreenState -> Screen
MS MenuScreenState
sst{_mssList :: GenericList Name Vector MenuScreenItem
_mssList=GenericList Name Vector MenuScreenItem
l}}

            -- fall through to the list's event handler (handles up/down)
            VtyEvent Event
e -> do
              GenericList Name Vector MenuScreenItem
list' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent (Event -> Event
normaliseMovementKeys Event
e)
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=MenuScreenState -> Screen
MS forall a b. (a -> b) -> a -> b
$ MenuScreenState
sst forall a b. a -> (a -> b) -> b
& Lens' MenuScreenState (GenericList Name Vector MenuScreenItem)
mssList forall s t a b. ASetter s t a b -> b -> s -> t
.~ GenericList Name Vector MenuScreenItem
list'}

            MouseDown{} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseUp{}   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            AppEvent AppEvent
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    UIState
_ -> forall s. String -> EventM Name s ()
dbguiEv String
"msHandle" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> a
errorWrongScreenType String
"event handler"

msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d ScreenName
scrname ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j, aopts :: UIState -> UIOpts
aopts=UIOpts
uopts} = do
  forall s. String -> EventM Name s ()
dbguiEv String
"msEnterScreen"
  let
    scr :: Screen
scr = case ScreenName
scrname of
      ScreenName
Accounts        -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
asNew UIOpts
uopts Day
d Journal
j forall a. Maybe a
Nothing
      ScreenName
CashScreen      -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
csNew UIOpts
uopts Day
d Journal
j forall a. Maybe a
Nothing
      ScreenName
Balancesheet    -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
bsNew UIOpts
uopts Day
d Journal
j forall a. Maybe a
Nothing
      ScreenName
Incomestatement -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
isNew UIOpts
uopts Day
d Journal
j forall a. Maybe a
Nothing
  UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Screen -> UIState -> UIState
pushScreen Screen
scr UIState
ui

-- | Set the selected list item on the menu screen. Has no effect on other screens.
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen Int
selidx (MS mss :: MenuScreenState
mss@MSS{_mssList :: MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList=GenericList Name Vector MenuScreenItem
l}) = MenuScreenState -> Screen
MS MenuScreenState
mss{_mssList :: GenericList Name Vector MenuScreenItem
_mssList=forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
selidx GenericList Name Vector MenuScreenItem
l}
msSetSelectedScreen Int
_ Screen
s = Screen
s

isBlankElement :: Maybe (a, MenuScreenItem) -> Bool
isBlankElement Maybe (a, MenuScreenItem)
mel = ((MenuScreenItem -> Text
msItemScreenName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, MenuScreenItem)
mel) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
""

msListSize :: GenericList n Vector MenuScreenItem -> Int
msListSize = forall a. Vector a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile ((forall a. Eq a => a -> a -> Bool
/=Text
"")forall b c a. (b -> c) -> (a -> b) -> a -> c
.MenuScreenItem -> Text
msItemScreenName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t :: * -> *) e. GenericList n t e -> t e
listElements