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

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

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

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

import Hledger
import Hledger.Cli hiding (Mode, mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.Editor
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.RegisterScreen (rsCenterSelection)
import Data.Either (fromRight)
import Control.Arrow ((>>>))
import Safe (headDef)


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

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

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

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

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

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

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

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

            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
"filename") Widget Name
forall {n}. Widget n
files
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
toggles
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scrname)
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Period -> Widget Name
borderPeriodStr (if Bool
ishistorical then String
"at end of" else String
"in") (ReportOpts -> Period
period_ ReportOpts
ropts)
              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)
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Maybe Int -> Widget Name
borderDepthStr Maybe Int
mdepth
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
str (String
" ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
curidxString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
totidxString -> String -> String
forall a. [a] -> [a] -> [a]
++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
                files :: Widget n
files = case Journal -> [String]
journalFilePaths Journal
j of
                              [] -> String -> Widget n
forall n. String -> Widget n
str String
""
                              String
f:[String]
_ -> String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
f
                              -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
                              -- f:fs  -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")
                toggles :: Widget n
toggles = 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") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                  [String
""]
                  ,if ReportOpts -> Bool
empty_ ReportOpts
ropts then [] else [String
"nonzero"]
                  ,CliOpts -> [Status] -> [String]
uiShowStatus CliOpts
copts ([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 []
                  ]
                mdepth :: Maybe Int
mdepth = ReportOpts -> Maybe Int
depth_ ReportOpts
ropts
                curidx :: String
curidx = case AccountsScreenState
ass AccountsScreenState
-> Getting (Maybe Int) AccountsScreenState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (GenericList Name Vector AccountsScreenItem
 -> Const (Maybe Int) (GenericList Name Vector AccountsScreenItem))
-> AccountsScreenState -> Const (Maybe Int) AccountsScreenState
Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList ((GenericList Name Vector AccountsScreenItem
  -> Const (Maybe Int) (GenericList Name Vector AccountsScreenItem))
 -> AccountsScreenState -> Const (Maybe Int) AccountsScreenState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> GenericList Name Vector AccountsScreenItem
    -> Const (Maybe Int) (GenericList Name Vector AccountsScreenItem))
-> Getting (Maybe Int) AccountsScreenState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> GenericList Name Vector AccountsScreenItem
-> Const (Maybe Int) (GenericList Name Vector AccountsScreenItem)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
listSelectedL 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)
                totidx :: String
totidx = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Vector AccountsScreenItem -> Int
forall a. Vector a -> Int
V.length Vector AccountsScreenItem
nonblanks
                  where
                    nonblanks :: Vector AccountsScreenItem
nonblanks = (AccountsScreenItem -> Bool)
-> Vector AccountsScreenItem -> Vector AccountsScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (AccountsScreenItem -> Bool) -> AccountsScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null (AccountName -> Bool)
-> (AccountsScreenItem -> AccountName)
-> AccountsScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountsScreenItem -> AccountName
asItemAccountName) (Vector AccountsScreenItem -> Vector AccountsScreenItem)
-> Vector AccountsScreenItem -> Vector AccountsScreenItem
forall a b. (a -> b) -> a -> b
$ AccountsScreenState
ass AccountsScreenState
-> Getting
     (Vector AccountsScreenItem)
     AccountsScreenState
     (Vector AccountsScreenItem)
-> Vector AccountsScreenItem
forall s a. s -> Getting a s a -> a
^. (GenericList Name Vector AccountsScreenItem
 -> Const
      (Vector AccountsScreenItem)
      (GenericList Name Vector AccountsScreenItem))
-> AccountsScreenState
-> Const (Vector AccountsScreenItem) AccountsScreenState
Lens'
  AccountsScreenState (GenericList Name Vector AccountsScreenItem)
assList ((GenericList Name Vector AccountsScreenItem
  -> Const
       (Vector AccountsScreenItem)
       (GenericList Name Vector AccountsScreenItem))
 -> AccountsScreenState
 -> Const (Vector AccountsScreenItem) AccountsScreenState)
-> ((Vector AccountsScreenItem
     -> Const (Vector AccountsScreenItem) (Vector AccountsScreenItem))
    -> GenericList Name Vector AccountsScreenItem
    -> Const
         (Vector AccountsScreenItem)
         (GenericList Name Vector AccountsScreenItem))
