-- The account register screen, showing transactions in an account, like hledger-web's register.

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module Hledger.UI.RegisterScreen
(rsNew
,rsUpdate
,rsDraw
,rsHandle
,rsSetAccount
,rsCenterSelection
)
where

import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Bifunctor (bimap, Bifunctor (second))
import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Brick
import Brick.Widgets.List hiding (reverse)
import Brick.Widgets.Edit
import Lens.Micro.Platform
import System.Console.ANSI

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.Editor
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)

rsDraw :: UIState -> [Widget Name]
rsDraw :: UIState -> [Widget Name]
rsDraw UIState{aopts :: UIState -> UIOpts
aopts=_uopts :: UIOpts
_uopts@UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec}}
              ,aScreen :: UIState -> Screen
aScreen=RS RSS{Bool
AccountName
List Name RegisterScreenItem
_rssList :: RegisterScreenState -> List Name RegisterScreenItem
_rssForceInclusive :: RegisterScreenState -> Bool
_rssAccount :: RegisterScreenState -> AccountName
_rssList :: List Name RegisterScreenItem
_rssForceInclusive :: Bool
_rssAccount :: AccountName
..}
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } = forall a. String -> a -> a
dbgui String
"rsDraw 1" forall a b. (a -> b) -> a -> b
$
  case Mode
mode of
    Mode
Help       -> [Widget Name
helpDialog, Widget Name
maincontent]
    Mode
_          -> [Widget Name
maincontent]
  where
    displayitems :: [RegisterScreenItem]
displayitems = 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 forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList
    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
      -- calculate column widths, based on current available width
      Context Name
c <- forall n. RenderM n (Context n)
getContext
      let
        totalwidth :: Int
totalwidth = 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)
        -- the date column is fixed width
        datewidth :: Int
datewidth = Int
10
        -- multi-commodity amounts rendered on one line can be
        -- arbitrarily wide.  Give the two amounts as much space as
        -- they need, while reserving a minimum of space for other
        -- columns and whitespace.  If they don't get all they need,
        -- allocate it to them proportionally to their maximum widths.
        whitespacewidth :: Int
whitespacewidth = Int
10 -- inter-column whitespace, fixed width
        minnonamtcolswidth :: Int
minnonamtcolswidth = Int
datewidth forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 -- date column plus at least 1 for status and 2 for desc and accts
        maxamtswidth :: Int
maxamtswidth = forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth forall a. Num a => a -> a -> a
- Int
minnonamtcolswidth forall a. Num a => a -> a -> a
- Int
whitespacewidth)
        maxchangewidthseen :: Int
maxchangewidthseen = forall a. Integral a => [a] -> a
maximum' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> WideBuilder
rsItemChangeAmount) [RegisterScreenItem]
displayitems
        maxbalwidthseen :: Int
maxbalwidthseen = forall a. Integral a => [a] -> a
maximum' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> WideBuilder
rsItemBalanceAmount) [RegisterScreenItem]
displayitems
        changewidthproportion :: Double
changewidthproportion = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxchangewidthseen forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxchangewidthseen forall a. Num a => a -> a -> a
+ Int
maxbalwidthseen)
        maxchangewidth :: Int
maxchangewidth = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
changewidthproportion forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
        maxbalwidth :: Int
maxbalwidth = Int
maxamtswidth forall a. Num a => a -> a -> a
- Int
maxchangewidth
        changewidth :: Int
changewidth = forall a. Ord a => a -> a -> a
min Int
maxchangewidth Int
maxchangewidthseen
        balwidth :: Int
balwidth = forall a. Ord a => a -> a -> a
min Int
maxbalwidth Int
maxbalwidthseen
        -- assign the remaining space to the description and accounts columns
        -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth
        maxdescacctswidth :: Int
maxdescacctswidth =
          -- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $
          forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth forall a. Num a => a -> a -> a
