-- | 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
,esNew
,esUpdate
,msNew
,msUpdate
,asNew
,asUpdate
,asItemIndex
,csNew
,csUpdate
,csItemIndex
,bsNew
,bsUpdate
,bsItemIndex
,isNew
,isUpdate
,isItemIndex
,rsNew
,rsUpdate
,tsNew
,tsUpdate
)
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
import Data.Function ((&))


-- | Regenerate the content of any screen from new options, reporting date and journal.
screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate UIOpts
opts Day
d Journal
j = \case
  MS MenuScreenState
sst -> MenuScreenState -> Screen
MS (MenuScreenState -> Screen) -> MenuScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ MenuScreenState -> MenuScreenState
msUpdate MenuScreenState
sst  -- opts d j ass
  AS AccountsScreenState
sst -> AccountsScreenState -> Screen
AS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate UIOpts
opts Day
d Journal
j AccountsScreenState
sst
  CS AccountsScreenState
sst -> AccountsScreenState -> Screen
CS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
csUpdate UIOpts
opts Day
d Journal
j AccountsScreenState
sst
  BS AccountsScreenState
sst -> AccountsScreenState -> Screen
BS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate UIOpts
opts Day
d Journal
j AccountsScreenState
sst
  IS AccountsScreenState
sst -> AccountsScreenState -> Screen
IS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
isUpdate UIOpts
opts Day
d Journal
j AccountsScreenState
sst
  RS RegisterScreenState
sst -> RegisterScreenState -> Screen
RS (RegisterScreenState -> Screen) -> RegisterScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate UIOpts
opts Day
d Journal
j RegisterScreenState
sst
  TS TransactionScreenState
sst -> TransactionScreenState -> Screen
TS (TransactionScreenState -> Screen)
-> TransactionScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ TransactionScreenState -> TransactionScreenState
tsUpdate TransactionScreenState
sst
  ES ErrorScreenState
sst -> ErrorScreenState -> Screen
ES (ErrorScreenState -> Screen) -> ErrorScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ ErrorScreenState -> ErrorScreenState
esUpdate ErrorScreenState
sst

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

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

-- | Construct a menu screen, with the first item selected.
-- Screen-specific arguments: none.
msNew :: Screen
msNew :: Screen
msNew =
  String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"msNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$
  MenuScreenState -> Screen
MS MSS { _mssList :: List Name MenuScreenItem
_mssList = Name -> Vector MenuScreenItem -> Int -> List Name MenuScreenItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
MenuList ([MenuScreenItem] -> Vector MenuScreenItem
forall a. [a] -> Vector a
V.fromList [MenuScreenItem]
items ) Int
1, _mssUnused :: ()
_mssUnused = () }
  where
    -- keep synced with: indexes below, initial screen stack setup in UI.Main
    items :: [MenuScreenItem]
items = [
       AccountName -> ScreenName -> MenuScreenItem
MenuScreenItem AccountName
"Cash accounts" ScreenName
CashScreen
      ,AccountName -> ScreenName -> MenuScreenItem
MenuScreenItem AccountName
"Balance sheet accounts" ScreenName
Balancesheet
      ,AccountName -> ScreenName -> MenuScreenItem
MenuScreenItem AccountName
"Income statement accounts" ScreenName
Incomestatement
      ,AccountName -> ScreenName -> MenuScreenItem
MenuScreenItem AccountName
"All accounts" ScreenName
Accounts
      ]

-- keep synced with items above.
-- | Positions of menu screen items, so we can move selection to them.
[
  Int
csItemIndex,
  Int
bsItemIndex,
  Int
isItemIndex,
  Int
asItemIndex
  ] = [Int
0..Int
3] :: [Int]

-- | Update a menu screen. Currently a no-op since menu screen
-- has unchanging content.
msUpdate :: MenuScreenState -> MenuScreenState
msUpdate :: MenuScreenState -> MenuScreenState
msUpdate = String -> MenuScreenState -> MenuScreenState
forall a. String -> a -> a
dbgui String
"msUpdate"

