-- 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
              } = String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"msDraw" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
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 = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
      Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout Widget Name
forall {n}. Widget n
toplabel Widget Name
bottomlabel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> MenuScreenItem -> Widget Name)
-> Bool -> GenericList Name Vector MenuScreenItem -> Widget Name
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 MenuScreenState
-> Getting
     (GenericList Name Vector MenuScreenItem)
     MenuScreenState
     (GenericList Name Vector MenuScreenItem)
-> GenericList Name Vector MenuScreenItem
forall s a. s -> Getting a s a -> a
^. Getting
  (GenericList Name Vector MenuScreenItem)
  MenuScreenState
  (GenericList Name Vector MenuScreenItem)
Lens' MenuScreenState (GenericList Name Vector MenuScreenItem)
mssList)
      where
        toplabel :: Widget n
toplabel =
              AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"filename") Widget n
forall {n}. Widget n
files
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (if BalancingOpts -> Bool
ignore_assertions_ (BalancingOpts -> Bool)
-> (InputOpts -> BalancingOpts) -> InputOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ (InputOpts -> Bool) -> InputOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts
               then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query") (String -> Widget n
forall n. String -> Widget n
str String
" ignoring balance assertions")
               else String -> Widget n
forall n. String -> Widget n
str String
"")
          where
            files :: Widget n
files = case Journal -> [String]
journalFilePaths Journal
j of
                           [] -> String -> Widget n
forall n. String -> Widget n
str String
""
                           String
f:[String]
_ -> String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
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", String -> Widget Name
forall n. String -> Widget n
str String
"select")
              ,(String
"RIGHT", String -> Widget Name
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", String -> Widget Name
forall n. String -> Widget n
str String
"add txn")
--               ,("g", "reload")
              ,(String
"?", String -> Widget Name
forall n. String -> Widget n
str String
"help")
              ,(String
"q", String -> Widget Name
forall n. String -> Widget n
str String
"quit")
              ]

msDraw UIState
_ =  String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"msDraw" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ String -> [Widget Name]
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
msItemScreenName :: Text
msItemScreen :: ScreenName
msItemScreenName :: MenuScreenItem -> Text
msItemScreen :: MenuScreenItem -> ScreenName
..} =
  Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
    Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
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'
  String -> EventM Name UIState ()
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 GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector MenuScreenItem
 -> Maybe (Int, MenuScreenItem))
-> GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst of
                    Just (Int
_, MenuScreenItem{Text
ScreenName
msItemScreenName :: MenuScreenItem -> Text
msItemScreen :: MenuScreenItem -> ScreenName
msItemScreenName :: Text
msItemScreen :: ScreenName
..}) -> ScreenName -> Maybe ScreenName
forall a. a -> Maybe a
Just ScreenName
msItemScreen
                    Maybe (Int, MenuScreenItem)
Nothing -> Maybe ScreenName
forall a. Maybe a
Nothing
        nonblanks :: Vector MenuScreenItem
nonblanks = (MenuScreenItem -> Bool)
-> Vector MenuScreenItem -> Vector MenuScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (MenuScreenItem -> Bool) -> MenuScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool)
-> (MenuScreenItem -> Text) -> MenuScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuScreenItem -> Text
msItemScreenName) (Vector MenuScreenItem -> Vector MenuScreenItem)
-> Vector MenuScreenItem -> Vector MenuScreenItem
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem)
-> GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst
        lastnonblankidx :: Int
lastnonblankidx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Vector MenuScreenItem -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector MenuScreenItem
nonblanks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      Day
d <- IO Day -> EventM Name UIState Day
forall a. IO a -> EventM Name UIState a
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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui
            VtyEvent (EvKey Key
KEnter []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$
                case String -> UIState -> Either String UIState
setFilter String
s (UIState -> Either String UIState)
-> UIState -> Either String UIState
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" (String -> Maybe String
forall a. a -> Maybe a
Just String
bad) UIState
ui
                  Right UIState
ui' -> UIState
ui'
              where s :: String
s = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Editor String Name -> [String]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor String Name
ed
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            VtyEvent Event
e -> do
              Editor String Name