- Int
datewidth forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
changewidth forall a. Num a => a -> a -> a
- Int
balwidth forall a. Num a => a -> a -> a
- Int
whitespacewidth)
        -- allocating proportionally.
        -- descwidth' = maximum' $ map (strWidth . second6) displayitems
        -- acctswidth' = maximum' $ map (strWidth . third6) displayitems
        -- descwidthproportion = (descwidth' + acctswidth') / descwidth'
        -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion)
        -- maxacctswidth = maxdescacctswidth - maxdescwidth
        -- descwidth = min maxdescwidth descwidth'
        -- acctswidth = min maxacctswidth acctswidth'
        -- allocating equally.
        descwidth :: Int
descwidth = Int
maxdescacctswidth forall a. Integral a => a -> a -> a
`div` Int
2
        acctswidth :: Int
acctswidth = Int
maxdescacctswidth forall a. Num a => a -> a -> a
- Int
descwidth
        colwidths :: (Int, Int, Int, Int, Int)
colwidths = (Int
datewidth,Int
descwidth,Int
acctswidth,Int
changewidth,Int
balwidth)

      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, Int, Int, Int)
-> Bool -> RegisterScreenItem -> Widget Name
rsDrawItem (Int, Int, Int, Int, Int)
colwidths) Bool
True List Name RegisterScreenItem
_rssList

      where
        ropts :: ReportOpts
ropts = ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
        ishistorical :: Bool
ishistorical = ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
Historical
        -- inclusive = tree_ ropts || rsForceInclusive

        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
"bold") (forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ AccountName -> String
T.unpack forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"All" AccountName
_rssAccount)
--           <+> withAttr ("border" <> "query") (str $ if inclusive then "" else " exclusive")
          forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
togglefilters
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
" transactions"
          -- <+> str (if ishistorical then " historical total" else " period total")
          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)
          -- <+> str " and subs"
          forall n. Widget n -> Widget n -> Widget n
<+> String -> Period -> Widget Name
borderPeriodStr String
"in" (ReportOpts -> Period
period_ ReportOpts
ropts)
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
" ("
          forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
cur
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
"/"
          forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
total
          forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str 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
            togglefilters :: Widget n
togglefilters =
              case forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                   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 []
                  ,if ReportOpts -> Bool
empty_ ReportOpts
ropts then [] else [String
"nonzero"]
                  ] of
                [] -> forall n. String -> Widget n
str String
""
                [String]
fs -> 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 forall a b. (a -> b) -> a -> b
$ String
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
fs)
            cur :: Widget n
cur = forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ case forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name RegisterScreenItem
_rssList 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)
            total :: Widget n
total = forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector RegisterScreenItem
nonblanks
            nonblanks :: Vector RegisterScreenItem
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
. RegisterScreenItem -> AccountName
rsItemDate) forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList

            -- query = query_ $ reportopts_ $ cliopts_ opts

        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 "transaction")

              -- tree/list mode - rsForceInclusive may override, but use tree_ to ensure a visible toggle effect
              ,(String
"t", Bool -> String -> String -> Widget Name
renderToggle (ReportOpts -> Bool
tree_ ReportOpts
ropts) String
"list(-subs)" String
"tree(+subs)")
              -- ,("t", str "tree(+subs)")
              -- ,("l", str "list(-subs)")

              ,(String
"H", Bool -> String -> String -> Widget Name
renderToggle (Bool -> Bool
not Bool
ishistorical) String
"historical" String
"period")
              ,(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 b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> InputOpts
inputopts_ forall a b. (a -> b) -> a -> b
$ CliOpts
copts) String
"forecast")
              -- ,("a", "add")
              -- ,("g", "reload")
              ,(String
"?", forall n. String -> Widget n
str String
"help")
              -- ,("q", "quit")
              ]

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

rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget Name
rsDrawItem :: (Int, Int, Int, Int, Int)
-> Bool -> RegisterScreenItem -> Widget Name
rsDrawItem (Int
datewidth,Int
descwidth,Int
acctswidth,Int
changewidth,Int
balwidth) Bool
selected RegisterScreenItem{AccountName
Transaction
Status
WideBuilder
rsItemTransaction :: RegisterScreenItem -> Transaction
rsItemOtherAccounts :: RegisterScreenItem -> AccountName
rsItemDescription :: RegisterScreenItem -> AccountName
rsItemStatus :: RegisterScreenItem -> Status
rsItemTransaction :: Transaction
rsItemBalanceAmount :: WideBuilder
rsItemChangeAmount :: WideBuilder
rsItemOtherAccounts :: AccountName
rsItemDescription :: AccountName
rsItemStatus :: Status
rsItemDate :: AccountName
rsItemDate :: RegisterScreenItem -> AccountName
rsItemBalanceAmount :: RegisterScreenItem -> WideBuilder
rsItemChangeAmount :: RegisterScreenItem -> WideBuilder
..} =
  forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
    forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$
      forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
datewidth) (forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True AccountName
rsItemDate) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
" " forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
1) (forall a. a -> Maybe a
Just Int
1) Bool
True Bool
True (String -> AccountName
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Status
rsItemStatus)) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
" " forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
descwidth) (forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True AccountName
rsItemDescription) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
"  " forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
acctswidth) (forall a. a -> Maybe a
Just Int
acctswidth) Bool
True Bool
True AccountName
rsItemOtherAccounts) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
"   " forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
changeattr (forall n. AccountName -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
changewidth) (forall a. a -> Maybe a
Just Int
changewidth) Bool
True Bool
False AccountName
changeAmt) forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AccountName -> Widget n
txt AccountName
"   " forall n. Widget n -> Widget n -> Widget n
<+>
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
balattr (forall n. AccountName -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (forall a. a -> Maybe a
Just Int
balwidth) (forall a. a -> Maybe a
Just Int
balwidth) Bool
True Bool
False AccountName
balanceAmt)
  where
    changeAmt :: AccountName
changeAmt  = WideBuilder -> AccountName
wbToText WideBuilder
rsItemChangeAmount
    balanceAmt :: AccountName
balanceAmt = WideBuilder -> AccountName
wbToText WideBuilder
rsItemBalanceAmount
    changeattr :: AttrName
changeattr | (Char -> Bool) -> AccountName -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'-') AccountName
changeAmt  = 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
"amount" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease"
               | Bool
otherwise                = 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
"amount" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"increase"
    balattr :: AttrName
balattr    | (Char -> Bool) -> AccountName -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'-') AccountName
balanceAmt = 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"
               | Bool
otherwise                = 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"
    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

-- XXX clean up like asHandle
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle BrickEvent Name AppEvent
ev = do
  UIState
ui0 <- EventM Name UIState UIState
get'
  forall s. String -> EventM Name s ()
dbguiEv String
"rsHandle 1"
  case UIState
ui0 of
    ui :: UIState
ui@UIState{
      aScreen :: UIState -> Screen
aScreen=RS sst :: RegisterScreenState
sst@RSS{Bool
AccountName
List Name RegisterScreenItem
_rssList :: List Name RegisterScreenItem
_rssForceInclusive :: Bool
_rssAccount :: AccountName
_rssList :: RegisterScreenState -> List Name RegisterScreenItem
_rssForceInclusive :: RegisterScreenState -> Bool
_rssAccount :: RegisterScreenState -> AccountName
..}
      ,aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
      ,ajournal :: UIState -> Journal
ajournal=Journal
j
      ,aMode :: UIState -> Mode
aMode=Mode
mode
      } -> do
      Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
      let
        journalspan :: DateSpan
journalspan = Bool -> Journal -> DateSpan
journalDateSpan Bool
False Journal
j
        nonblanks :: Vector RegisterScreenItem
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
. RegisterScreenItem -> AccountName
rsItemDate) forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList
        lastnonblankidx :: Int
lastnonblankidx = forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector RegisterScreenItem
nonblanks forall a. Num a => a -> a -> a
- Int
1)
        numberedtxns :: [(Integer, Transaction)]
