hledger/hledger-ui/Hledger/UI/UIScreens.hs

-- | Constructors and updaters for all hledger-ui screens.
--
-- Constructors (*New) create and initialise a new screen with valid state,
-- based on the provided options, reporting date, journal, and screen-specific parameters.
--
-- Updaters (*Update) recalculate an existing screen's state, 
-- based on new options, reporting date, journal, and the old screen state.
--
-- These are gathered in this low-level module so that any screen's handler 
-- can create or regenerate all other screens.
-- Drawing and event-handling code is elsewhere, in per-screen modules.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}

module Hledger.UI.UIScreens
 (screenUpdate
 ,asNew
 ,asUpdate
 ,rsNew
 ,rsUpdate
 ,tsNew
 ,tsUpdate
 ,esNew
 ,esUpdate
 )
where

import Brick.Widgets.List (listMoveTo, listSelectedElement, list)
import Data.List
import Data.Maybe
import Data.Time.Calendar (Day, diffDays)
import Safe
import qualified Data.Vector as V

import Hledger.Cli hiding (mode, progname,prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIUtils


-- | Regenerate the content of any screen from new options, reporting date and journal.
screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate opts d j = \case
  AS ass -> AS $ asUpdate opts d j ass
  RS rss -> RS $ rsUpdate opts d j rss
  TS tss -> TS $ tsUpdate tss
  ES ess -> ES $ esUpdate ess

-- | Construct an accounts screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
asNew uopts d j macct =
  dlogUiTrace "asNew" $
  AS $ 
  asUpdate uopts d j $
  ASS {
     _assSelectedAccount = fromMaybe "" macct
    ,_assList            = list AccountsList (V.fromList []) 1
    }

-- | Recalculate an accounts screen from these options, reporting date, and journal.
asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
  where
    UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
    -- decide which account is selected:
    -- if selectfirst is true, the first account;
    -- otherwise, the previously selected account if possible;
    -- otherwise, the first account with the same prefix (eg first leaf account when entering flat mode);
    -- otherwise, the alphabetically preceding account.
    l =
      listMoveTo selidx $
      list AccountsList (V.fromList $ displayitems ++ blankitems) 1
      where
        selidx = headDef 0 $ catMaybes [
                  elemIndex a as
                  ,findIndex (a `isAccountNamePrefixOf`) as
                  ,Just $ max 0 (length (filter (< a) as) - 1)
                  ]
                  where
                    a = _assSelectedAccount ass
                    as = map asItemAccountName displayitems

        displayitems = map displayitem items
          where
            -- run the report
            (items, _) = balanceReport rspec' j
              where
                rspec' =
                  -- Further restrict the query based on the current period and future/forecast mode.
                  (reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) rspec)
                  -- always show declared accounts even if unused
                    {_rsReportOpts=ropts{declared_=True}}

            -- pre-render a list item
            displayitem (fullacct, shortacct, indent, bal) =
              AccountsScreenItem{asItemIndentLevel        = indent
                                ,asItemAccountName        = fullacct
                                ,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct
                                ,asItemMixedAmount        = Just bal
                                }

        -- blanks added for scrolling control, cf RegisterScreen.
        -- XXX Ugly. Changing to 0 helps when debugging.
        blankitems = replicate uiNumBlankItems
          AccountsScreenItem{asItemIndentLevel        = 0
                            ,asItemAccountName        = ""
                            ,asItemDisplayAccountName = ""
                            ,asItemMixedAmount        = Nothing
                            }

-- | Construct a register screen listing the appropriate set of transactions,
-- with the appropriate one selected.
-- Screen-specific arguments: the account whose register this is,
-- whether to force inclusive balances.
rsNew :: UIOpts -> Day -> Journal -> AccountName -> Bool -> Screen
rsNew uopts d j acct forceinclusive =  -- XXX forcedefaultselection - whether to force selecting the last transaction.
  dlogUiTrace "rsNew" $
  RS $ 
  rsUpdate uopts d j $
  RSS {
     _rssAccount        = replaceHiddenAccountsNameWith "*" acct
    ,_rssForceInclusive = forceinclusive
    ,_rssList           = list RegisterList (V.fromList []) 1
    }

