-- 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
_rssAccount :: AccountName
_rssForceInclusive :: Bool
_rssList :: List Name RegisterScreenItem
_rssAccount :: RegisterScreenState -> AccountName
_rssForceInclusive :: RegisterScreenState -> Bool
_rssList :: RegisterScreenState -> List Name RegisterScreenItem
..}
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } = String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"rsDraw 1" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$
  case Mode
mode of
    Mode
Help       -> [Widget Name
helpDialog, Widget Name
maincontent]
    Mode
_          -> [Widget Name
maincontent]
  where
    displayitems :: [RegisterScreenItem]
displayitems = Vector RegisterScreenItem -> [RegisterScreenItem]
forall a. Vector a -> [a]
V.toList (Vector RegisterScreenItem -> [RegisterScreenItem])
-> Vector RegisterScreenItem -> [RegisterScreenItem]
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (List Name RegisterScreenItem -> Vector RegisterScreenItem)
-> List Name RegisterScreenItem -> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList
    maincontent :: Widget Name
maincontent = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
      -- calculate column widths, based on current available width
      Context Name
c <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
      let
        totalwidth :: Int
totalwidth = Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
                     Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minnonamtcolswidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
whitespacewidth)
        maxchangewidthseen :: Int
maxchangewidthseen = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (RegisterScreenItem -> Int) -> [RegisterScreenItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (RegisterScreenItem -> WideBuilder) -> RegisterScreenItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> WideBuilder
rsItemChangeAmount) [RegisterScreenItem]
displayitems
        maxbalwidthseen :: Int
maxbalwidthseen = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (RegisterScreenItem -> Int) -> [RegisterScreenItem] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (RegisterScreenItem -> WideBuilder) -> RegisterScreenItem -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> WideBuilder
rsItemBalanceAmount) [RegisterScreenItem]
displayitems
        changewidthproportion :: Double
changewidthproportion = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxchangewidthseen Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxchangewidthseen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxbalwidthseen)
        maxchangewidth :: Int
maxchangewidth = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
changewidthproportion Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxamtswidth
        maxbalwidth :: Int
maxbalwidth = Int
maxamtswidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxchangewidth
        changewidth :: Int
changewidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxchangewidth Int
maxchangewidthseen
        balwidth :: Int
balwidth = Int -> Int -> Int
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)) $
          Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
totalwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
datewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
changewidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
balwidth Int -> Int -> Int
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 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        acctswidth :: Int
acctswidth = Int
maxdescacctswidth Int -> Int -> Int
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)

      Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout Widget Name
toplabel Widget Name
bottomlabel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> RegisterScreenItem -> Widget Name)
-> Bool -> List Name RegisterScreenItem -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList ((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 BalanceAccumulation -> BalanceAccumulation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
Historical
        -- inclusive = tree_ ropts || rsForceInclusive

        toplabel :: Widget Name
toplabel =
              AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"bold") (String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ AccountName -> String
T.unpack (AccountName -> String) -> AccountName -> String
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"All" AccountName
_rssAccount)
--           <+> withAttr ("border" <> "query") (str $ if inclusive then "" else " exclusive")
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
togglefilters
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str String
" transactions"
          -- <+> str (if ishistorical then " historical total" else " period total")
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
borderQueryStr (AccountName -> String
T.unpack (AccountName -> String)
-> ([AccountName] -> AccountName) -> [AccountName] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> AccountName
T.unwords ([AccountName] -> AccountName)
-> ([AccountName] -> [AccountName]) -> [AccountName] -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
textQuoteIfNeeded ([AccountName] -> String) -> [AccountName] -> String
forall a b. (a -> b) -> a -> b
$ ReportOpts -> [AccountName]
querystring_ ReportOpts
ropts)
          -- <+> str " and subs"
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Period -> Widget Name
borderPeriodStr String
"in" (ReportOpts -> Period
period_ ReportOpts
ropts)
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str String
" ("
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
cur
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str String
"/"
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
total
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str String
")"
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> (if BalancingOpts -> Bool
ignore_assertions_ (BalancingOpts -> Bool)
-> (InputOpts -> BalancingOpts) -> InputOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ (InputOpts -> Bool) -> InputOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts then AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query") (String -> Widget Name
forall n. String -> Widget n
str String
" ignoring balance assertions") else String -> Widget Name
forall n. String -> Widget n
str String
"")
          where
            togglefilters :: Widget n
