-- The transaction screen, showing a single transaction's general journal entry.

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

module Hledger.UI.TransactionScreen
(tsNew
,tsUpdate
,tsDraw
,tsHandle
) where

import Brick
import Brick.Widgets.Edit (editorText, renderEditor)
import Brick.Widgets.List (listMoveTo)
import Control.Monad.IO.Class (liftIO)
import Data.List
import Data.Maybe
import Data.Text qualified as T
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft))
import System.Exit (ExitCode (..))

import Hledger
import Hledger.Cli hiding (mode, prices, 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 (uiCheckBalanceAssertions, uiReload, uiReloadIfFileChanged, uiToggleBalanceAssertions)
import Hledger.UI.RegisterScreen (rsHandle)

tsDraw :: UIState -> [Widget Name]
tsDraw :: UIState -> [Widget Name]
tsDraw UIState{aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}}}
              ,ajournal :: UIState -> Journal
ajournal=Journal
j
              ,aScreen :: UIState -> Screen
aScreen=TS TSS{_tssTransaction :: TransactionScreenState -> NumberedTransaction
_tssTransaction=(Integer
i,Transaction
t')
                              ,_tssTransactions :: TransactionScreenState -> [NumberedTransaction]
_tssTransactions=[NumberedTransaction]
nts
                              ,_tssAccount :: TransactionScreenState -> AccountName
_tssAccount=AccountName
acct
                              }
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } =
  case Mode
mode of
    Mode
Help       -> [Widget Name
helpDialog, Widget Name
maincontent]
    Mode
_          -> [Widget Name
maincontent]
  where
    maincontent :: Widget Name
maincontent = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ 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
txneditor
      where
        -- as with print, show amounts with all of their decimal places
        t :: Transaction
t = (MixedAmount -> MixedAmount) -> Transaction -> Transaction
transactionMapPostingAmounts MixedAmount -> MixedAmount
mixedAmountSetFullPrecision Transaction
t'

        -- XXX would like to shrink the editor to the size of the entry,
        -- so handler can more easily detect clicks below it
        txneditor :: Widget Name
txneditor =
          ([AccountName] -> Widget Name)
-> Bool -> Editor AccountName Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor ([Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([AccountName] -> [Widget Name]) -> [AccountName] -> 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
forall n. AccountName -> Widget n
txt) Bool
False (Editor AccountName Name -> Widget Name)
-> Editor AccountName Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Int -> AccountName -> Editor AccountName Name
forall n. n -> Maybe Int -> AccountName -> Editor AccountName n
editorText Name
TransactionEditor Maybe Int
forall a. Maybe a
Nothing (AccountName -> Editor AccountName Name)
-> AccountName -> Editor AccountName Name
forall a b. (a -> b) -> a -> b
$
          ReportOpts -> ReportSpec -> Journal -> Transaction -> AccountName
showTxn ReportOpts
ropts ReportSpec
rspec Journal
j Transaction
t

        toplabel :: Widget Name
toplabel =
          [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Transaction "
          -- <+> withAttr ("border" <> "bold") (str $ "#" ++ show (tindex t))
          -- <+> str (" ("++show i++" of "++show (length nts)++" in "++acct++")")
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> ([Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char] -> Widget Name) -> [Char] -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char]
"#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Transaction -> Integer
tindex Transaction
t))
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" ("
          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 ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"bold") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char] -> Widget Name) -> [Char] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i)
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char]
" of "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show ([NumberedTransaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NumberedTransaction]
nts))
          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
<+> [Char] -> Widget Name
borderQueryStr ([[Char]] -> [Char]
unwords ([[Char]] -> [Char])
-> ([AccountName] -> [[Char]]) -> [AccountName] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName -> [Char]) -> [AccountName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
quoteIfNeeded ([Char] -> [Char])
-> (AccountName -> [Char]) -> AccountName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [Char]
T.unpack) ([AccountName] -> [Char]) -> [AccountName] -> [Char]
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
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char]
" in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++AccountName -> [Char]
T.unpack (AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"All" AccountName
acct)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")")
          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 ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" ignoring balance assertions") else [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"")
          where
            togglefilters :: Widget n
