-- The accounts screen, showing accounts and balances like the CLI balance command.

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

module Hledger.UI.AccountsScreen
 (asNew
 ,asUpdate
 ,asDraw
 ,asDrawHelper
 ,asHandle
 ,handleHelpMode
 ,handleMinibufferMode
 ,asHandleNormalMode
 ,enterRegisterScreen
 ,asSetSelectedAccount
 )
where

import Brick
import Brick.Widgets.List
import Brick.Widgets.Edit
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List hiding (reverse)
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 Text.DocLayout (realLength)

import Hledger
import Hledger.Cli hiding (Mode, 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.Editor
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.RegisterScreen (rsCenterSelection)
import Data.Either (fromRight)
import Control.Arrow ((>>>))
import Safe (headDef)


asDraw :: UIState -> [Widget Name]
asDraw :: UIState -> [Widget Name]
asDraw UIState
ui = forall a. String -> a -> a
dbgui String
"asDraw" forall a b. (a -> b) -> a -> b
$ UIState -> ReportOpts -> String -> [Widget Name]
asDrawHelper UIState
ui ReportOpts
ropts' String
scrname
  where
    ropts' :: ReportOpts
ropts' = ReportSpec -> ReportOpts
_rsReportOpts forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ forall a b. (a -> b) -> a -> b
$ UIOpts -> CliOpts
uoCliOpts forall a b. (a -> b) -> a -> b
$ UIState -> UIOpts
aopts UIState
ui
    scrname :: String
scrname = String
"account " forall a. [a] -> [a] -> [a]
++ if Bool
ishistorical then String
"balances" else String
"changes"
      where ishistorical :: Bool
ishistorical = ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts' forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
Historical

-- | Help draw any accounts-like screen (all accounts, balance sheet, income statement..).
-- The provided ReportOpts are used instead of the ones in the UIState.
-- The other argument is the screen display name.
asDrawHelper :: UIState -> ReportOpts -> String -> [Widget Name]
asDrawHelper :: UIState -> ReportOpts -> String -> [Widget Name]
asDrawHelper UIState{aScreen :: UIState -> Screen
aScreen=Screen
scr, aopts :: UIState -> UIOpts
aopts=UIOpts
uopts, ajournal :: UIState -> Journal
ajournal=Journal
j, aMode :: UIState -> Mode
aMode=Mode
mode} ReportOpts
ropts String
scrname =
  forall a. String -> a -> a
dbgui String
"asDrawHelper" forall a b. (a -> b) -> a -> b
$
  case Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen Screen
scr of
    Maybe AccountsLikeScreen
Nothing          -> forall a. String -> a -> a
dbgui String
"asDrawHelper" forall a b. (a -> b) -> a -> b
$ forall a. String -> a
errorWrongScreenType String
"draw helper"  -- PARTIAL:
    Just (ALS AccountsScreenState -> Screen
_ AccountsScreenState
ass) -> case Mode
mode of
      Mode
Help -> [Widget Name
helpDialog, Widget Name
maincontent]
      Mode
_    -> [Widget Name
maincontent]
      where
        UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts} = UIOpts
uopts
        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
          Context Name
c <- forall n. RenderM n (Context n)
getContext
          let
            availwidth :: Int
availwidth =
              -- ltrace "availwidth" $
              Context Name
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
              forall a. Num a => a -> a -> a
- Int
2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
            displayitems :: Vector AccountsScreenItem
displayitems = AccountsScreenState
ass forall s a. s -> Getting a s a -> a
^. Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL

            acctwidths :: Vector Int
acctwidths = forall a b. (a -> b) -> Vector a -> Vector b
V.map (\AccountsScreenItem{Int
Maybe MixedAmount
AccountName
asItemMixedAmount :: AccountsScreenItem -> Maybe MixedAmount
asItemDisplayAccountName :: AccountsScreenItem -> AccountName
asItemAccountName :: AccountsScreenItem -> AccountName
asItemIndentLevel :: AccountsScreenItem -> Int
asItemMixedAmount :: Maybe MixedAmount
asItemDisplayAccountName :: AccountName
asItemAccountName :: AccountName
asItemIndentLevel :: Int
..} -> Int
asItemIndentLevel forall a. Num a => a -> a -> a
+ forall a. HasChars a => a -> Int
realLength AccountName
asItemDisplayAccountName) Vector AccountsScreenItem
displayitems
            balwidths :: Vector Int