nullass :: Maybe AccountName -> AccountsScreenState
nullass Maybe AccountName
macct = ASS {
   _assSelectedAccount :: AccountName
_assSelectedAccount = AccountName -> Maybe AccountName -> AccountName
forall a. a -> Maybe a -> a
fromMaybe AccountName
"" Maybe AccountName
macct
  ,_assList :: List Name AccountsScreenItem
_assList            = Name
-> Vector AccountsScreenItem -> Int -> List Name AccountsScreenItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
AccountsList ([AccountsScreenItem] -> Vector AccountsScreenItem
forall a. [a] -> Vector a
V.fromList []) Int
1
  }

-- | 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 :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
asNew UIOpts
uopts Day
d Journal
j Maybe AccountName
macct = String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"asNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$ AccountsScreenState -> Screen
AS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate UIOpts
uopts Day
d Journal
j (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState -> AccountsScreenState
forall a b. (a -> b) -> a -> b
$ Maybe AccountName -> AccountsScreenState
nullass Maybe AccountName
macct

-- | Update an accounts screen's state from these options, reporting date, and journal.
asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate :: UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate UIOpts
uopts Day
d = String
-> (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState
-> AccountsScreenState
forall a. String -> a -> a
dbgui String
"asUpdate" ((AccountsScreenState -> AccountsScreenState)
 -> AccountsScreenState -> AccountsScreenState)
-> (Journal -> AccountsScreenState -> AccountsScreenState)
-> Journal
-> AccountsScreenState
-> AccountsScreenState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ReportSpec
-> Day
-> CliOpts
-> (ReportOpts -> ReportOpts)
-> Query
-> Journal
-> AccountsScreenState
-> AccountsScreenState
asUpdateHelper ReportSpec
rspec Day
d CliOpts
copts ReportOpts -> ReportOpts
forall {a}. a -> a
roptsmod Query
extraquery
  where
    UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec}} = UIOpts
uopts
    roptsmod :: a -> a
roptsmod       = a -> a
forall {a}. a -> a
id
    extraquery :: Query
extraquery     = Query
Any

-- | Update an accounts-like screen's state from this report spec, reporting date,
-- cli options, report options modifier, extra query, and journal.
asUpdateHelper :: ReportSpec -> Day -> CliOpts -> (ReportOpts -> ReportOpts) -> Query -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdateHelper :: ReportSpec
-> Day
-> CliOpts
-> (ReportOpts -> ReportOpts)
-> Query
-> Journal
-> AccountsScreenState
-> AccountsScreenState
asUpdateHelper ReportSpec
rspec0 Day
d CliOpts
copts ReportOpts -> ReportOpts
roptsModify Query
extraquery Journal
j AccountsScreenState
ass = String -> AccountsScreenState -> AccountsScreenState
forall a. String -> a -> a
dbgui String
"asUpdateHelper"
  AccountsScreenState
ass{_assList=l}
  where
    ropts :: ReportOpts
ropts = ReportOpts -> ReportOpts
roptsModify (ReportOpts -> ReportOpts) -> ReportOpts -> ReportOpts
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec0
    rspec :: ReportSpec
rspec =
      ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec
        ReportOpts
ropts
        ReportSpec
rspec0{_rsDay=d}  -- update to the current date, might have changed since program start
      Either String ReportSpec
-> (Either String ReportSpec -> ReportSpec) -> ReportSpec
forall a b. a -> (a -> b) -> b
& (String -> ReportSpec)
-> (ReportSpec -> ReportSpec)
-> Either String ReportSpec
-> ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> ReportSpec
forall a. HasCallStack => String -> a
error String
"asUpdateHelper: adjusting the query, should not have failed") ReportSpec -> ReportSpec
forall {a}. a -> a
id -- PARTIAL:
      ReportSpec -> (ReportSpec -> ReportSpec) -> ReportSpec