togglefilters =
              case [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                   CliOpts -> [Status] -> [[Char]]
uiShowStatus CliOpts
copts ([Status] -> [[Char]]) -> [Status] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Status]
statuses_ ReportOpts
ropts
                  ,if ReportOpts -> Bool
real_ ReportOpts
ropts then [[Char]
"real"] else []
                  ,if ReportOpts -> Bool
empty_ ReportOpts
ropts then [] else [[Char]
"nonzero"]
                  ] of
                [] -> [Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
""
                [[Char]]
fs -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") ([Char] -> Widget n
forall n. [Char] -> Widget n
str ([Char] -> Widget n) -> [Char] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
fs)

        bottomlabel :: Widget Name
bottomlabel = Widget Name
quickhelp
                        -- case mode of
                        -- Minibuffer ed -> minibuffer ed
                        -- _             -> quickhelp
          where
            quickhelp :: Widget Name
quickhelp = [([Char], [Char])] -> Widget Name
borderKeysStr [
               ([Char]
"LEFT", [Char]
"back")
              ,([Char]
"UP/DOWN", [Char]
"prev/next txn")
              --,("ESC", "cancel/top")
              -- ,("a", "add")
              ,([Char]
"E", [Char]
"edit")
              ,([Char]
"g", [Char]
"reload")
              ,([Char]
"?", [Char]
"help")
              -- ,("q", "quit")
              ]

tsDraw UIState
_ = [Char] -> [Widget Name]
forall a. [Char] -> a
errorWrongScreenType [Char]
"tsDraw"  -- PARTIAL:

-- Render a transaction suitably for the transaction screen.
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> AccountName
showTxn ReportOpts
ropts ReportSpec
rspec Journal
j Transaction
t =
      Transaction -> AccountName
showTransactionOneLineAmounts
    (Transaction -> AccountName) -> Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction)
-> (ValuationType -> Transaction -> Transaction)
-> Maybe ValuationType
-> Transaction
-> Transaction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Transaction -> Transaction
forall a. a -> a
id (PriceOracle
-> Map AccountName AmountStyle
-> Day
-> Day
-> ValuationType
-> Transaction
-> Transaction
transactionApplyValuation PriceOracle
prices Map AccountName AmountStyle
styles Day
periodlast (ReportSpec -> Day
_rsDay ReportSpec
rspec)) (ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts)
    (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction)
-> (ConversionOp -> Transaction -> Transaction)
-> Maybe ConversionOp
-> Transaction
-> Transaction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Transaction -> Transaction
forall a. a -> a
id ConversionOp -> Transaction -> Transaction
transactionToCost (ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts) Transaction
t
    -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
  where
    prices :: PriceOracle
prices = Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_prices_ ReportOpts
ropts) Journal
j
    styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
    periodlast :: Day
periodlast =
      Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Day
forall a. [Char] -> a
error' [Char]
"TransactionScreen: expected a non-empty journal") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$  -- PARTIAL: shouldn't happen
      ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ReportSpec
rspec Journal
j

tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle BrickEvent Name AppEvent
ev = do
  ui0 <- EventM Name UIState UIState
get'
  case ui0 of
    ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=TS TSS{_tssTransaction :: TransactionScreenState -> NumberedTransaction
_tssTransaction=(Integer
i,Transaction
t), _tssTransactions :: TransactionScreenState -> [NumberedTransaction]
_tssTransactions=[NumberedTransaction]
nts}
              ,aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
              ,ajournal :: UIState -> Journal
ajournal=Journal
j
              ,aMode :: UIState -> Mode
aMode=Mode
mode
              } ->
      case Mode
mode of
        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