togglefilters =
              case [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                   CliOpts -> [Status] -> [String]
uiShowStatus CliOpts
copts ([Status] -> [String]) -> [Status] -> [String]
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
                [] -> String -> Widget n
forall n. String -> Widget n
str String
""
                [String]
fs -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query") (String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
fs)
            cur :: Widget n
cur = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ case List Name RegisterScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name RegisterScreenItem
_rssList of
                         Maybe Int
Nothing -> String
"-"
                         Just Int
i -> Int -> String
forall a. Show a => a -> String
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            total :: Widget n
total = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Vector RegisterScreenItem -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector RegisterScreenItem
nonblanks
            nonblanks :: Vector RegisterScreenItem
nonblanks = (RegisterScreenItem -> Bool)
-> Vector RegisterScreenItem -> Vector RegisterScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (RegisterScreenItem -> Bool) -> RegisterScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null (AccountName -> Bool)
-> (RegisterScreenItem -> AccountName)
-> RegisterScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> AccountName
rsItemDate) (Vector RegisterScreenItem -> Vector RegisterScreenItem)
-> Vector RegisterScreenItem -> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (List Name RegisterScreenItem -> Vector RegisterScreenItem)
-> List Name RegisterScreenItem -> Vector RegisterScreenItem
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", String -> Widget Name
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 (Maybe DateSpan -> Bool
forall a. Maybe a -> Bool
isJust (Maybe DateSpan -> Bool)
-> (CliOpts -> Maybe DateSpan) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> Maybe DateSpan
forecast_ (InputOpts -> Maybe DateSpan)
-> (CliOpts -> InputOpts) -> CliOpts -> Maybe DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> InputOpts
inputopts_ (CliOpts -> Bool) -> CliOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts
copts) String
"forecast")
              -- ,("a", "add")
              -- ,("g", "reload")
              ,(String
"?", String -> Widget Name
forall n. String -> Widget n
str String
"help")
              -- ,("q", "quit")
              ]

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

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
rsItemChangeAmount :: RegisterScreenItem -> WideBuilder
rsItemBalanceAmount :: RegisterScreenItem -> WideBuilder
rsItemDate :: RegisterScreenItem -> AccountName
rsItemDate :: AccountName
rsItemStatus :: Status
rsItemDescription :: AccountName
rsItemOtherAccounts :: AccountName
rsItemChangeAmount :: WideBuilder
rsItemBalanceAmount :: WideBuilder
rsItemTransaction :: Transaction
rsItemStatus :: RegisterScreenItem -> Status
rsItemDescription :: RegisterScreenItem -> AccountName
rsItemOtherAccounts :: RegisterScreenItem -> AccountName
rsItemTransaction :: RegisterScreenItem -> Transaction
..} =
  Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
    Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
datewidth) Bool
True Bool
True AccountName
rsItemDate) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt AccountName
" " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Bool
True Bool
True (String -> AccountName
T.pack (String -> AccountName) -> String -> AccountName
forall a b. (a -> b) -> a -> b
$ Status -> String
forall a. Show a => a -> String
show Status
rsItemStatus)) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt AccountName
" " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
descwidth) Bool
True Bool
True AccountName
rsItemDescription) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt AccountName
"  " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctswidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
acctswidth) Bool
True Bool
True AccountName
rsItemOtherAccounts) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt AccountName
"   " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
changeattr (AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (AccountName -> Widget Name) -> AccountName -> Widget Name
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
changewidth) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
changewidth) Bool
True Bool
False AccountName
changeAmt) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AccountName -> Widget Name
forall n. AccountName -> Widget n
txt AccountName
"   " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
      AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