balwidths  = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (WideBuilder -> Int
wbWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountsScreenItem -> Maybe MixedAmount
asItemMixedAmount) Vector AccountsScreenItem
displayitems
            preferredacctwidth :: Int
preferredacctwidth = forall a. Ord a => Vector a -> a
V.maximum Vector Int
acctwidths
            totalacctwidthseen :: Int
totalacctwidthseen = forall a. Num a => Vector a -> a
V.sum Vector Int
acctwidths
            preferredbalwidth :: Int
preferredbalwidth  = forall a. Ord a => Vector a -> a
V.maximum Vector Int
balwidths
            totalbalwidthseen :: Int
totalbalwidthseen  = forall a. Num a => Vector a -> a
V.sum Vector Int
balwidths

            totalwidthseen :: Int
totalwidthseen = Int
totalacctwidthseen forall a. Num a => a -> a -> a
+ Int
totalbalwidthseen
            shortfall :: Int
shortfall = Int
preferredacctwidth forall a. Num a => a -> a -> a
+ Int
preferredbalwidth forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
- Int
availwidth
            acctwidthproportion :: Double
acctwidthproportion = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalacctwidthseen forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalwidthseen
            adjustedacctwidth :: Int
adjustedacctwidth = forall a. Ord a => a -> a -> a
min Int
preferredacctwidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max Int
15 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
acctwidthproportion forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
availwidth forall a. Num a => a -> a -> a
- Int
2)  -- leave 2 whitespace for padding
            adjustedbalwidth :: Int
adjustedbalwidth  = Int
availwidth forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
adjustedacctwidth

            -- XXX how to minimise the balance column's jumping around as you change the depth limit ?

            colwidths :: (Int, Int)
colwidths | Int
shortfall forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int
preferredacctwidth, Int
preferredbalwidth)
                      | Bool
otherwise      = (Int
adjustedacctwidth, Int
adjustedbalwidth)

          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 Widget Name
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 ((Int, Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (Int, Int)
colwidths) Bool
True (AccountsScreenState
ass forall s a. s -> Getting a s a -> a
^. Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList)

          where
            ishistorical :: Bool
ishistorical = ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
Historical

            toplabel :: Widget Name
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
<+> forall {n}. Widget n
toggles
              forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (String
" " forall a. [a] -> [a] -> [a]
++ String
scrname)
              forall n. Widget n -> Widget n -> Widget n
<+> String -> Period -> Widget Name
borderPeriodStr (if Bool
ishistorical then String
"at end of" else String
"in") (ReportOpts -> Period
period_ ReportOpts
ropts)
              forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
borderQueryStr (AccountName -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> AccountName
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
textQuoteIfNeeded forall a b. (a -> b) -> a -> b
$ ReportOpts -> [AccountName]
querystring_ ReportOpts
ropts)
              forall n. Widget n -> Widget n -> Widget n
<+> Maybe Int -> Widget Name
borderDepthStr Maybe Int
mdepth
              forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str (String
" ("forall a. [a] -> [a] -> [a]
++String
curidxforall a. [a] -> [a] -> [a]
++String
"/"forall a. [a] -> [a] -> [a]
++String
totidxforall a. [a] -> [a] -> [a]
++String
")")
              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)")
                toggles :: Widget n
toggles = 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 a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                  [String
""]
                  ,if ReportOpts -> Bool
empty_ ReportOpts
ropts then [] else [String
"nonzero"]
                  ,CliOpts -> [Status] -> [String]
uiShowStatus CliOpts
copts forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Status]
statuses_ ReportOpts
ropts
                  ,if ReportOpts -> Bool