forall a b. a -> (a -> b) -> b
& Maybe DateSpan -> ReportSpec -> ReportSpec
reportSpecSetFutureAndForecast (InputOpts -> Maybe DateSpan
forecast_ (InputOpts -> Maybe DateSpan) -> InputOpts -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts)  -- include/exclude future & forecast transactions
      ReportSpec -> (ReportSpec -> ReportSpec) -> ReportSpec
forall a b. a -> (a -> b) -> b
& Query -> ReportSpec -> ReportSpec
reportSpecAddQuery Query
extraquery  -- add any extra restrictions

    l :: List Name AccountsScreenItem
l = Int -> List Name AccountsScreenItem -> List Name AccountsScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
selidx (List Name AccountsScreenItem -> List Name AccountsScreenItem)
-> List Name AccountsScreenItem -> List Name AccountsScreenItem
forall a b. (a -> b) -> a -> b
$ Name
-> Vector AccountsScreenItem -> Int -> List Name AccountsScreenItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
AccountsList ([AccountsScreenItem] -> Vector AccountsScreenItem
forall a. [a] -> Vector a
V.fromList ([AccountsScreenItem] -> Vector AccountsScreenItem)
-> [AccountsScreenItem] -> Vector AccountsScreenItem
forall a b. (a -> b) -> a -> b
$ [AccountsScreenItem]
displayitems [AccountsScreenItem]
-> [AccountsScreenItem] -> [AccountsScreenItem]
forall a. [a] -> [a] -> [a]
++ [AccountsScreenItem]
blankitems) Int
1
      where
        -- which account 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 one previously selected, 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
            a :: AccountName
a = AccountsScreenState -> AccountName
_assSelectedAccount AccountsScreenState
ass
            as :: [AccountName]
as = (AccountsScreenItem -> AccountName)
-> [AccountsScreenItem] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountsScreenItem -> AccountName
asItemAccountName [AccountsScreenItem]
displayitems

        displayitems :: [AccountsScreenItem]
displayitems = ((AccountName, AccountName, Int, MixedAmount)
 -> AccountsScreenItem)
-> [(AccountName, AccountName, Int, MixedAmount)]
-> [AccountsScreenItem]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, AccountName, Int, MixedAmount) -> AccountsScreenItem
displayitem [(AccountName, AccountName, Int, MixedAmount)]
items
          where
            -- run the report
            ([(AccountName, AccountName, Int, MixedAmount)]
items, MixedAmount
_) = Map AccountName AmountStyle -> BalanceReport -> BalanceReport
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles (BalanceReport -> BalanceReport) -> BalanceReport -> BalanceReport
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> BalanceReport
balanceReport ReportSpec
rspec Journal
j
              where
                styles :: Map AccountName AmountStyle
styles = Rounding -> Journal -> Map AccountName AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j

            -- pre-render a list item
            displayitem :: (AccountName, AccountName, Int, MixedAmount) -> AccountsScreenItem
