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

imp: ui: debug log startup args, debug level, initial screen stack

Browse Source
This commit is contained in:
Simon Michael 2022-11-07 14:52:42 -10:00
parent da569e51e1
commit 1a526b82c9
1 changed files with 55 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,3 @@
-- TODO: brick 1 support
-- https://hackage.haskell.org/package/brick-1.0/changelog
{-| {-|
hledger-ui - a hledger add-on providing a curses-style interface. hledger-ui - a hledger add-on providing a curses-style interface.
Copyright (c) 2007-2015 Simon Michael <simon@joyful.com> Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
@ -37,7 +35,7 @@ import Hledger.UI.Theme
import Hledger.UI.UIOptions import Hledger.UI.UIOptions
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIState (uiState, getDepth) import Hledger.UI.UIState (uiState, getDepth)
import Hledger.UI.UIUtils (dbguiEv) import Hledger.UI.UIUtils (dbguiEv, showScreenStack, showScreenSelection)
import Hledger.UI.MenuScreen import Hledger.UI.MenuScreen
import Hledger.UI.AccountsScreen import Hledger.UI.AccountsScreen
import Hledger.UI.BalancesheetScreen import Hledger.UI.BalancesheetScreen
@ -58,6 +56,10 @@ writeChan = BC.writeBChan
main :: IO () main :: IO ()
main = withProgName "hledger-ui.log" $ do -- force Hledger.Utils.Debug.* to log to hledger-ui.log main = withProgName "hledger-ui.log" $ do -- force Hledger.Utils.Debug.* to log to hledger-ui.log
traceLogAtIO 1 "\n\n\n\n==== hledger-ui start"
dbg1IO "args" progArgs
dbg1IO "debugLevel" debugLevel
opts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- getHledgerUIOpts opts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- getHledgerUIOpts
-- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
@ -142,61 +144,63 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
-- if an account query has been provided at startup. -- if an account query has been provided at startup.
-- Whichever it is, we also set up a stack of previous screens, -- Whichever it is, we also set up a stack of previous screens,
-- as if you had navigated down to it from the top. -- as if you had navigated down to it from the top.
(prevscrs, currscr) = case (uoRegister uopts, hasbsaccts, hasacctquery) of (prevscrs, currscr) =
dbg1With (showScreenStack "initial" showScreenSelection . uncurry2 (uiState defuiopts nulljournal)) $
case (uoRegister uopts, hasbsaccts, hasacctquery) of
-- With --register=ACCT, the initial screen stack is: -- With --register=ACCT, the initial screen stack is:
-- 1. menu screen, with ACCTSSCR selected -- 1. menu screen, with ACCTSSCR selected
-- 2. ACCTSSCR (the accounts screen containing ACCT), with ACCT selected -- 2. ACCTSSCR (the accounts screen containing ACCT), with ACCT selected
-- 3. register screen for ACCT -- 3. register screen for ACCT
(Just apat, _, _) -> ([acctsscr, menuscr'], regscr) -- remember, previous screens are ordered nearest/lowest first (Just apat, _, _) -> ([acctsscr, menuscr'], regscr) -- remember, previous screens are ordered nearest/lowest first
where where
-- the account being requested -- the account being requested
acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL: acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL:
. firstMatch $ journalAccountNamesDeclaredOrImplied j . 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
where where
forceinclusive = case getDepth ui of firstMatch = case toRegexCI $ T.pack apat of
Just de -> accountNameLevel acct >= de Right re -> find (regexMatchText re)
Nothing -> False Left _ -> const Nothing
-- The accounts screen containing acct. -- the register screen for acct
-- Keep these selidx values synced with the menu items in msNew. regscr =
(acctsscr, selidx) = rsSetAccount acct False $
case journalAccountType j acct of rsNew uopts today j acct forceinclusive
Just t | isBalanceSheetAccountType t -> (bsacctsscr, 1) where
Just t | isIncomeStatementAccountType t -> (isacctsscr, 2) forceinclusive = case getDepth ui of
_ -> (allacctsscr,0) Just de -> accountNameLevel acct >= de
& first (asSetSelectedAccount acct) Nothing -> False
-- the menu screen -- The accounts screen containing acct.
menuscr' = msSetSelectedScreen selidx menuscr -- 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)
-- Or with balance sheet accounts detected and no initial account query, it is: -- the menu screen
-- 1. menu screen, with balance sheet accounts screen selected menuscr' = msSetSelectedScreen selidx menuscr
-- 2. balance sheet accounts screen
(Nothing, True, False) -> ([menuscr], bsacctsscr)
-- Otherwise it is: -- Or with balance sheet accounts detected and no initial account query, it is:
-- 1. menu screen, with all accounts screen selected -- 1. menu screen, with balance sheet accounts screen selected
-- 2. all accounts screen -- 2. balance sheet accounts screen
(Nothing, _, _) -> ([msSetSelectedScreen 0 menuscr], allacctsscr) (Nothing, True, False) -> ([menuscr], bsacctsscr)
where -- Otherwise it is:
hasbsaccts = any (`elem` accttypes) [Asset, Liability, Equity] -- 1. menu screen, with all accounts screen selected
where accttypes = M.elems $ jaccounttypes j -- 2. all accounts screen
hasacctquery = matchesQuery queryIsAcct $ _rsQuery rspec (Nothing, _, _) -> ([msSetSelectedScreen 0 menuscr], allacctsscr)
menuscr = msNew
allacctsscr = asNew uopts today j Nothing where
bsacctsscr = bsNew uopts today j Nothing hasbsaccts = any (`elem` accttypes) [Asset, Liability, Equity]
isacctsscr = isNew uopts today j Nothing where accttypes = M.elems $ jaccounttypes j
hasacctquery = matchesQuery queryIsAcct $ _rsQuery rspec
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 ui = uiState uopts j prevscrs currscr
app = brickApp (uoTheme uopts) app = brickApp (uoTheme uopts)
@ -210,8 +214,6 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
setMode (outputIface v) Mouse True setMode (outputIface v) Mouse True
return v return v
traceLogAtIO 1 "\n\n==== hledger-ui start"
if not (uoWatch uopts) if not (uoWatch uopts)
then do then do
vty <- makevty vty <- makevty