balattr (AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (AccountName -> Widget Name) -> AccountName -> Widget Name
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int -> Bool -> Bool -> AccountName -> AccountName
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
balwidth) (Int -> Maybe Int
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') AccountName
changeAmt  = AttrName -> AttrName
sel (AttrName -> AttrName) -> AttrName -> AttrName
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease"
               | Bool
otherwise                = AttrName -> AttrName
sel (AttrName -> AttrName) -> AttrName -> AttrName
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"increase"
    balattr :: AttrName
balattr    | (Char -> Bool) -> AccountName -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') AccountName
balanceAmt = AttrName -> AttrName
sel (AttrName -> AttrName) -> AttrName -> AttrName
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative"
               | Bool
otherwise                = AttrName -> AttrName
sel (AttrName -> AttrName) -> AttrName -> AttrName
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive"
    sel :: AttrName -> AttrName
sel | Bool
selected  = (AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected")
        | Bool
otherwise = AttrName -> AttrName
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'
  String -> EventM Name UIState ()
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
_rssAccount :: RegisterScreenState -> AccountName
_rssForceInclusive :: RegisterScreenState -> Bool
_rssList :: RegisterScreenState -> List Name RegisterScreenItem
_rssAccount :: AccountName
_rssForceInclusive :: Bool
_rssList :: List Name RegisterScreenItem
..}
      ,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 <- IO Day -> EventM Name UIState Day
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
      let
        journalspan :: DateSpan
journalspan = Bool -> Journal -> DateSpan
journalDateSpan Bool
False Journal
j
        nonblanks :: Vector RegisterScreenItem
nonblanks = (RegisterScreenItem -> Bool)
-> Vector RegisterScreenItem -> Vector RegisterScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (RegisterScreenItem -> Bool) -> RegisterScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null (AccountName -> Bool)
-> (RegisterScreenItem -> AccountName)
-> RegisterScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> AccountName
rsItemDate) (Vector RegisterScreenItem -> Vector RegisterScreenItem)
-> Vector RegisterScreenItem -> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (List Name RegisterScreenItem -> Vector RegisterScreenItem)
-> List Name RegisterScreenItem -> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList
        lastnonblankidx :: Int
lastnonblankidx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Vector RegisterScreenItem -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector RegisterScreenItem
nonblanks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        numberedtxns :: [(Integer, Transaction)]
numberedtxns = (Integer -> RegisterScreenItem -> (Integer, Transaction))
-> [Integer] -> [RegisterScreenItem] -> [(Integer, Transaction)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Integer, RegisterScreenItem) -> (Integer, Transaction))
-> Integer -> RegisterScreenItem -> (Integer, Transaction)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((RegisterScreenItem -> Transaction)
-> (Integer, RegisterScreenItem) -> (Integer, Transaction)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second RegisterScreenItem -> Transaction
rsItemTransaction)) [(Integer
1::Integer)..] (Vector RegisterScreenItem -> [RegisterScreenItem]
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
          []        -> Maybe ([(Integer, Transaction)], (Integer, Transaction))
forall a. Maybe a
Nothing
          nts :: [(Integer, Transaction)]
nts@((Integer, Transaction)
_:[(Integer, Transaction)]
_) -> ([(Integer, Transaction)], (Integer, Transaction))
-> Maybe ([(Integer, Transaction)], (Integer, Transaction))
forall a. a -> Maybe a
Just ([(Integer, Transaction)]
nts, (Integer, Transaction)
-> ((Int, RegisterScreenItem) -> (Integer, Transaction))
-> Maybe (Int, RegisterScreenItem)
-> (Integer, Transaction)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(Integer, Transaction)] -> (Integer, Transaction)
forall a. HasCallStack => [a] -> a
last [(Integer, Transaction)]
nts) ((Int -> Integer)
-> (RegisterScreenItem -> Transaction)
-> (Int, RegisterScreenItem)
-> (Integer, Transaction)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)(Integer -> Integer) -> (Int -> Integer) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral) RegisterScreenItem -> Transaction
rsItemTransaction) (Maybe (Int, RegisterScreenItem) -> (Integer, Transaction))
-> Maybe (Int, RegisterScreenItem) -> (Integer, Transaction)
forall a b. (a -> b) -> a -> b
$
                              List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem)
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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$
                case String -> UIState -> Either String UIState