real_ ReportOpts
ropts then [String
"real"] else []
                  ]
                mdepth :: Maybe Int
mdepth = ReportOpts -> Maybe Int
depth_ ReportOpts
ropts
                curidx :: String
curidx = case AccountsScreenState
ass forall s a. s -> Getting a s a -> a
^. Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
                          Maybe Int
Nothing -> String
"-"
                          Just Int
i -> forall a. Show a => a -> String
show (Int
i forall a. Num a => a -> a -> a
+ Int
1)
                totidx :: String
totidx = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
V.length Vector AccountsScreenItem
nonblanks
                  where
                    nonblanks :: Vector AccountsScreenItem
nonblanks = forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountsScreenItem -> AccountName
asItemAccountName) forall a b. (a -> b) -> a -> b
$ AccountsScreenState
ass forall s a. s -> Getting a s a -> a
^. Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL

            bottomlabel :: Widget Name
bottomlabel = case Mode
mode of
                            Minibuffer AccountName
label Editor String Name
ed -> AccountName -> Editor String Name -> Widget Name
minibuffer AccountName
label Editor String Name
ed
                            Mode
_                   -> Widget Name
quickhelp
              where
                quickhelp :: Widget Name
quickhelp = [(String, Widget Name)] -> Widget Name
borderKeysStr' [
                   (String
"LEFT", forall n. String -> Widget n
str String
"back")
                  -- ,("RIGHT", str "register")
                  ,(String
"t", Bool -> String -> String -> Widget Name
renderToggle (ReportOpts -> Bool
tree_ ReportOpts
ropts) String
"list" String
"tree")
                  -- ,("t", str "tree")
                  -- ,("l", str "list")
                  ,(String
"-+", forall n. String -> Widget n
str String
"depth")
                  ,case Screen
scr of
                    BS AccountsScreenState
_ -> (String
"", forall n. String -> Widget n
str String
"")
                    IS AccountsScreenState
_ -> (String
"", forall n. String -> Widget n
str String
"")
                    Screen
_    -> (String
"H", Bool -> String -> String -> Widget Name
renderToggle (Bool -> Bool
not Bool
ishistorical) String
"end-bals" String
"changes")
                  ,(String
"F", Bool -> String -> Widget Name
renderToggle1 (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> Maybe DateSpan
forecast_ forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts) String
"forecast")
                  --,("/", "filter")
                  --,("DEL", "unfilter")
                  --,("ESC", "cancel/top")
                  -- ,("a", str "add")
                  -- ,("g", "reload")
                  ,(String
"?", forall n. String -> Widget n
str String
"help")
                  -- ,("q", str "quit")
                  ]

asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem :: (Int, Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (Int
acctwidth, Int
balwidth) Bool
selected AccountsScreenItem{Int
Maybe MixedAmount
AccountName
asItemMixedAmount :: Maybe MixedAmount
asItemDisplayAccountName :: AccountName
asItemAccountName :: AccountName
asItemIndentLevel :: Int
asItemMixedAmount :: AccountsScreenItem -> Maybe MixedAmount
asItemDisplayAccountName :: AccountsScreenItem -> AccountName
asItemAccountName :: AccountsScreenItem -> AccountName
asItemIndentLevel :: AccountsScreenItem -> Int
..} =
  forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
    -- c <- getContext
      -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
    forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$
      forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
acctwidth) (forall a. a -> Maybe a
Just Int
acctwidth) Bool
True Bool
True forall a b. (a -> b) -> a -> b
$ Int -> AccountName -> AccountName
T.replicate (Int
asItemIndentLevel) AccountName
" " forall a. Semigroup a => a -> a -> a
<> AccountName
asItemDisplayAccountName) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
balspace forall n. Widget n -> Widget n -> Widget n
<+>
      WideBuilder -> Widget Name
splitAmounts WideBuilder
balBuilder
      where
        balBuilder :: WideBuilder
balBuilder = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty MixedAmount -> WideBuilder
showamt Maybe MixedAmount
asItemMixedAmount
        showamt :: MixedAmount -> WideBuilder