displayitem (AccountName
fullacct, AccountName
shortacct, Int
indent, MixedAmount
bal) =
              AccountsScreenItem{asItemIndentLevel :: Int
asItemIndentLevel        = Int
indent
                                ,asItemAccountName :: AccountName
asItemAccountName        = AccountName
fullacct
                                ,asItemDisplayAccountName :: AccountName
asItemDisplayAccountName = AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"All" (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ if ReportOpts -> Bool
tree_ ReportOpts
ropts then AccountName
shortacct else AccountName
fullacct
                                ,asItemMixedAmount :: Maybe MixedAmount
asItemMixedAmount        = MixedAmount -> Maybe MixedAmount
forall a. a -> Maybe a
Just MixedAmount
bal
                                }

        -- blanks added for scrolling control, cf RegisterScreen.
        blankitems :: [AccountsScreenItem]
blankitems = Int -> AccountsScreenItem -> [AccountsScreenItem]
forall a. Int -> a -> [a]
replicate Int
uiNumBlankItems  -- XXX ugly hard-coded value. When debugging, changing to 0 reduces noise.
          AccountsScreenItem{asItemIndentLevel :: Int
asItemIndentLevel        = Int
0
                            ,asItemAccountName :: AccountName
asItemAccountName        = AccountName
""
                            ,asItemDisplayAccountName :: AccountName
asItemDisplayAccountName = AccountName
""
                            ,asItemMixedAmount :: Maybe MixedAmount
asItemMixedAmount        = Maybe MixedAmount
forall a. Maybe a
Nothing
                            }

-- | Construct a balance sheet screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
bsNew UIOpts
uopts Day
d Journal
j Maybe AccountName
macct = String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"bsNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$ AccountsScreenState -> Screen
BS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate UIOpts
uopts Day
d Journal
j (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState -> AccountsScreenState
forall a b. (a -> b) -> a -> b
$ Maybe AccountName -> AccountsScreenState
nullass Maybe AccountName
macct

-- | Update a balance sheet screen's state from these options, reporting date, and journal.
bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate :: UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate UIOpts
uopts Day
d = String
-> (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState
-> AccountsScreenState
forall a. String -> a -> a
dbgui String
"bsUpdate" ((AccountsScreenState -> AccountsScreenState)
 -> AccountsScreenState -> AccountsScreenState)
-> (Journal -> AccountsScreenState -> AccountsScreenState)
-> Journal
-> AccountsScreenState
-> AccountsScreenState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ReportSpec
-> Day
-> CliOpts
-> (ReportOpts -> ReportOpts)
-> Query
-> Journal
-> AccountsScreenState
-> AccountsScreenState
asUpdateHelper ReportSpec
rspec Day
d CliOpts
copts ReportOpts -> ReportOpts
roptsmod Query
extraquery
  where
    UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec}} = UIOpts
uopts
    roptsmod :: ReportOpts -> ReportOpts
roptsmod ReportOpts
ropts = ReportOpts
ropts{balanceaccum_=Historical}  -- always show historical end balances
    extraquery :: Query
extraquery     = [AccountType] -> Query
Type [AccountType
Asset,AccountType
Liability,AccountType
Equity]    -- restrict to balance sheet accounts

-- | Construct a cash accounts screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
csNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
csNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
csNew UIOpts
uopts Day
d Journal
j Maybe AccountName
macct = String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"csNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$ AccountsScreenState -> Screen
CS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
csUpdate UIOpts
uopts Day
d Journal
j (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState -> AccountsScreenState
forall a b. (a -> b) -> a -> b
$ Maybe AccountName -> AccountsScreenState
nullass Maybe AccountName
macct

-- | Update a balance sheet screen's state from these options, reporting date, and journal.
csUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
csUpdate :: UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
csUpdate UIOpts
uopts Day
d = String
-> (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState
-> AccountsScreenState
forall a. String -> a -> a
dbgui String
"csUpdate" ((AccountsScreenState -> AccountsScreenState)
 -> AccountsScreenState -> AccountsScreenState)
-> (Journal -> AccountsScreenState -> AccountsScreenState)
-> Journal
-> AccountsScreenState
-> AccountsScreenState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ReportSpec
-> Day
-> CliOpts
-> (ReportOpts -> ReportOpts)
-> Query
-> Journal
-> AccountsScreenState
-> AccountsScreenState
asUpdateHelper ReportSpec
rspec Day
d CliOpts
copts ReportOpts -> ReportOpts
roptsmod Query
extraquery
  where
    UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec}} = UIOpts
uopts
    roptsmod :: ReportOpts -> ReportOpts
roptsmod ReportOpts
ropts = ReportOpts
ropts{balanceaccum_=Historical}  -- always show historical end balances
    extraquery :: Query
extraquery     = [AccountType] -> Query
Type [AccountType
Cash]    -- restrict to cash accounts

-- | Construct an income statement screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
isNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
isNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
isNew UIOpts
uopts Day
d Journal
j Maybe AccountName
macct = String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"isNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$ AccountsScreenState -> Screen
IS (AccountsScreenState -> Screen) -> AccountsScreenState -> Screen
forall a b. (a -> b) -> a -> b
$ UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
isUpdate UIOpts
uopts Day
d Journal
j (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState -> AccountsScreenState
forall a b. (a -> b) -> a -> b
$ Maybe AccountName -> AccountsScreenState
nullass Maybe AccountName
macct

-- | Update an income statement screen's state from these options, reporting date, and journal.
isUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
isUpdate :: UIOpts
-> Day -> Journal -> AccountsScreenState -> AccountsScreenState
isUpdate UIOpts
uopts Day
d = String
-> (AccountsScreenState -> AccountsScreenState)
-> AccountsScreenState
-> AccountsScreenState
forall a. String -> a -> a
dbgui String
"isUpdate" ((AccountsScreenState -> AccountsScreenState)
 -> AccountsScreenState -> AccountsScreenState)
-> (Journal -> AccountsScreenState -> AccountsScreenState)
-> Journal
-> AccountsScreenState
-> AccountsScreenState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ReportSpec
-> Day
-> CliOpts
-> (ReportOpts -> ReportOpts)
-> Query
-> Journal
-> AccountsScreenState
-> AccountsScreenState
asUpdateHelper ReportSpec
rspec Day
d CliOpts
copts ReportOpts -> ReportOpts
roptsmod Query
extraquery
  where
    UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec}} = UIOpts