-> Getting
     (Vector AccountsScreenItem)
     AccountsScreenState
     (Vector AccountsScreenItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector AccountsScreenItem
 -> Const (Vector AccountsScreenItem) (Vector AccountsScreenItem))
-> GenericList Name Vector AccountsScreenItem
-> Const
     (Vector AccountsScreenItem)
     (GenericList Name Vector AccountsScreenItem)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2 (f :: * -> *).
Functor f =>
(t1 e1 -> f (t2 e2))
-> GenericList n t1 e1 -> f (GenericList n t2 e2)
listElementsL

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

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

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

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

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

  case BrickEvent Name AppEvent
ev of

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

    -- AppEvents come from the system, in --watch mode.
    -- XXX currently they are handled only in Normal mode
    -- XXX be sure we don't leave unconsumed app events piling up
    -- A data file has changed (or the user has pressed g): reload.
    BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e 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'

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

    -- set or reset a filter:
    VtyEvent (EvKey (KChar Char
'/') []) -> (UIState -> UIState) -> EventM Name UIState ()
modify' (AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"filter" Maybe String
forall a. Maybe a
Nothing (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)
    VtyEvent (EvKey Key
k           []) | Key
k 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 -> UIState) -> EventM Name UIState ()
modify' (UIState -> UIState
resetFilter (UIState -> UIState) -> (UIState -> UIState) -> UIState -> UIState
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d)

    -- run external programs:
    VtyEvent (EvKey (KChar Char
'a') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
    VtyEvent (EvKey (KChar Char
'A') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
    VtyEvent (EvKey (KChar Char
'E') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
endPosition (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui

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

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

    -- LEFT key or a click in the app's left margin: exit to the parent screen.
    VtyEvent Event
e | Event
e 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 -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
popScreen
    VtyEvent (EvMouseUp Int
0 Int
_ (Just Button
BLeft)) -> (UIState -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
popScreen  -- this mouse click is a VtyEvent since not in a clickable widget

    -- RIGHT key or MouseUp on an account: enter the register screen for the selected account
    VtyEvent Event
e | Event
e Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, AccountsScreenItem) -> Bool
forall {a}. Maybe (a, AccountsScreenItem) -> Bool
isBlankItem (Maybe (Int, AccountsScreenItem) -> Bool)
-> Maybe (Int, AccountsScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList Name Vector AccountsScreenItem
l -> Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
selacct UIState
ui
    MouseUp Name
_n (Just Button
BLeft) Location{loc :: Location -> (Int, Int)
loc=(Int
_,Int
y)} | Just AccountName
clkacct <- Int -> Maybe AccountName
clickedAcctAt Int
y    -> Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
clkacct UIState
ui

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

    -- Mouse scroll wheel: scroll up or down to the maximum extent, pushing the selection when necessary.
    MouseDown Name
name Button
btn [Modifier]
_mods Location
_loc | Button
btn Button -> [Button] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
      let scrollamt :: Int
scrollamt = if Button
btnButton -> Button -> Bool
forall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
      GenericList Name Vector AccountsScreenItem
l' <- GenericList Name Vector AccountsScreenItem
-> EventM
     Name
     (GenericList Name Vector AccountsScreenItem)
     (GenericList Name Vector AccountsScreenItem)
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l (EventM
   Name
   (GenericList Name Vector AccountsScreenItem)
   (GenericList Name Vector AccountsScreenItem)
 -> EventM
      Name UIState (GenericList Name Vector AccountsScreenItem))
-> EventM
     Name
     (GenericList Name Vector AccountsScreenItem)
     (GenericList Name Vector AccountsScreenItem)
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Int
-> EventM
     Name
     (GenericList Name Vector AccountsScreenItem)
     (GenericList Name Vector AccountsScreenItem)
forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name (GenericList Name Vector AccountsScreenItem -> Int
forall {n}. GenericList n Vector AccountsScreenItem -> Int
asListSize GenericList Name Vector AccountsScreenItem
l) Int
scrollamt
      UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=scons ass{_assList=l'}}

    -- PGDOWN/END keys: handle with List's default handler, but restrict the selection to stop
    -- (and center) at the last non-blank item.
    VtyEvent e :: Event
e@(EvKey Key
k []) | Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KPageDown, Key
KEnd] -> do
      GenericList Name Vector AccountsScreenItem
l1 <- GenericList Name Vector AccountsScreenItem
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l (EventM Name (GenericList Name Vector AccountsScreenItem) ()
 -> EventM
      Name UIState (GenericList Name Vector AccountsScreenItem))
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a b. (a -> b) -> a -> b
$ Event
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
      if Maybe (Int, AccountsScreenItem) -> Bool
forall {a}. Maybe (a, AccountsScreenItem) -> Bool
isBlankItem (Maybe (Int, AccountsScreenItem) -> Bool)
-> Maybe (Int, AccountsScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList Name Vector AccountsScreenItem
l1
      then do
        let l2 :: GenericList Name Vector AccountsScreenItem
l2 = Int
-> GenericList Name Vector AccountsScreenItem
-> GenericList Name Vector AccountsScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
lastnonblankidx GenericList Name Vector AccountsScreenItem
l1
        GenericList Name Vector AccountsScreenItem
-> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector AccountsScreenItem
l2
        UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=scons ass{_assList=l2}}
      else
        UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=scons ass{_assList=l1}}

    -- DOWN key when selection is at the last item: scroll 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, AccountsScreenItem) -> Bool
forall {a}. Maybe (a, AccountsScreenItem) -> Bool
isBlankItem Maybe (Int, AccountsScreenItem)
mnextelement -> 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
$ GenericList Name Vector AccountsScreenItem
lGenericList Name Vector AccountsScreenItem
-> Getting Name (GenericList Name Vector AccountsScreenItem) Name
-> Name
forall s a. s -> Getting a s a -> a
^.Getting Name (GenericList Name Vector AccountsScreenItem) Name
forall n1 (t :: * -> *) e n2 (f :: * -> *).
Functor f =>
(n1 -> f n2) -> GenericList n1 t e -> f (GenericList n2 t e)
listNameL) Int
1
      where mnextelement :: Maybe (Int, AccountsScreenItem)
mnextelement = GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector AccountsScreenItem
 -> Maybe (Int, AccountsScreenItem))
-> GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector AccountsScreenItem
-> GenericList Name Vector AccountsScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown GenericList Name Vector AccountsScreenItem
l

    -- Any other vty event (UP, DOWN, PGUP etc): handle with List's default handler.
    VtyEvent Event
e -> do
      GenericList Name Vector AccountsScreenItem
l' <- GenericList Name Vector AccountsScreenItem
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector AccountsScreenItem
l (EventM Name (GenericList Name Vector AccountsScreenItem) ()
 -> EventM
      Name UIState (GenericList Name Vector AccountsScreenItem))
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
-> EventM Name UIState (GenericList Name Vector AccountsScreenItem)
forall a b. (a -> b) -> a -> b
$ Event
-> EventM Name (GenericList Name Vector AccountsScreenItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent (Event -> Event
normaliseMovementKeys Event
e)
      UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=scons $ ass & assList .~ l' & assSelectedAccount .~ selacct}

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

-- | Handle events when in minibuffer mode on any screen.
handleMinibufferMode :: Editor String Name -> BrickEvent n e -> EventM Name UIState ()
handleMinibufferMode Editor String Name
ed BrickEvent n e
ev = do
  ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j} <- EventM Name UIState UIState
get'
  Day
d <- IO Day -> EventM Name UIState Day
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
  case BrickEvent n e
ev of
    VtyEvent (EvKey Key
KEsc   []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui
    VtyEvent (EvKey Key
KEnter []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d UIState
ui'
      where
        ui' :: UIState
ui' = String -> UIState -> Either String UIState
setFilter String
s (UIState -> UIState
closeMinibuffer UIState
ui)
          Either String UIState
-> (Either String UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& UIState -> Either String UIState -> UIState
forall b a. b -> Either a b -> b
fromRight (AccountName -> Maybe String -> UIState -> UIState
showMinibuffer AccountName
"Cannot compile regular expression" (String -> Maybe String
forall a. a -> Maybe a
Just String
s) UIState
ui)
          where s :: String
s = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Editor String Name -> [String]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor String Name
ed
    VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
forall n s. EventM n 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 e
_  -> () -> 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 ()

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

enterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen Day
d AccountName
acct ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j, aopts :: UIState -> UIOpts
aopts=UIOpts
uopts} = do
  String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"enterRegisterScreen"
  let
    regscr :: Screen
regscr = UIOpts -> Day -> Journal -> AccountName -> Bool -> Screen
rsNew UIOpts
uopts Day
d Journal
j AccountName
acct Bool
isdepthclipped
      where
        isdepthclipped :: Bool
isdepthclipped = case UIState -> Maybe Int
getDepth UIState
ui of
                          Just Int
de -> AccountName -> Int
accountNameLevel AccountName
acct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
de
                          Maybe Int
Nothing -> Bool
False
    ui1 :: UIState
ui1 = Screen -> UIState -> UIState
pushScreen Screen
regscr UIState
ui
  UIState -> EventM Name UIState UIState
rsCenterSelection UIState
ui1 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'

-- | From any accounts screen's state, get the account name from the 
-- currently selected list item, or otherwise the last known selected account name.
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount AccountsScreenState
ass =
  case GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector AccountsScreenItem
 -> Maybe (Int, AccountsScreenItem))
-> GenericList Name Vector AccountsScreenItem
-> Maybe (Int, AccountsScreenItem)
forall a b. (a -> b) -> a -> b
$ AccountsScreenState -> GenericList Name Vector AccountsScreenItem
_assList AccountsScreenState
ass of
    Just (Int
_, AccountsScreenItem{Int
Maybe MixedAmount
AccountName
asItemIndentLevel :: AccountsScreenItem -> Int
asItemAccountName :: AccountsScreenItem -> AccountName
asItemDisplayAccountName :: AccountsScreenItem -> AccountName
asItemMixedAmount :: AccountsScreenItem -> Maybe MixedAmount
asItemIndentLevel :: Int
asItemAccountName :: AccountName
asItemDisplayAccountName :: AccountName
asItemMixedAmount :: Maybe MixedAmount
..}) -> AccountName
asItemAccountName
    Maybe (Int, AccountsScreenItem)
Nothing -> AccountsScreenState
ass AccountsScreenState
-> Getting AccountName AccountsScreenState AccountName
-> AccountName
forall s a. s -> Getting a s a -> a
^. Getting AccountName AccountsScreenState AccountName
Lens' AccountsScreenState AccountName
assSelectedAccount

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

isBlankItem :: Maybe (a, AccountsScreenItem) -> Bool
isBlankItem Maybe (a, AccountsScreenItem)
mitem = ((AccountsScreenItem -> AccountName
asItemAccountName (AccountsScreenItem -> AccountName)
-> ((a, AccountsScreenItem) -> AccountsScreenItem)
-> (a, AccountsScreenItem)
-> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, AccountsScreenItem) -> AccountsScreenItem
forall a b. (a, b) -> b
snd) ((a, AccountsScreenItem) -> AccountName)
-> Maybe (a, AccountsScreenItem) -> Maybe AccountName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, AccountsScreenItem)
mitem) Maybe AccountName -> Maybe AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName -> Maybe AccountName
forall a. a -> Maybe a
Just AccountName
""

asListSize :: GenericList n Vector AccountsScreenItem -> Int
asListSize = Vector AccountsScreenItem -> Int
forall a. Vector a -> Int
V.length (Vector AccountsScreenItem -> Int)
-> (GenericList n Vector AccountsScreenItem
    -> Vector AccountsScreenItem)
-> GenericList n Vector AccountsScreenItem
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountsScreenItem -> Bool)
-> Vector AccountsScreenItem -> Vector AccountsScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile ((AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
/=AccountName
"")(AccountName -> Bool)
-> (AccountsScreenItem -> AccountName)
-> AccountsScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AccountsScreenItem -> AccountName
asItemAccountName) (Vector AccountsScreenItem -> Vector AccountsScreenItem)
-> (GenericList n Vector AccountsScreenItem
    -> Vector AccountsScreenItem)
-> GenericList n Vector AccountsScreenItem
-> Vector AccountsScreenItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericList n Vector AccountsScreenItem
-> Vector AccountsScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements