slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

imp: ui: start on balance sheet screen: better initial screen stack

Browse Source
This commit is contained in:
Simon Michael 2022-11-06 07:55:57 -10:00
parent 06bc09a36f
commit 9a8a8a75a2
5 changed files with 100 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
hledger-lib/Hledger/Data/Types.hs
View File

@ -163,6 +163,21 @@ instance Show AccountType where
show Cash = "C"
show Conversion = "V"
isBalanceSheetAccountType :: AccountType -> Bool
isBalanceSheetAccountType t = t `elem` [
Asset,
Liability,
Equity,
Cash,
Conversion
]
isIncomeStatementAccountType :: AccountType -> Bool
isIncomeStatementAccountType t = t `elem` [
Revenue,
Expense
]
-- | Check whether the first argument is a subtype of the second: either equal
-- or one of the defined subtypes.
isAccountSubtypeOf :: AccountType -> AccountType -> Bool

27
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -47,6 +47,7 @@ import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiRelo
import Hledger.UI.RegisterScreen (rsCenterSelection)
import Data.Either (fromRight)
import Control.Arrow ((>>>))
import Safe (headDef)
asDraw :: UIState -> [Widget Name]
@ -363,7 +364,7 @@ enterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
ui1 = pushScreen regscr ui
rsCenterSelection ui1 >>= put'
-- | From an accounts-screen-like screen's state, get the account name from the
-- | 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 ass =
@ -371,10 +372,28 @@ asSelectedAccount ass =
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> ass ^. assSelectedAccount
-- | Set the selected account on an accounts screen. No effect on other screens.
-- | 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 a (AS ass@ASS{}) = AS ass{_assSelectedAccount=a}
asSetSelectedAccount _ s = s
asSetSelectedAccount acct scr =
case scr of
(AS ass) -> AS $ assSetSelectedAccount acct ass
(BS ass) -> BS $ assSetSelectedAccount acct ass
(IS ass) -> IS $ assSetSelectedAccount acct ass
_ -> scr
where
assSetSelectedAccount a ass@ASS{_assList=l} =
ass{_assSelectedAccount=a, _assList=listMoveTo selidx l}
where
-- which list item should be selected ?
selidx = headDef 0 $ catMaybes [
elemIndex a as -- the specified account, if it can be found
,findIndex (a `isAccountNamePrefixOf`) as -- or the first account found with the same prefix
,Just $ max 0 (length (filter (< a) as) - 1) -- otherwise, the alphabetically preceding account.
]
where
as = map asItemAccountName $ V.toList $ listElements l
isBlankItem mitem = ((asItemAccountName . snd) <$> mitem) == Just ""

63
hledger-ui/Hledger/UI/Main.hs
View File