uopts
    roptsmod :: ReportOpts -> ReportOpts
roptsmod ReportOpts
ropts = ReportOpts
ropts{balanceaccum_=PerPeriod}  -- always show historical end balances
    extraquery :: Query
extraquery     = [AccountType] -> Query
Type [AccountType
Revenue, AccountType
Expense]         -- restrict to income statement accounts

-- | 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 :: UIOpts -> Day -> Journal -> AccountName -> Bool -> Screen
rsNew UIOpts
uopts Day
d Journal
j AccountName
acct Bool
forceinclusive =  -- XXX forcedefaultselection - whether to force selecting the last transaction.
  String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"rsNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$
  RegisterScreenState -> Screen
RS (RegisterScreenState -> Screen) -> RegisterScreenState -> Screen
forall a b. (a -> b) -> a -> b
$
  UIOpts
-> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate UIOpts
uopts Day
d Journal
j (RegisterScreenState -> RegisterScreenState)
-> RegisterScreenState -> RegisterScreenState
forall a b. (a -> b) -> a -> b
$
  RSS {
     _rssAccount :: AccountName
_rssAccount        = AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
"*" AccountName
acct
    ,_rssForceInclusive :: Bool
_rssForceInclusive = Bool
forceinclusive
    ,_rssList :: List Name RegisterScreenItem
_rssList           = Name
-> Vector RegisterScreenItem -> Int -> List Name RegisterScreenItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
RegisterList ([RegisterScreenItem] -> Vector RegisterScreenItem
forall a. [a] -> Vector a
V.fromList []) Int
1
    }

-- | Update a register screen from these options, reporting date, and journal.
rsUpdate :: UIOpts -> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate :: UIOpts
-> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate UIOpts
uopts Day
d Journal
j rss :: RegisterScreenState
rss@RSS{AccountName
_rssAccount :: RegisterScreenState -> AccountName
_rssAccount :: AccountName
_rssAccount, Bool
_rssForceInclusive :: RegisterScreenState -> Bool
_rssForceInclusive :: Bool
_rssForceInclusive, _rssList :: RegisterScreenState -> List Name RegisterScreenItem
_rssList=List Name RegisterScreenItem
oldlist} =
  String -> RegisterScreenState -> RegisterScreenState
forall a. String -> a -> a
dbgui String
"rsUpdate"
  RegisterScreenState