ed' <- Editor String Name
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Editor String Name
ed (EventM Name (Editor String Name) ()
 -> EventM Name UIState (Editor String Name))
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a b. (a -> b) -> a -> b
$ BrickEvent Name Any -> EventM Name (Editor String Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (Event -> BrickEvent Name Any
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
              UIState -> EventM Name UIState ()
put' UIState
ui{aMode=Minibuffer "filter" ed'}
            AppEvent AppEvent
_  -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseDown{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseUp{}   -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
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]) -> EventM Name UIState ()
forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
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') []) -> EventM Name UIState ()
forall a s. EventM a s ()
halt
            -- EvKey (KChar 'l') [MCtrl] -> do
            VtyEvent (EvKey Key
KEsc        []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
            VtyEvent (EvKey (KChar Char
c)   []) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
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 BrickEvent Name AppEvent -> [BrickEvent Name AppEvent] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), AppEvent -> BrickEvent Name AppEvent
forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
              IO UIState -> EventM Name UIState UIState
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
            VtyEvent (EvKey (KChar Char
'a') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
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') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
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') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
endPosition (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Text -> Maybe String -> UIState -> UIState
showMinibuffer Text
"filter" Maybe String
forall a. Maybe a
Nothing UIState
ui
            VtyEvent (EvKey Key
k           []) | Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KBS, Key
KDel] -> (UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
resetFilter UIState
ui)

            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> GenericList Name Vector MenuScreenItem -> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) EventM Name UIState ()
-> EventM Name UIState () -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> EventM Name UIState b -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
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 Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents
                      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement (Maybe (Int, MenuScreenItem) -> Bool)
-> Maybe (Int, MenuScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
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 (ScreenName -> Maybe ScreenName -> ScreenName
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"") Text
clickedname -> do
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst}  -- XXX does this do anything ?
              where
                item :: Maybe MenuScreenItem
item = GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) Vector MenuScreenItem -> Int -> Maybe MenuScreenItem
forall a. Vector a -> Int -> Maybe a
!? Int
y
                clickedname :: Text
clickedname = Text -> (MenuScreenItem -> Text) -> Maybe MenuScreenItem -> Text
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  -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              where
                item :: Maybe MenuScreenItem
item = GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) Vector MenuScreenItem -> Int -> Maybe MenuScreenItem
forall a. Vector a -> Int -> Maybe a
!? Int
y
                -- clickedname = maybe "" msItemScreenName item
                mclickedscr :: Maybe ScreenName
mclickedscr  = MenuScreenItem -> ScreenName
msItemScreen (MenuScreenItem -> ScreenName)
-> Maybe MenuScreenItem -> Maybe ScreenName
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 Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents, Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement Maybe (Int, MenuScreenItem)
mnextelement -> do
              ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)GenericList Name Vector MenuScreenItem
-> Getting Name (GenericList Name Vector MenuScreenItem) Name
-> Name
forall s a. s -> Getting a s a -> a
^.Getting Name (GenericList Name Vector MenuScreenItem) Name
forall n1 (t :: * -> *) e n2 (f :: * -> *).
Functor f =>
(n1 -> f n2) -> GenericList n1 t e -> f (GenericList n2 t e)
listNameL) Int
1
              where mnextelement :: Maybe (Int, MenuScreenItem)
mnextelement = GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector MenuScreenItem
 -> Maybe (Int, MenuScreenItem))
-> GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> GenericList Name Vector MenuScreenItem
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 Button -> [Button] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
              let scrollamt :: Int
scrollamt = if Button
btnButton -> Button -> Bool
forall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
              GenericList Name Vector MenuScreenItem
list' <- GenericList Name Vector MenuScreenItem
-> EventM
     Name
     (GenericList Name Vector MenuScreenItem)
     (GenericList Name Vector MenuScreenItem)
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM
   Name
   (GenericList Name Vector MenuScreenItem)
   (GenericList Name Vector MenuScreenItem)
 -> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM
     Name
     (GenericList Name Vector MenuScreenItem)
     (GenericList Name Vector MenuScreenItem)
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Int
-> EventM
     Name
     (GenericList Name Vector MenuScreenItem)
     (GenericList Name Vector MenuScreenItem)
forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name (GenericList Name Vector MenuScreenItem -> Int
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=MS sst{_mssList=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 Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KPageDown, Key
KEnd] -> do
              GenericList Name Vector MenuScreenItem
l <- GenericList Name Vector MenuScreenItem
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM Name (GenericList Name Vector MenuScreenItem) ()
 -> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (GenericList Name Vector MenuScreenItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
              if Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement (Maybe (Int, MenuScreenItem) -> Bool)
-> Maybe (Int, MenuScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
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' = Int
-> GenericList Name Vector MenuScreenItem
-> GenericList Name Vector MenuScreenItem
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
                GenericList Name Vector MenuScreenItem -> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector MenuScreenItem
l'
                UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst{_mssList=l'}}
              else
                UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst{_mssList=l}}

            -- fall through to the list's event handler (handles up/down)
            VtyEvent Event
e -> do
              GenericList Name Vector MenuScreenItem
list' <- GenericList Name Vector MenuScreenItem
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM Name (GenericList Name Vector MenuScreenItem) ()
 -> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (GenericList Name Vector MenuScreenItem) ()
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=MS $ sst & mssList .~ list'}

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

    UIState
_ -> String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"msHandle" EventM Name UIState ()
-> EventM Name UIState () -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> EventM Name UIState b -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EventM Name UIState ()
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
  String -> EventM Name UIState ()
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 Maybe Text
forall a. Maybe a
Nothing
      ScreenName
CashScreen      -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
csNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
      ScreenName
Balancesheet    -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
bsNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
      ScreenName
Incomestatement -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
isNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
  UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
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=listMoveTo selidx l}
msSetSelectedScreen Int
_ Screen
s = Screen
s

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

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