numberedtxns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second RegisterScreenItem -> Transaction
rsItemTransaction)) [(Integer
1::Integer)..] (forall a. Vector a -> [a]
V.toList Vector RegisterScreenItem
nonblanks)
        -- the transactions being shown and the currently selected or last transaction, if any:
        mtxns :: Maybe ([NumberedTransaction], NumberedTransaction)
        mtxns :: Maybe ([(Integer, Transaction)], (Integer, Transaction))
mtxns = case [(Integer, Transaction)]
numberedtxns of
          []        -> forall a. Maybe a
Nothing
          nts :: [(Integer, Transaction)]
nts@((Integer, Transaction)
_:[(Integer, Transaction)]
_) -> forall a. a -> Maybe a
Just ([(Integer, Transaction)]
nts, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> a
last [(Integer, Transaction)]
nts) (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((forall a. Num a => a -> a -> a
+Integer
1)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (Integral a, Num b) => a -> b
fromIntegral) RegisterScreenItem -> Transaction
rsItemTransaction) 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 List Name RegisterScreenItem
_rssList)  -- PARTIAL: last won't fail
      case Mode
mode of
        Minibuffer AccountName
_ Editor String Name
ed ->
          case BrickEvent Name AppEvent
ev of
            VtyEvent (EvKey Key
KEsc   []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
closeMinibuffer
            VtyEvent (EvKey Key
KEnter []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$
                case String -> UIState -> Either String UIState
setFilter String
s forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui of
                  Left String
bad -> AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"Cannot compile regular expression" (forall a. a -> Maybe a
Just String
bad) UIState
ui
                  Right UIState
ui' -> UIState
ui'
              where s :: String
s = String -> String
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            VtyEvent Event
e -> do
              Editor String Name
ed' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Editor String Name
ed forall a b. (a -> b) -> a -> b
$ forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
              UIState -> EventM Name UIState ()
put' UIState
ui{aMode :: Mode
aMode=AccountName -> Editor String Name -> Mode
Minibuffer AccountName
"filter" Editor String Name
ed'}
            AppEvent AppEvent
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseDown{} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseUp{}   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

        Mode
Normal ->
          case BrickEvent Name AppEvent
ev of
            VtyEvent (EvKey (KChar Char
'q') []) -> forall a s. EventM a s ()
halt
            VtyEvent (EvKey Key
KEsc        []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
            VtyEvent (EvKey (KChar Char
c)   []) | Char
c forall a. Eq a => a -> a -> Bool
== Char
'?' -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Mode -> UIState -> UIState
setMode Mode
Help UIState
ui

            -- AppEvents arrive in --watch mode, see AccountsScreen
            AppEvent (DateChange Day
old Day
_) | Period -> Bool
isStandardPeriod Period
p Bool -> Bool -> Bool
&& Period
p Period -> Day -> Bool
`periodContainsDate` Day
old ->
              UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
              where
                p :: Period
p = UIState -> Period
reportPeriod UIState
ui

            BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall n e. 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'

            VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
            VtyEvent (EvKey (KChar Char
'a') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'A') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'T') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
            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
pos String
f) 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
              where
                (Maybe TextPosition
pos,String
f) = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List Name RegisterScreenItem
_rssList of
                            Maybe (Int, RegisterScreenItem)
Nothing -> (Maybe TextPosition
endPosition, Journal -> String
journalFilePath Journal
j)
                            Just (Int
_, RegisterScreenItem{
                              rsItemTransaction :: RegisterScreenItem -> Transaction
rsItemTransaction=Transaction{tsourcepos :: Transaction -> (SourcePos, SourcePos)
tsourcepos=(SourcePos String
f' Pos
l Pos
c,SourcePos
_)}}) -> (forall a. a -> Maybe a
Just (Pos -> Int
unPos Pos
l, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos Pos
c),String
f')

            -- display mode/query toggles
            VtyEvent (EvKey (KChar Char
'B') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleConversionOp UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'V') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleValue UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'H') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleHistorical UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
't') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleTree UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
c) []) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'z',Char
'Z'] -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleEmpty UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'R') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleReal UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'U') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleUnmarked UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'P') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
togglePending UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'C') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleCleared UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'F') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
toggleForecast Day
d UIState
ui) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'

            VtyEvent (EvKey (KChar Char
'/') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"filter" forall a. Maybe a
Nothing UIState
ui
            VtyEvent (EvKey (Key
KDown)     [Modifier
MShift]) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
shrinkReportPeriod Day
d UIState
ui
            VtyEvent (EvKey (Key
KUp)       [Modifier
MShift]) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
growReportPeriod Day
d UIState
ui
            VtyEvent (EvKey (Key
KRight)    [Modifier
MShift]) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ DateSpan -> UIState -> UIState
nextReportPeriod DateSpan
journalspan UIState
ui
            VtyEvent (EvKey (Key
KLeft)     [Modifier
MShift]) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ DateSpan -> UIState -> UIState
previousReportPeriod DateSpan
journalspan UIState
ui
            VtyEvent (EvKey Key
k           []) | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KBS, Key
KDel] -> (UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d forall a b. (a -> b) -> a -> b
$ UIState -> UIState
resetFilter UIState
ui)
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle List Name RegisterScreenItem
_rssList forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui

            -- exit screen on LEFT
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveLeftEvents  -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ UIState -> UIState
popScreen UIState
ui
            -- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget.
            VtyEvent (EvMouseUp Int
x Int
_y (Just Button
BLeft)) | Int
xforall a. Eq a => a -> a -> Bool
==Int
0 -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ UIState -> UIState
popScreen UIState
ui

            -- enter transaction screen on RIGHT
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents ->
              case Maybe ([(Integer, Transaction)], (Integer, Transaction))