-- | Recalculate a register screen from these options, reporting date, and journal.
rsUpdate :: UIOpts -> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} =
  dlogUiTrace "rsUpdate" 
  rss{_rssList=l'}
  where
    UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
    -- gather arguments and queries
    -- XXX temp
    inclusive = tree_ ropts || _rssForceInclusive
    thisacctq = Acct $ mkregex _rssAccount
      where
        mkregex = if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex

    -- adjust the report options and report spec, carefully as usual to avoid screwups (#1523)
    rspec' =
      reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) .
      either (error "rsUpdate: adjusting the query for register, should not have failed") id $ -- PARTIAL:
      updateReportSpec ropts' rspec{_rsDay=d}
    ropts' = ropts {
        -- ignore any depth limit, as in postingsReport; allows register's total to match accounts screen
        depth_=Nothing
        -- do not strip prices so we can toggle costs within the ui
      , show_costs_=True
      -- XXX aregister also has this, needed ?
        -- always show historical balance
      -- , balanceaccum_= Historical
      }

    -- gather transactions to display
    items = accountTransactionsReport rspec' j thisacctq
    items' =
      (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $  -- without --empty, exclude no-change txns
      reverse  -- most recent last
      items

    -- pre-render the list items, helps calculate column widths
    displayitems = map displayitem items'
      where
        displayitem (t, _, _issplit, otheracctsstr, change, bal) =
          RegisterScreenItem{rsItemDate          = showDate $ transactionRegisterDate wd (_rsQuery rspec') thisacctq t
                            ,rsItemStatus        = tstatus t
                            ,rsItemDescription   = tdescription t
                            ,rsItemOtherAccounts = otheracctsstr
                                                    -- _   -> "<split>"  -- should do this if accounts field width < 30
                            ,rsItemChangeAmount  = showamt change
                            ,rsItemBalanceAmount = showamt bal
                            ,rsItemTransaction   = t
                            }
            where
              showamt = showMixedAmountB oneLine{displayMaxWidth=Just 3}
              wd = whichDate ropts'

    -- blank items are added to allow more control of scroll position; we won't allow movement over these.
    -- XXX Ugly. Changing to 0 helps when debugging.
    blankitems = replicate uiNumBlankItems
          RegisterScreenItem{rsItemDate          = ""
                            ,rsItemStatus        = Unmarked
                            ,rsItemDescription   = ""
                            ,rsItemOtherAccounts = ""
                            ,rsItemChangeAmount  = mempty
                            ,rsItemBalanceAmount = mempty
                            ,rsItemTransaction   = nulltransaction
                            }

    -- build the new list widget
    l = list RegisterList (V.fromList $ displayitems ++ blankitems) 1

    -- ensure the appropriate list item is selected:
    -- if forcedefaultselection is true, the last (latest) transaction;  XXX still needed ?
    -- otherwise, the previously selected transaction if possible;
    -- otherwise, the transaction nearest in date to it;
    -- or if there's several with the same date, the nearest in journal order;
    -- otherwise, the last (latest) transaction.
    l' = listMoveTo newselidx l
      where
        endidx = max 0 $ length displayitems - 1
        newselidx =
          -- case (forcedefaultselection, listSelectedElement _rssList) of
          --   (True, _)    -> endidx
          --   (_, Nothing) -> endidx
          --   (_, Just (_, RegisterScreenItem{rsItemTransaction=Transaction{tindex=prevselidx, tdate=prevseld}})) ->
          --     headDef endidx $ catMaybes [
          --       findIndex ((==prevselidx) . tindex . rsItemTransaction) displayitems
          --       ,findIndex ((==nearestidbydatethenid) . Just . tindex . rsItemTransaction) displayitems
          --       ]
          --     where
          --       nearestidbydatethenid = third3 <$> (headMay $ sort
          --         [(abs $ diffDays (tdate t) prevseld, abs (tindex t - prevselidx), tindex t) | t <- ts])
          --       ts = map rsItemTransaction displayitems
          case listSelectedElement oldlist of
            Nothing -> endidx
            Just (_, RegisterScreenItem{rsItemTransaction=Transaction{tindex=prevselidx, tdate=prevseld}}) ->
              headDef endidx $ catMaybes [
                findIndex ((==prevselidx) . tindex . rsItemTransaction) displayitems
                ,findIndex ((==nearestidbydatethenid) . Just . tindex . rsItemTransaction) displayitems
                ]
              where
                nearestidbydatethenid = third3 <$> (headMay $ sort
                  [(abs $ diffDays (tdate t) prevseld, abs (tindex t - prevselidx), tindex t) | t <- ts])
                ts = map rsItemTransaction displayitems

-- | Construct a transaction screen showing one of a given list of transactions,
-- with the ability to step back and forth through the list.
-- Screen-specific arguments: the account whose transactions are being shown,
-- the list of showable transactions, the currently shown transaction.
tsNew :: AccountName -> [NumberedTransaction] -> NumberedTransaction -> Screen
tsNew acct nts nt = 
  dlogUiTrace "tsNew" $
  TS TSS{
     _tssAccount      = acct
    ,_tssTransactions = nts
    ,_tssTransaction  = nt
    }

-- | Recalculate a transaction screen. Currently a no-op since transaction screen
-- depends only on its screen-specific state.
tsUpdate :: TransactionScreenState -> TransactionScreenState
tsUpdate = dlogUiTrace "tsUpdate"

-- | Construct a error screen.
-- Screen-specific arguments: the error message to show.
esNew :: String -> Screen
esNew msg =
  dlogUiTrace "esNew" $
  ES ESS {
    _essError = msg
    ,_essUnused = ()
    }

-- | Recalculate an error screen. Currently a no-op since error screen
-- depends only on its screen-specific state.
esUpdate :: ErrorScreenState -> ErrorScreenState
esUpdate = dlogUiTrace "esUpdate`"