showamt = AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedAmountB AmountDisplayOpts
oneLine{displayMinWidth :: Maybe Int
displayMinWidth=forall a. a -> Maybe a
Just Int
balwidth, displayMaxWidth :: Maybe Int
displayMaxWidth=forall a. a -> Maybe a
Just Int
balwidth}
        balspace :: AccountName
balspace = Int -> AccountName -> AccountName
T.replicate (Int
2 forall a. Num a => a -> a -> a
+ Int
balwidth forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
balBuilder) AccountName
" "
        splitAmounts :: WideBuilder -> Widget Name
splitAmounts = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall n. Widget n -> Widget n -> Widget n
(<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall n. String -> Widget n
str String
", ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map AccountName -> Widget Name
renderamt forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName -> [AccountName]
T.splitOn AccountName
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> AccountName
wbToText
        renderamt :: T.Text -> Widget Name
        renderamt :: AccountName -> Widget Name
renderamt AccountName
a | (Char -> Bool) -> AccountName -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'-') AccountName
a = forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName -> AttrName
sel forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative") forall a b. (a -> b) -> a -> b
$ forall n. AccountName -> Widget n
txt AccountName
a
                    | Bool
otherwise       = forall n. AttrName -> Widget n -> Widget n
withAttr (AttrName -> AttrName
sel forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive") forall a b. (a -> b) -> a -> b
$ forall n. AccountName -> Widget n
txt AccountName
a
        sel :: AttrName -> AttrName
sel | Bool
selected  = (forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected")
            | Bool
otherwise = forall a. a -> a
id

-- | Handle events on any accounts-like screen (all accounts, balance sheet, income statement..).
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle BrickEvent Name AppEvent
ev = do
  forall s. String -> EventM Name s ()
dbguiEv String
"asHandle"
  ui0 :: UIState
ui0@UIState{aScreen :: UIState -> Screen
aScreen=Screen
scr, aMode :: UIState -> Mode
aMode=Mode
mode} <- EventM Name UIState UIState
get'
  case Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen Screen
scr of
    Maybe AccountsLikeScreen
Nothing -> forall a. String -> a -> a
dbgui String
"asHandle" forall a b. (a -> b) -> a -> b
$ forall a. String -> a
errorWrongScreenType String
"event handler"  -- PARTIAL:
    Just als :: AccountsLikeScreen
als@(ALS AccountsScreenState -> Screen
scons AccountsScreenState
ass) -> do
      -- save the currently selected account, in case we leave this screen and lose the selection
      UIState -> EventM Name UIState ()
put' UIState
ui0{aScreen :: Screen
aScreen=AccountsScreenState -> Screen
scons AccountsScreenState
ass{_assSelectedAccount :: AccountName
_assSelectedAccount=AccountsScreenState -> AccountName
asSelectedAccount AccountsScreenState
ass}}
      case Mode
mode of
        Mode
Normal          -> AccountsLikeScreen
-> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode AccountsLikeScreen
als BrickEvent Name AppEvent
ev
        Minibuffer AccountName
_ Editor String Name
ed -> forall {n} {e}.
Editor String Name -> BrickEvent n e -> EventM Name UIState ()
handleMinibufferMode Editor String Name
ed BrickEvent Name AppEvent
ev
        Mode
Help            -> BrickEvent Name AppEvent -> EventM Name UIState ()
handleHelpMode BrickEvent Name AppEvent
ev

-- | Handle events when in normal mode on any accounts-like screen.
-- The provided AccountsLikeScreen should correspond to the ui state's current screen.
asHandleNormalMode :: AccountsLikeScreen -> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode :: AccountsLikeScreen
-> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode (ALS AccountsScreenState -> Screen
scons AccountsScreenState
ass) BrickEvent Name AppEvent
ev = do
  forall s. String -> EventM Name s ()
dbguiEv String
"asHandleNormalMode"

  ui :: UIState
ui@UIState{aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}, ajournal :: UIState -> Journal
ajournal=Journal
j} <- EventM Name UIState UIState
get'
  Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
  let
    l :: GenericList Name Vector AccountsScreenItem
l = AccountsScreenState -> GenericList Name Vector AccountsScreenItem
_assList AccountsScreenState
ass
    selacct :: AccountName
selacct = AccountsScreenState -> AccountName
asSelectedAccount AccountsScreenState
ass
    centerSelection :: EventM Name UIState ()
centerSelection = forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector AccountsScreenItem
l
    clickedAcctAt :: Int -> Maybe AccountName
clickedAcctAt Int
y =
      case AccountsScreenItem -> AccountName
asItemAccountName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList Name Vector AccountsScreenItem
l forall a. Vector a -> Int -> Maybe a
!? Int
y of
        Just AccountName
t | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ AccountName -> Bool
T.null AccountName
t -> forall a. a -> Maybe a
Just AccountName
t
        Maybe AccountName
_ -> forall a. Maybe a
Nothing
    nonblanks :: Vector AccountsScreenItem
nonblanks = forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountsScreenItem -> AccountName
asItemAccountName) forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList Name Vector AccountsScreenItem
l
    lastnonblankidx :: Int