rss{_rssList=l'}
  where
    UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}}} = UIOpts
uopts
    -- gather arguments and queries
    -- XXX temp
    inclusive :: Bool
inclusive = ReportOpts -> Bool
tree_ ReportOpts
ropts Bool -> Bool -> Bool
|| Bool
_rssForceInclusive
    thisacctq :: Query
thisacctq = Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ AccountName -> Regexp
mkregex AccountName
_rssAccount
      where
        mkregex :: AccountName -> Regexp
mkregex = if Bool
inclusive then AccountName -> Regexp
accountNameToAccountRegex else AccountName -> Regexp
accountNameToAccountOnlyRegex

    -- adjust the report options and report spec, carefully as usual to avoid screwups (#1523)
    ropts' :: ReportOpts
ropts' = ReportOpts
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
      }
    rspec' :: ReportSpec
rspec' =
      ReportOpts -> ReportSpec -> Either String ReportSpec
updateReportSpec ReportOpts
ropts' ReportSpec
rspec{_rsDay=d}
      Either String ReportSpec
-> (Either String ReportSpec -> ReportSpec) -> ReportSpec
forall a b. a -> (a -> b) -> b
& (String -> ReportSpec)
-> (ReportSpec -> ReportSpec)
-> Either String ReportSpec
-> ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> ReportSpec
forall a. HasCallStack => String -> a
error String
"rsUpdate: adjusting the query for register, should not have failed") ReportSpec -> ReportSpec
forall {a}. a -> a
id -- PARTIAL:
      ReportSpec -> (ReportSpec -> ReportSpec) -> ReportSpec
forall a b. a -> (a -> b) -> b
& Maybe DateSpan -> ReportSpec -> ReportSpec
reportSpecSetFutureAndForecast (InputOpts -> Maybe DateSpan
forecast_ (InputOpts -> Maybe DateSpan) -> InputOpts -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts)

    -- gather transactions to display
    items :: AccountTransactionsReport
items = Map AccountName AmountStyle
-> AccountTransactionsReport -> AccountTransactionsReport
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles (AccountTransactionsReport -> AccountTransactionsReport)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec' Journal
j Query
thisacctq
              where
                styles :: Map AccountName AmountStyle
styles = Rounding -> Journal -> Map AccountName AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
    items' :: AccountTransactionsReport
items' =
      (if ReportOpts -> Bool
empty_ ReportOpts
ropts then AccountTransactionsReport -> AccountTransactionsReport
forall {a}. a -> a
id else ((Transaction, Transaction, Bool, AccountName, MixedAmount,
  MixedAmount)
 -> Bool)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Transaction, Transaction, Bool, AccountName, MixedAmount,
     MixedAmount)
    -> Bool)
-> (Transaction, Transaction, Bool, AccountName, MixedAmount,
    MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> ((Transaction, Transaction, Bool, AccountName, MixedAmount,
     MixedAmount)
    -> MixedAmount)
-> (Transaction, Transaction, Bool, AccountName, MixedAmount,
    MixedAmount)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction, Transaction, Bool, AccountName, MixedAmount,
 MixedAmount)
-> MixedAmount
forall {a} {b} {c} {d} {e} {f}. (a, b, c, d, e, f) -> e
fifth6)) (AccountTransactionsReport -> AccountTransactionsReport)
-> AccountTransactionsReport -> AccountTransactionsReport
forall a b. (a -> b) -> a -> b
$  -- without --empty, exclude no-change txns
      AccountTransactionsReport -> AccountTransactionsReport
forall a. [a] -> [a]
reverse  -- most recent last
      AccountTransactionsReport
items

    -- pre-render the list items, helps calculate column widths
    displayitems :: [RegisterScreenItem]
displayitems = ((Transaction, Transaction, Bool, AccountName, MixedAmount,
  MixedAmount)
 -> RegisterScreenItem)
-> AccountTransactionsReport -> [RegisterScreenItem]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction, Transaction, Bool, AccountName, MixedAmount,
 MixedAmount)