_ -> do
          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
            (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
            (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
          case 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

            -- g or file change: reload the journal and rebuild app state.
            BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e BrickEvent Name AppEvent -> [BrickEvent Name AppEvent] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), AppEvent -> BrickEvent Name AppEvent
forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
              CliOpts -> Day -> UIState -> EventM Name UIState ()
tsReload CliOpts
copts Day
d UIState
ui

              -- for debugging; leaving these here because they were hard to find
              -- \u -> dbguiEv (pshow u) >> put' u  -- doesn't log
              -- \UIState{aScreen=TS tss} -> error' $ pshow $ _tssTransaction tss

            -- E: run editor, reload the journal.
            VtyEvent (EvKey (KChar Char
'E') []) -> do
              IO () -> EventM Name UIState ()
forall n a s. Ord n => IO a -> EventM n s a
suspendAndResume' (IO () -> EventM Name UIState ())
-> IO () -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ do
                let (Maybe (Int, Maybe Int)
pos,[Char]
f) = case Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t of (SourcePos [Char]
f' Pos
l1 Pos
c1,SourcePos
_) -> ((Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Pos -> Int
unPos Pos
l1, 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
c1),[Char]
f')
                exitcode <- Maybe (Int, Maybe Int) -> [Char] -> IO ExitCode
runEditor Maybe (Int, Maybe Int)
pos [Char]
f
                case exitcode of
                  ExitCode
ExitSuccess   -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  ExitFailure Int
c -> [Char] -> IO ()
forall a. [Char] -> a
error' ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"running the text editor failed with exit code " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c
              CliOpts -> Day -> Journal -> UIState -> EventM Name UIState ()
tsReloadIfFileChanged CliOpts
copts Day
d Journal
j UIState
ui

            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

            VtyEvent (EvKey (KChar Char
'I') []) -> Day -> UIState -> EventM Name UIState ()
uiToggleBalanceAssertions Day
d UIState
ui

            -- for toggles that may change the current/prev/next transactions,
            -- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP
            -- EvKey (KChar 'E') [] -> put' $ regenerateScreens j d $ stToggleEmpty ui
            -- EvKey (KChar 'C') [] -> put' $ regenerateScreens j d $ stToggleCleared ui
            -- EvKey (KChar 'R') [] -> put' $ regenerateScreens j d $ stToggleReal ui
            VtyEvent (EvKey (KChar Char
'B') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> (UIState -> UIState) -> UIState -> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleConversionOp UIState
ui
            VtyEvent (EvKey (KChar Char
'V') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> (UIState -> UIState) -> UIState -> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleValue UIState
ui

            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]
moveUpEvents   -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
iprev Transaction
tprev UIState
ui
            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 -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
inext Transaction
tnext 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 -> UIState) -> UIState -> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIState -> UIState
popScreen (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t UIState
ui  -- Probably not necessary to tsSelect here, but it's safe.
            -- or on a click in the app's left margin.
            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 -> UIState) -> UIState -> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIState -> UIState
popScreen (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t UIState
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
            BrickEvent Name AppEvent
_ -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    UIState
_ -> [Char] -> EventM Name UIState ()
forall a. [Char] -> a
errorWrongScreenType [Char]
"tsHandle"

    where
      -- Reload and fully regenerate the transaction screen.
      -- XXX On transaction screen or below, this is tricky because of a current limitation of regenerateScreens.
      -- For now we try to work around by re-entering the screen(s).
      -- This can show flicker in the UI and it's hard to handle all situations robustly.
      tsReload :: CliOpts -> Day -> UIState -> EventM Name UIState ()
tsReload CliOpts
copts Day
d UIState
ui = CliOpts -> Day -> UIState -> EventM Name UIState UIState
uiReload 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
>>= CliOpts -> Day -> UIState -> EventM Name UIState ()
forall {p}. p -> Day -> UIState -> EventM Name UIState ()
reEnterTransactionScreen CliOpts
copts Day
d
      tsReloadIfFileChanged :: CliOpts -> Day -> Journal -> UIState -> EventM Name UIState ()
tsReloadIfFileChanged CliOpts
copts Day
d Journal
j UIState
ui = 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 -> Journal -> UIState -> IO UIState
uiReloadIfFileChanged CliOpts
copts Day
d Journal
j 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
>>= CliOpts -> Day -> UIState -> EventM Name UIState ()
forall {p}. p -> Day -> UIState -> EventM Name UIState ()
reEnterTransactionScreen CliOpts
copts Day
d
      
      reEnterTransactionScreen :: p -> Day -> UIState -> EventM Name UIState ()
reEnterTransactionScreen p
_copts Day
d UIState
ui = do
        -- 1. If uiReload (or checking balance assertions) moved us to the error screen, save that, and return to the transaction screen.
        let
          (Maybe Screen
merrscr, UIState
uiTxn) = case UIState -> Screen
aScreen (UIState -> Screen) -> UIState -> Screen
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d UIState
ui of
            s :: Screen
s@(ES ErrorScreenState
_) -> (Screen -> Maybe Screen
forall a. a -> Maybe a
Just Screen
s,  UIState -> UIState
popScreen UIState
ui)
            Screen
_        -> (Maybe Screen
forall a. Maybe a
Nothing, UIState
ui)
        -- 2. Exit to register screen
        let uiReg :: UIState
uiReg = UIState -> UIState
popScreen UIState
uiTxn
        UIState -> EventM Name UIState ()
put' UIState
uiReg
        -- 3. Re-enter the transaction screen
        BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey Key
KEnter [])) -- PARTIAL assumes we are on the register screen.
        -- 4. Return to the error screen (below the transaction screen) if there was one.
        -- Next events will be handled by esHandle. Error repair will return to the transaction screen.
        EventM Name UIState ()
-> (Screen -> EventM Name UIState ())
-> Maybe Screen
-> EventM Name UIState ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> (Screen -> UIState) -> Screen -> EventM Name UIState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen -> UIState -> UIState) -> UIState -> Screen -> UIState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Screen -> UIState -> UIState
pushScreen UIState
uiTxn) Maybe Screen
merrscr
          -- doesn't uiTxn have old state from before step 3 ? seems to work

        -- XXX some problem:
        -- 4. Reload once more, possibly re-entering the error screen, by sending a g event.
        -- sendVtyEvents [EvKey (KChar 'g') []]  --  XXX Might be disrupted if other events are queued

        -- XXX doesn't update on non-error change:
        -- 4. Reload once more, possibly re-entering the error screen.
        -- uiTxnOrErr <- uiReload copts d uiTxn
          -- uiReloadIfChanged ?
          -- uiCheckBalanceAssertions ? seems unneeded
        -- put' uiTxnOrErr

        -- XXX not working right:
        -- -- 1. If uiReload (or checking balance assertions) moved us to the error screen, exit to the transaction screen.
        -- let
        --   uiTxn = case aScreen $ uiCheckBalanceAssertions d ui of
        --     ES _ -> popScreen ui
        --     _    -> ui
        -- -- 2. Exit to register screen
        -- put' $ popScreen uiTxn
        -- -- 3. Re-enter the transaction screen, and reload once more.
        -- sendVtyEvents [EvKey KEnter [], EvKey (KChar 'g') []]  -- XXX Might be disrupted if other events are queued


-- | Select a new transaction and update the previous register screen
tsSelect :: Integer -> Transaction -> UIState -> UIState
tsSelect :: Integer -> Transaction -> UIState -> UIState
tsSelect Integer
i Transaction
t ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=TS TransactionScreenState
sst} = case UIState -> [Screen]
aPrevScreens UIState
ui of
    Screen
x:[Screen]
xs -> UIState
ui'{aPrevScreens=rsSelect i x : xs}
    []   -> UIState
ui'
  where ui' :: UIState
ui' = UIState
ui{aScreen=TS sst{_tssTransaction=(i,t)}}
tsSelect Integer
_ Transaction
_ UIState
ui = UIState
ui

-- | Select the nth item on the register screen.
rsSelect :: Integer -> Screen -> Screen
rsSelect :: Integer -> Screen -> Screen
rsSelect Integer
i (RS sst :: RegisterScreenState
sst@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
..}) = RegisterScreenState -> Screen
RS RegisterScreenState
sst{_rssList=listMoveTo (fromInteger $ i-1) _rssList}
rsSelect Integer
_ Screen
scr = Screen
scr