lastnonblankidx = forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector AccountsScreenItem
nonblanks forall a. Num a => a -> a -> a
- Int
1)
    journalspan :: DateSpan
journalspan = Bool -> Journal -> DateSpan
journalDateSpan Bool
False Journal
j

  case BrickEvent Name AppEvent
ev of

    VtyEvent (EvKey (KChar Char
'q') []) -> forall n s. EventM n s ()
halt                               -- q: quit
    VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui                    -- C-z: suspend
    VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
centerSelection forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n s. EventM n s ()
redraw     -- C-l: redraw
    VtyEvent (EvKey Key
KEsc        []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Day -> UIState -> UIState
resetScreens Day
d)           -- ESC: reset
    VtyEvent (EvKey (KChar Char
c)   []) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Mode -> UIState -> UIState
setMode Mode
Help)  -- ?: enter help mode

    -- AppEvents come from the system, in --watch mode.
    -- XXX currently they are handled only in Normal mode
    -- XXX be sure we don't leave unconsumed app events piling up
    -- A data file has changed (or the user has pressed g): reload.
    BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange, forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') [])] ->
      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'

    -- The date has changed (and we are viewing a standard period which contained the old date):
    -- adjust the viewed period and regenerate, just in case needed.
    -- (Eg: when watching data for "today" and the time has just passed midnight.)
    AppEvent (DateChange Day
old Day
_) | Period -> Bool
isStandardPeriod Period
p Bool -> Bool -> Bool
&& Period
p Period -> Day -> Bool
`periodContainsDate` Day
old ->
      (UIState -> UIState) -> EventM Name UIState ()
modify' (Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
      where p :: Period