-> RegisterScreenItem
forall {b} {c}.
(Transaction, b, c, AccountName, MixedAmount, MixedAmount)
-> RegisterScreenItem
displayitem AccountTransactionsReport
items'
      where
        displayitem :: (Transaction, b, c, AccountName, MixedAmount, MixedAmount)
-> RegisterScreenItem
displayitem (Transaction
t, b
_, c
_issplit, AccountName
otheracctsstr, MixedAmount
change, MixedAmount
bal) =
          RegisterScreenItem{rsItemDate :: AccountName
rsItemDate          = Day -> AccountName
showDate (Day -> AccountName) -> Day -> AccountName
forall a b. (a -> b) -> a -> b
$ WhichDate -> Query -> Query -> Transaction -> Day
transactionRegisterDate WhichDate
wd (ReportSpec -> Query
_rsQuery ReportSpec
rspec') Query
thisacctq Transaction
t
                            ,rsItemStatus :: Status
rsItemStatus        = Transaction -> Status
tstatus Transaction
t
                            ,rsItemDescription :: AccountName
rsItemDescription   = Transaction -> AccountName
tdescription Transaction
t
                            ,rsItemOtherAccounts :: AccountName
rsItemOtherAccounts = AccountName
otheracctsstr
                                                    -- _   -> "<split>"  -- should do this if accounts field width < 30
                            ,rsItemChangeAmount :: WideBuilder
rsItemChangeAmount  = MixedAmount -> WideBuilder
showamt MixedAmount
change
                            ,rsItemBalanceAmount :: WideBuilder
rsItemBalanceAmount = MixedAmount -> WideBuilder
showamt MixedAmount
bal
                            ,rsItemTransaction :: Transaction
rsItemTransaction   = Transaction
t
                            }
            where
              showamt :: MixedAmount -> WideBuilder
showamt = AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
oneLineNoCostFmt{displayMaxWidth=Just 3}
              wd :: WhichDate
wd = ReportOpts -> WhichDate
whichDate ReportOpts
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 :: [RegisterScreenItem]
blankitems = Int -> RegisterScreenItem -> [RegisterScreenItem]
forall a. Int -> a -> [a]
replicate Int
uiNumBlankItems
          RegisterScreenItem{rsItemDate :: AccountName
rsItemDate          = AccountName
""
                            ,rsItemStatus :: Status
rsItemStatus        = Status
Unmarked
                            ,rsItemDescription :: AccountName
rsItemDescription   = AccountName
""
                            ,rsItemOtherAccounts :: AccountName
rsItemOtherAccounts = AccountName
""
                            ,rsItemChangeAmount :: WideBuilder
rsItemChangeAmount  = WideBuilder
forall a. Monoid a => a
mempty
                            ,rsItemBalanceAmount :: WideBuilder
rsItemBalanceAmount = WideBuilder
forall a. Monoid a => a
mempty
                            ,rsItemTransaction :: Transaction
rsItemTransaction   = Transaction
nulltransaction
                            }

    -- build the new list widget
    l :: List Name RegisterScreenItem
l = Name
-> Vector RegisterScreenItem -> Int -> List Name RegisterScreenItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Name
RegisterList ([RegisterScreenItem] -> Vector RegisterScreenItem
forall a. [a] -> Vector a
V.fromList ([RegisterScreenItem] -> Vector RegisterScreenItem)
-> [RegisterScreenItem] -> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ [RegisterScreenItem]
displayitems [RegisterScreenItem]
-> [RegisterScreenItem] -> [RegisterScreenItem]
forall a. [a] -> [a] -> [a]
++ [RegisterScreenItem]
blankitems) Int
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' :: List Name RegisterScreenItem
l' = Int -> List Name RegisterScreenItem -> List Name RegisterScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
newselidx List Name RegisterScreenItem
l
      where
        endidx :: Int
endidx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [RegisterScreenItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RegisterScreenItem]
displayitems Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        newselidx :: Int
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 List Name RegisterScreenItem -> Maybe (Int, RegisterScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List Name RegisterScreenItem
oldlist of
            Maybe (Int, RegisterScreenItem)
Nothing -> Int
endidx
            Just (Int
_, RegisterScreenItem{rsItemTransaction :: RegisterScreenItem -> Transaction
rsItemTransaction=Transaction{tindex :: Transaction -> Integer
tindex=Integer
prevselidx, tdate :: Transaction -> Day
tdate=Day
prevseld}}) ->
              Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef Int
endidx ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [
                (RegisterScreenItem -> Bool) -> [RegisterScreenItem] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
prevselidx) (Integer -> Bool)
-> (RegisterScreenItem -> Integer) -> RegisterScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Integer
tindex (Transaction -> Integer)
-> (RegisterScreenItem -> Transaction)
-> RegisterScreenItem
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> Transaction
rsItemTransaction) [RegisterScreenItem]
displayitems
                ,(RegisterScreenItem -> Bool) -> [RegisterScreenItem] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe Integer
nearestidbydatethenid) (Maybe Integer -> Bool)
-> (RegisterScreenItem -> Maybe Integer)
-> RegisterScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (RegisterScreenItem -> Integer)
-> RegisterScreenItem
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Integer
tindex (Transaction -> Integer)
-> (RegisterScreenItem -> Transaction)
-> RegisterScreenItem
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> Transaction
rsItemTransaction) [RegisterScreenItem]
displayitems
                ]
              where
                nearestidbydatethenid :: Maybe Integer