setFilter String
s (UIState -> Either String UIState)
-> UIState -> Either String UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui of
                  Left String
bad -> AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"Cannot compile regular expression" (String -> Maybe String
forall a. a -> Maybe a
Just String
bad) UIState
ui
                  Right UIState
ui' -> UIState
ui'
              where s :: String
s = String -> String
chomp (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Editor String Name -> [String]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor String Name
ed
            -- VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui
            VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
forall a s. EventM a s ()
redraw
            VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
            VtyEvent Event
e -> do
              Editor String Name
ed' <- Editor String Name
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Editor String Name
ed (EventM Name (Editor String Name) ()
 -> EventM Name UIState (Editor String Name))
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a b. (a -> b) -> a -> b
$ BrickEvent Name Any -> EventM Name (Editor String Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (Event -> BrickEvent Name Any
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
              UIState -> EventM Name UIState ()
put' UIState
ui{aMode=Minibuffer "filter" ed'}
            AppEvent AppEvent
_  -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseDown{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            MouseUp{}   -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

            -- 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' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
              where
                p :: Period
p = UIState -> Period
reportPeriod UIState
ui

            BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e BrickEvent Name AppEvent -> [BrickEvent Name AppEvent] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AppEvent -> BrickEvent Name AppEvent
forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange, Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') [])] ->
              IO UIState -> EventM Name UIState UIState
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'

            VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
            VtyEvent (EvKey (KChar Char
'a') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'A') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
            VtyEvent (EvKey (KChar Char
'T') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
            VtyEvent (EvKey (KChar Char
'E') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
pos String
f) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
              where
                (Maybe TextPosition
pos,String
f) = case List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem)
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
_)}}) -> (TextPosition -> Maybe TextPosition
forall a. a -> Maybe a
Just (Pos -> Int
unPos Pos
l, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
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 (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleConversionOp UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'V') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleValue UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'H') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleHistorical UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
't') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleTree UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
c) []) | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleEmpty UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'R') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleReal UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'U') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleUnmarked UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'P') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
togglePending UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'C') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleCleared UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
            VtyEvent (EvKey (KChar Char
'F') []) -> UIState -> EventM Name UIState UIState
rsCenterSelection (Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
toggleForecast Day
d UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'

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

            -- exit screen on LEFT
            VtyEvent Event
e | Event
e Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveLeftEvents  -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
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
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
popScreen UIState
ui

            -- enter transaction screen on RIGHT
            VtyEvent Event
e | Event
e Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents ->
              case Maybe ([(Integer, Transaction)], (Integer, Transaction))
mtxns of Maybe ([(Integer, Transaction)], (Integer, Transaction))
Nothing -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
"") AccountName
clickeddate -> do
              UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState
ui{aScreen=RS sst{_rssList=listMoveTo y _rssList}}
              where clickeddate :: AccountName