@ -15,6 +15,8 @@ import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
import Control.Monad (forM_, void, when)
import Data.Bifunctor (first)
import Data.Function ((&))
import Data.List (find)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe)
@ -22,6 +24,7 @@ import qualified Data.Text as T
import Graphics.Vty (mkVty, Mode (Mouse), Vty (outputIface), Output (setMode))
import Lens.Micro ((^.))
import System.Directory (canonicalizePath)
import System.Environment (withProgName)
import System.FilePath (takeDirectory)
import System.FSNotify (Event(Modified), watchDir, withManager, EventIsDirectory (IsFile))
import Brick hiding (bsDraw)
@ -41,7 +44,7 @@ import Hledger.UI.IncomestatementScreen
import Hledger.UI.RegisterScreen
import Hledger.UI.TransactionScreen
import Hledger.UI.ErrorScreen
import System.Environment (withProgName)
----------------------------------------------------------------------
@ -132,13 +135,30 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q]
where filtered = filterQuery (\x -> not $ queryIsDepth x || queryIsDate x)
-- Select the starting screen, and parent screens you can step back to:
-- menu > accounts by default, or menu > accounts > register with --register.
-- Remember the parent screens are ordered nearest/lowest first.
(prevscrs, startscr) = case uoRegister uopts of
Nothing -> ([menuscr], bsacctsscr)
Just apat -> ([asSetSelectedAccount acct bsacctsscr, menuscr], regscr)
-- Set up the initial screen to display, and a stack of previous screens
-- as if you had navigated down to it from the top.
(prevscrs, currscr) = case uoRegister uopts of
-- The default initial screen stack is:
-- menu screen, with balance sheet accounts screen selected
-- balance sheet accounts screen
Nothing -> ([menuscr], bsacctsscr)
-- With --register=ACCT, it is:
-- menu screen, with ACCTSSCR selected
-- ACCTSSCR (the accounts screen containing ACCT), with ACCT selected
-- register screen for ACCT
Just apat -> ([acctsscr, menuscr'], regscr) -- remember, previous screens are ordered nearest/lowest first
where
-- the account being requested
acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL:
. firstMatch $ journalAccountNamesDeclaredOrImplied j
where
firstMatch = case toRegexCI $ T.pack apat of
Right re -> find (regexMatchText re)
Left _ -> const Nothing
-- the register screen for acct
regscr =
rsSetAccount acct False $
rsNew uopts today j acct forceinclusive
@ -146,17 +166,26 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
forceinclusive = case getDepth ui of
Just de -> accountNameLevel acct >= de
Nothing -> False
acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL:
. firstMatch $ journalAccountNamesDeclaredOrImplied j
where
firstMatch = case toRegexCI $ T.pack apat of
Right re -> find (regexMatchText re)
Left _ -> const Nothing
where
menuscr = msNew
bsacctsscr = bsNew uopts today j Nothing
ui = uiState uopts j prevscrs startscr
-- The accounts screen containing acct.
-- Keep these selidx values synced with the menu items in msNew.
(acctsscr, selidx) =
case journalAccountType j acct of
Just t | isBalanceSheetAccountType t -> (bsacctsscr, 1)
Just t | isIncomeStatementAccountType t -> (isacctsscr, 2)
_ -> (allacctsscr,0)
& first (asSetSelectedAccount acct)
-- the menu screen
menuscr' = msSetSelectedScreen selidx menuscr
where
menuscr = msNew
allacctsscr = asNew uopts today j Nothing
bsacctsscr = bsNew uopts today j Nothing
isacctsscr = isNew uopts today j Nothing
ui = uiState uopts j prevscrs currscr
app = brickApp (uoTheme uopts)
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit

6
hledger-ui/Hledger/UI/MenuScreen.hs
View File

@ -8,6 +8,7 @@ module Hledger.UI.MenuScreen
,msUpdate
,msDraw
,msHandle
,msSetSelectedScreen
)
where
@ -261,6 +262,11 @@ msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do
Incomestatement -> isNew uopts d j Nothing
put' $ pushScreen scr ui
-- | Set the selected list item on the menu screen. Has no effect on other screens.
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen selidx (MS mss@MSS{_mssList=l}) = MS mss{_mssList=listMoveTo selidx l}
msSetSelectedScreen _ s = s
isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just ""
msListSize = V.length . V.takeWhile ((/="").msItemScreenName) . listElements

25
hledger-ui/Hledger/UI/UIScreens.hs
View File

@ -80,6 +80,7 @@ msNew =
dbgui "msNew" $
MS MSS {
_mssList = list MenuList (V.fromList [
-- keep initial screen stack setup in UI.Main synced with these
MenuScreenItem "All accounts" Accounts
,MenuScreenItem "Balance sheet accounts (assets, liabilities, equity)" Balancesheet
,MenuScreenItem "Income statement accounts (revenues, expenses)" Incomestatement
@ -128,23 +129,17 @@ asUpdateHelper rspec0 d copts roptsModify extraquery j ass = dbgui "asUpdateHelp
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
& reportSpecAddQuery extraquery -- add any extra restrictions
-- 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
l = listMoveTo selidx $ list AccountsList (V.fromList $ displayitems ++ blankitems) 1
where
-- which account should be selected ?
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
elemIndex a as -- the one previously selected, if it can be found
,findIndex (a `isAccountNamePrefixOf`) as -- or the first account found with the same prefix
,Just $ max 0 (length (filter (< a) as) - 1) -- otherwise, the alphabetically preceding account.
]
where
a = _assSelectedAccount ass
as = map asItemAccountName displayitems
displayitems = map displayitem items
where