nearestidbydatethenid = (Integer, Integer, Integer) -> Integer
forall {a} {b} {c}. (a, b, c) -> c
third3 ((Integer, Integer, Integer) -> Integer)
-> Maybe (Integer, Integer, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Integer, Integer, Integer)] -> Maybe (Integer, Integer, Integer)
forall a. [a] -> Maybe a
headMay ([(Integer, Integer, Integer)]
 -> Maybe (Integer, Integer, Integer))
-> [(Integer, Integer, Integer)]
-> Maybe (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ [(Integer, Integer, Integer)] -> [(Integer, Integer, Integer)]
forall a. Ord a => [a] -> [a]
sort
                  [(Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays (Transaction -> Day
tdate Transaction
t) Day
prevseld, Integer -> Integer
forall a. Num a => a -> a
abs (Transaction -> Integer
tindex Transaction
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
prevselidx), Transaction -> Integer
tindex Transaction
t) | Transaction
t <- [Transaction]
ts])
                ts :: [Transaction]
ts = (RegisterScreenItem -> Transaction)
-> [RegisterScreenItem] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map RegisterScreenItem -> Transaction
rsItemTransaction [RegisterScreenItem]
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 :: AccountName
-> [NumberedTransaction] -> NumberedTransaction -> Screen
tsNew AccountName
acct [NumberedTransaction]
nts NumberedTransaction
nt =
  String -> Screen -> Screen
forall a. String -> a -> a
dbgui String
"tsNew" (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$
  TransactionScreenState -> Screen
TS TSS{
     _tssAccount :: AccountName
_tssAccount      = AccountName
acct
    ,_tssTransactions :: [NumberedTransaction]
_tssTransactions = [NumberedTransaction]
nts
    ,_tssTransaction :: NumberedTransaction
_tssTransaction  = NumberedTransaction
nt
    }

-- | Update a transaction screen. 
-- This currently does nothing because the initialisation in rsHandle is not so easy to extract.
-- To see the updated transaction, one must exit and re-enter the transaction screen.
-- See also tsHandle.
tsUpdate :: TransactionScreenState -> TransactionScreenState
tsUpdate :: TransactionScreenState -> TransactionScreenState
tsUpdate = String -> TransactionScreenState -> TransactionScreenState
forall a. String -> a -> a
dbgui String
"tsUpdate"