mtxns of Maybe ([(Integer, Transaction)], (Integer, Transaction))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (); Just ([(Integer, Transaction)]
nts, (Integer, Transaction)
nt) -> AccountName
-> [(Integer, Transaction)]
-> (Integer, Transaction)
-> UIState
-> EventM Name UIState ()
rsEnterTransactionScreen AccountName
_rssAccount [(Integer, Transaction)]
nts (Integer, Transaction)
nt UIState
ui
            -- or on transaction click
            -- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
            -- just use it to move the selection
            MouseDown Name
_n Button
BLeft [Modifier]
_mods Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> a -> Bool
==AccountName
"") AccountName
clickeddate -> do
              UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ UIState
ui{aScreen :: Screen
aScreen=RegisterScreenState -> Screen
RS RegisterScreenState
sst{_rssList :: List Name RegisterScreenItem
_rssList=forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
y List Name RegisterScreenItem
_rssList}}
              where clickeddate :: AccountName
clickeddate = forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" RegisterScreenItem -> AccountName
rsItemDate forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements List Name RegisterScreenItem
_rssList forall a. Vector a -> Int -> Maybe a
!? Int
y
            -- and on MouseUp, enter the subscreen
            MouseUp Name
_n (Just Button
BLeft) Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> a -> Bool
==AccountName
"") AccountName
clickeddate -> do
              case Maybe ([(Integer, Transaction)], (Integer, Transaction))
mtxns of Maybe ([(Integer, Transaction)], (Integer, Transaction))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (); Just ([(Integer, Transaction)]
nts, (Integer, Transaction)
nt) -> AccountName
-> [(Integer, Transaction)]
-> (Integer, Transaction)
-> UIState
-> EventM Name UIState ()
rsEnterTransactionScreen AccountName
_rssAccount [(Integer, Transaction)]
nts (Integer, Transaction)
nt UIState
ui
              where clickeddate :: AccountName
clickeddate = forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" RegisterScreenItem -> AccountName
rsItemDate forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements List Name RegisterScreenItem
_rssList forall a. Vector a -> Int -> Maybe a
!? Int
y

            -- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
            VtyEvent Event
e | Event
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents, forall {a}. Maybe (a, RegisterScreenItem) -> Bool
isBlankElement Maybe (Int, RegisterScreenItem)
mnextelement -> do
              forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> n