clickeddate = AccountName
-> (RegisterScreenItem -> AccountName)
-> Maybe RegisterScreenItem
-> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" RegisterScreenItem -> AccountName
rsItemDate (Maybe RegisterScreenItem -> AccountName)
-> Maybe RegisterScreenItem -> AccountName
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements List Name RegisterScreenItem
_rssList Vector RegisterScreenItem -> Int -> Maybe RegisterScreenItem
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (AccountName -> AccountName -> Bool
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 -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
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 = AccountName
-> (RegisterScreenItem -> AccountName)
-> Maybe RegisterScreenItem
-> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" RegisterScreenItem -> AccountName
rsItemDate (Maybe RegisterScreenItem -> AccountName)
-> Maybe RegisterScreenItem -> AccountName
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements List Name RegisterScreenItem
_rssList Vector RegisterScreenItem -> Int -> Maybe RegisterScreenItem
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 Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents, Maybe (Int, RegisterScreenItem) -> Bool
forall {a}. Maybe (a, RegisterScreenItem) -> Bool
isBlankElement Maybe (Int, RegisterScreenItem)
mnextelement -> do
              ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> Name
forall n (t :: * -> *) e. GenericList n t e -> n
listName (List Name RegisterScreenItem -> Name)
-> List Name RegisterScreenItem -> Name
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem
_rssList) Int
1
              where mnextelement :: Maybe (Int, RegisterScreenItem)
mnextelement = List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem))
-> List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem)
forall a b. (a -> b) -> a -> b
$ List Name RegisterScreenItem -> List Name RegisterScreenItem
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 Button -> [Button] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
              let scrollamt :: Int
scrollamt = if Button
btnButton -> Button -> Bool
forall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
              List Name RegisterScreenItem
list' <- List Name RegisterScreenItem
-> EventM
     Name (List Name RegisterScreenItem) (List Name RegisterScreenItem)
-> EventM Name UIState (List Name RegisterScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name RegisterScreenItem
_rssList (EventM
   Name (List Name RegisterScreenItem) (List Name RegisterScreenItem)
 -> EventM Name UIState (List Name RegisterScreenItem))
-> EventM
     Name (List Name RegisterScreenItem) (List Name RegisterScreenItem)
-> EventM Name UIState (List Name RegisterScreenItem)
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Int
-> EventM
     Name (List Name RegisterScreenItem) (List Name RegisterScreenItem)
forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name (List Name RegisterScreenItem -> Int
forall {n}. GenericList n Vector RegisterScreenItem -> Int
rsListSize List Name RegisterScreenItem
_rssList) Int
scrollamt
              UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=RS sst{_rssList=list'}}

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

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

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

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

rsListSize :: GenericList n Vector RegisterScreenItem -> Int
rsListSize = Vector RegisterScreenItem -> Int
forall a. Vector a -> Int
V.length (Vector RegisterScreenItem -> Int)
-> (GenericList n Vector RegisterScreenItem
    -> Vector RegisterScreenItem)
-> GenericList n Vector RegisterScreenItem
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RegisterScreenItem -> Bool)
-> Vector RegisterScreenItem -> Vector RegisterScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=AccountName
"")(AccountName -> Bool)
-> (RegisterScreenItem -> AccountName)
-> RegisterScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RegisterScreenItem -> AccountName
rsItemDate) (Vector RegisterScreenItem -> Vector RegisterScreenItem)
-> (GenericList n Vector RegisterScreenItem
    -> Vector RegisterScreenItem)
-> GenericList n Vector RegisterScreenItem
-> Vector RegisterScreenItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericList n Vector RegisterScreenItem
-> Vector RegisterScreenItem
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=replaceHiddenAccountsNameWith "*" a, _rssForceInclusive=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
  List Name RegisterScreenItem -> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle (List Name RegisterScreenItem -> EventM Name UIState ())
-> List Name RegisterScreenItem -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ RegisterScreenState -> List Name RegisterScreenItem
_rssList RegisterScreenState
sst
  UIState -> EventM Name UIState UIState
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui  -- ui is unchanged, but this makes the function more chainable
rsCenterSelection UIState
ui = UIState -> EventM Name UIState UIState
forall a. a -> EventM Name UIState a
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
  String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"rsEnterTransactionScreen"
  UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
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