p = UIState -> Period
reportPeriod UIState
ui

    -- set or reset a filter:
    VtyEvent (EvKey (KChar Char
'/') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"filter" forall a. Maybe a
Nothing forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey Key
k           []) | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KBS, Key
KDel] -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
resetFilter forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)

    -- run external programs:
    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

    -- adjust the period displayed:
    VtyEvent (EvKey (KChar Char
'T') []) ->       (UIState -> UIState) -> EventM Name UIState ()
modify' (Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d)    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (Key
KDown)     [Modifier
MShift]) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Day -> UIState -> UIState
shrinkReportPeriod Day
d             forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (Key
KUp)       [Modifier
MShift]) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Day -> UIState -> UIState
growReportPeriod Day
d               forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (Key
KRight)    [Modifier
MShift]) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (DateSpan -> UIState -> UIState
nextReportPeriod DateSpan
journalspan     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (Key
KLeft)     [Modifier
MShift]) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (DateSpan -> UIState -> UIState
previousReportPeriod DateSpan
journalspan forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)

    -- various toggles and settings:
    VtyEvent (EvKey (KChar Char
'I') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleIgnoreBalanceAssertions forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d)
    VtyEvent (EvKey (KChar Char
'F') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Day -> UIState -> UIState
toggleForecast Day
d   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'B') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleConversionOp forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'V') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleValue        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'0') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
0)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'1') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
1)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'2') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
2)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'3') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
3)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'4') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
4)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'5') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
5)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'6') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
6)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'7') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
7)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'8') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
8)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
'9') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (Maybe Int -> UIState -> UIState
setDepth (forall a. a -> Maybe a
Just Int
9)  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
c) []) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'-',Char
'_'] -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
decDepth forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey (KChar Char
c) []) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+',Char
'='] -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
incDepth forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    -- toggles after which the selection should be recentered:
    VtyEvent (EvKey (KChar Char
'H') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleHistorical   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection  -- harmless on BS/IS screens
    VtyEvent (EvKey (KChar Char
't') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleTree         forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection
    VtyEvent (EvKey (KChar Char
'R') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleReal         forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection
    VtyEvent (EvKey (KChar Char
'U') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleUnmarked     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection
    VtyEvent (EvKey (KChar Char
'P') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
togglePending      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection
    VtyEvent (EvKey (KChar Char
'C') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleCleared      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection
    VtyEvent (EvKey (KChar Char
c) []) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'z',Char
'Z'] -> (UIState -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
toggleEmpty forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
centerSelection  -- back compat: accept Z as well as z

    -- LEFT key or a click in the app's left margin: exit to the parent screen.
    VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveLeftEvents  -> (UIState -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
popScreen
    VtyEvent (EvMouseUp Int
0 Int
_ (Just Button
BLeft)) -> (UIState -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
popScreen  -- this mouse click is a VtyEvent since not in a clickable widget

    -- RIGHT key or MouseUp on an account: enter the register screen for the selected account
    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, AccountsScreenItem) -> Bool
isBlankItem 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 AccountsScreenItem
l -> Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
selacct UIState
ui
    MouseUp Name
_n (Just Button
BLeft) Location{loc :: Location -> (Int, Int)
loc=(Int
_,Int
y)} | Just AccountName
clkacct <- Int -> Maybe AccountName
clickedAcctAt Int
y    -> Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
clkacct UIState
ui

    -- MouseDown: this is not debounced and can repeat (https://github.com/jtdaugherty/brick/issues/347)
    -- so we only let it do something harmless: move the selection.
    MouseDown Name
_n Button
BLeft [Modifier]
_mods Location{loc :: Location -> (Int, Int)
loc=(Int
_,Int
y)} | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall {a}. Maybe (a, AccountsScreenItem) -> Bool
isBlankItem Maybe (Integer, AccountsScreenItem)
clickeditem ->
      UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=AccountsScreenState -> Screen
scons AccountsScreenState
ass'}
      where
        clickeditem :: Maybe (Integer, AccountsScreenItem)
clickeditem = (Integer
0,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList Name Vector AccountsScreenItem
l forall a. Vector a -> Int -> Maybe a
!? Int
y
        ass' :: AccountsScreenState
ass' = AccountsScreenState
ass{_assList :: GenericList Name Vector AccountsScreenItem
_assList=forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
y GenericList Name Vector AccountsScreenItem
l}

    -- Mouse scroll wheel: scroll up or down to the 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 AccountsScreenItem
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l 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 AccountsScreenItem -> Int
asListSize GenericList Name Vector AccountsScreenItem
l) Int
scrollamt
      UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=AccountsScreenState -> Screen
scons AccountsScreenState
ass{_assList :: GenericList Name Vector AccountsScreenItem
_assList=GenericList Name Vector AccountsScreenItem
l'}}

    -- PGDOWN/END keys: handle with List's default handler, but restrict the selection to stop
    -- (and center) at the last non-blank item.
    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 AccountsScreenItem
l1 <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l 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, AccountsScreenItem) -> Bool
isBlankItem 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 AccountsScreenItem
l1
      then do
        let l2 :: GenericList Name Vector AccountsScreenItem
l2 = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
lastnonblankidx GenericList Name Vector AccountsScreenItem
l1
        forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector AccountsScreenItem
l2
        UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=AccountsScreenState -> Screen
scons AccountsScreenState
ass{_assList :: GenericList Name Vector AccountsScreenItem
_assList=GenericList Name Vector AccountsScreenItem
l2}}
      else
        UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=AccountsScreenState -> Screen
scons AccountsScreenState
ass{_assList :: GenericList Name Vector AccountsScreenItem
_assList=GenericList Name Vector AccountsScreenItem
l1}}

    -- DOWN key when selection is at the last item: scroll 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, AccountsScreenItem) -> Bool
isBlankItem Maybe (Int, AccountsScreenItem)
mnextelement -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ GenericList Name Vector AccountsScreenItem
lforall 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, AccountsScreenItem)
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 GenericList Name Vector AccountsScreenItem
l

    -- Any other vty event (UP, DOWN, PGUP etc): handle with List's default handler.
    VtyEvent Event
e -> do
      GenericList Name Vector AccountsScreenItem
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l 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=AccountsScreenState -> Screen
scons forall a b. (a -> b) -> a -> b
$ AccountsScreenState
ass forall a b. a -> (a -> b) -> b
& Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList forall s t a b. ASetter s t a b -> b -> s -> t
.~ GenericList Name Vector AccountsScreenItem
l' forall a b. a -> (a -> b) -> b
& Lens' AccountsScreenState AccountName
assSelectedAccount forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountName
selacct}

    -- Any other mouse/app event: ignore
    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 ()

-- | Handle events when in minibuffer mode on any screen.
handleMinibufferMode :: Editor String Name -> BrickEvent n e -> EventM Name UIState ()
handleMinibufferMode Editor String Name
ed BrickEvent n e
ev = do
  ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j} <- EventM Name UIState UIState
get'
  Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
  case BrickEvent n e
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 UIState
ui'
      where
        ui' :: UIState
ui' = String -> UIState -> Either String UIState
setFilter String
s (UIState -> UIState
closeMinibuffer UIState
ui)
          forall a b. a -> (a -> b) -> b
& forall b a. b -> Either a b -> b
fromRight (AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"Cannot compile regular expression" (forall a. a -> Maybe a
Just String
s) 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 n s. EventM n 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=AccountName -> Editor String Name -> Mode
Minibuffer AccountName
"filter" Editor String Name
ed'}
    AppEvent e
_  -> 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 ()

-- | Handle events when in help mode on any screen.
handleHelpMode :: BrickEvent Name AppEvent -> EventM Name UIState ()
handleHelpMode BrickEvent Name AppEvent
ev = do
  UIState
ui <- EventM Name UIState UIState
get'
  case BrickEvent Name AppEvent
ev of
    -- VtyEvent (EvKey (KChar 'q') []) -> halt
    VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall n s. EventM n 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

enterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
acct 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
"enterRegisterScreen"
  let
    regscr :: Screen
regscr = UIOpts -> Day -> Journal -> AccountName -> Bool -> Screen
rsNew UIOpts
uopts Day
d Journal
j AccountName
acct Bool
isdepthclipped
      where
        isdepthclipped :: Bool
isdepthclipped = case UIState -> Maybe Int
getDepth UIState
ui of
                          Just Int
de -> AccountName -> Int
accountNameLevel AccountName
acct forall a. Ord a => a -> a -> Bool
>= Int
de
                          Maybe Int
Nothing -> Bool
False
    ui1 :: UIState
ui1 = Screen -> UIState -> UIState
pushScreen Screen
regscr UIState
ui
  UIState -> EventM Name UIState UIState
rsCenterSelection UIState
ui1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'

-- | From any accounts screen's state, get the account name from the 
-- currently selected list item, or otherwise the last known selected account name.
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount AccountsScreenState
ass =
  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
$ AccountsScreenState -> GenericList Name Vector AccountsScreenItem
_assList AccountsScreenState
ass of
    Just (Int
_, AccountsScreenItem{Int
Maybe MixedAmount
AccountName
asItemMixedAmount :: Maybe MixedAmount
asItemDisplayAccountName :: AccountName
asItemAccountName :: AccountName
asItemIndentLevel :: Int
asItemMixedAmount :: AccountsScreenItem -> Maybe MixedAmount
asItemDisplayAccountName :: AccountsScreenItem -> AccountName
asItemAccountName :: AccountsScreenItem -> AccountName
asItemIndentLevel :: AccountsScreenItem -> Int
..}) -> AccountName
asItemAccountName
    Maybe (Int, AccountsScreenItem)
Nothing -> AccountsScreenState
ass forall s a. s -> Getting a s a -> a
^. Lens' AccountsScreenState AccountName
assSelectedAccount

-- | Set the selected account on any of the accounts screens. Has no effect on other screens.
-- Sets the high-level property _assSelectedAccount and also selects the corresponding or
-- best alternative item in the list widget (_assList).
asSetSelectedAccount :: AccountName -> Screen -> Screen
asSetSelectedAccount :: AccountName -> Screen -> Screen
asSetSelectedAccount AccountName
acct Screen
scr =
  case Screen
scr of
    (AS AccountsScreenState
ass) -> AccountsScreenState -> Screen
AS forall a b. (a -> b) -> a -> b
$ AccountName -> AccountsScreenState -> AccountsScreenState
assSetSelectedAccount AccountName
acct AccountsScreenState
ass
    (BS AccountsScreenState
ass) -> AccountsScreenState -> Screen
BS forall a b. (a -> b) -> a -> b
$ AccountName -> AccountsScreenState -> AccountsScreenState
assSetSelectedAccount AccountName
acct AccountsScreenState
ass
    (IS AccountsScreenState
ass) -> AccountsScreenState -> Screen
IS forall a b. (a -> b) -> a -> b
$ AccountName -> AccountsScreenState -> AccountsScreenState
assSetSelectedAccount AccountName
acct AccountsScreenState
ass
    Screen
_        -> Screen
scr
    where
      assSetSelectedAccount :: AccountName -> AccountsScreenState -> AccountsScreenState
assSetSelectedAccount AccountName
a ass :: AccountsScreenState
ass@ASS{_assList :: AccountsScreenState -> GenericList Name Vector AccountsScreenItem
_assList=GenericList Name Vector AccountsScreenItem
l} =
        AccountsScreenState
ass{_assSelectedAccount :: AccountName
_assSelectedAccount=AccountName
a, _assList :: GenericList Name Vector AccountsScreenItem
_assList=forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
selidx GenericList Name Vector AccountsScreenItem
l}
        where
          -- which list item should be selected ?
          selidx :: Int
selidx = forall a. a -> [a] -> a
headDef Int
0 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
            forall a. Eq a => a -> [a] -> Maybe Int
elemIndex AccountName
a [AccountName]
as                                -- the specified account, if it can be found
            ,forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (AccountName
a AccountName -> AccountName -> Bool
`isAccountNamePrefixOf`) [AccountName]
as     -- or the first account found with the same prefix
            ,forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
< AccountName
a) [AccountName]
as) forall a. Num a => a -> a -> a
- Int
1)  -- otherwise, the alphabetically preceding account.
            ]
            where
              as :: [AccountName]
as = forall a b. (a -> b) -> [a] -> [b]
map AccountsScreenItem -> AccountName
asItemAccountName forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList Name Vector AccountsScreenItem
l

isBlankItem :: Maybe (a, AccountsScreenItem) -> Bool
isBlankItem Maybe (a, AccountsScreenItem)
mitem = ((AccountsScreenItem -> AccountName
asItemAccountName 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, AccountsScreenItem)
mitem) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AccountName
""

asListSize :: GenericList n Vector AccountsScreenItem -> Int
asListSize = 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
/=AccountName
"")forall b c a. (b -> c) -> (a -> b) -> a -> c
.AccountsScreenItem -> AccountName
asItemAccountName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t :: * -> *) e. GenericList n t e -> t e
listElements