listName forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList) Int
1
              where mnextelement :: Maybe (Int, RegisterScreenItem)
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 List Name RegisterScreenItem
_rssList

            -- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
            -- pushing the selection when necessary.
            MouseDown Name
name Button
btn [Modifier]
_mods Location
_loc | Button
btn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
              let scrollamt :: Int
scrollamt = if Button
btnforall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
              List Name RegisterScreenItem
list' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name RegisterScreenItem
_rssList 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 RegisterScreenItem -> Int
rsListSize List Name RegisterScreenItem
_rssList) Int
scrollamt
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=RegisterScreenState -> Screen
RS RegisterScreenState
sst{_rssList :: List Name RegisterScreenItem
_rssList=List Name RegisterScreenItem
list'}}

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

            -- fall through to the list's event handler (handles other [pg]up/down events)
            VtyEvent Event
e -> do
              let e' :: Event
e' = Event -> Event
normaliseMovementKeys Event
e
              List Name RegisterScreenItem
newitems <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name RegisterScreenItem
_rssList 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'
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen :: Screen
aScreen=RegisterScreenState -> Screen
RS RegisterScreenState
sst{_rssList :: List Name RegisterScreenItem
_rssList=List Name RegisterScreenItem
newitems}}

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

    UIState
_ -> forall a. String -> a -> a
dbgui String
"rsHandle 2" forall a b. (a -> b) -> a -> b
$ forall a. String -> a
errorWrongScreenType String
"event handler"

isBlankElement :: Maybe (a, RegisterScreenItem) -> Bool
isBlankElement Maybe (a, RegisterScreenItem)
mel = ((RegisterScreenItem -> AccountName
rsItemDate 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, RegisterScreenItem)
mel) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AccountName
""

rsListSize :: GenericList n Vector RegisterScreenItem -> Int
rsListSize = 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
.RegisterScreenItem -> AccountName
rsItemDate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t :: * -> *) e. GenericList n t e -> t e
listElements

rsSetAccount :: AccountName -> Bool -> Screen -> Screen
rsSetAccount :: AccountName -> Bool -> Screen -> Screen
rsSetAccount AccountName
a Bool
forceinclusive (RS st :: RegisterScreenState
st@RSS{}) =
  RegisterScreenState -> Screen
RS RegisterScreenState
st{_rssAccount :: AccountName
_rssAccount=AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"*" AccountName
a, _rssForceInclusive :: Bool
_rssForceInclusive=Bool
forceinclusive}
rsSetAccount AccountName
_ Bool
_ Screen
st = Screen
st

-- | Scroll the selected item to the middle of the screen, when on the register screen.
-- No effect on other screens.
rsCenterSelection :: UIState -> EventM Name UIState UIState
rsCenterSelection :: UIState -> EventM Name UIState UIState
rsCenterSelection ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=RS RegisterScreenState
sst} = do
  forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle forall a b. (a -> b) -> a -> b
$ RegisterScreenState -> List Name RegisterScreenItem
_rssList RegisterScreenState
sst
  forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui  -- ui is unchanged, but this makes the function more chainable
rsCenterSelection UIState
ui = forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui

rsEnterTransactionScreen :: AccountName -> [NumberedTransaction] -> NumberedTransaction -> UIState -> EventM Name UIState ()
rsEnterTransactionScreen :: AccountName
-> [(Integer, Transaction)]
-> (Integer, Transaction)
-> UIState
-> EventM Name UIState ()
rsEnterTransactionScreen AccountName
acct [(Integer, Transaction)]
nts (Integer, Transaction)
nt UIState
ui = do
  forall s. String -> EventM Name s ()
dbguiEv String
"rsEnterTransactionScreen"
  UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$
    Screen -> UIState -> UIState
pushScreen (AccountName
-> [(Integer, Transaction)] -> (Integer, Transaction) -> Screen
tsNew AccountName
acct [(Integer, Transaction)]
nts (Integer, Transaction)
nt)
    UIState
ui