mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 10:17:35 +03:00
imp: ui: improve debug logging helpers, log screen stack on each event
This commit is contained in:
Simon Michael
parent
6d2687e67d
commit
da569e51e1
@ -33,12 +33,15 @@ module Hledger.UI.UIUtils (
|
||||
,reportSpecSetFutureAndForecast
|
||||
,listScrollPushingSelection
|
||||
,dbgui
|
||||
,dbguiIO
|
||||
,dbguiEv
|
||||
,dbguiScreensEv
|
||||
,screenRegisterDescriptions
|
||||
,screenId
|
||||
,showScreenId
|
||||
,showScreenRegisterDescriptions
|
||||
,showScreenSelection
|
||||
,mapScreens
|
||||
,uiNumBlankItems
|
||||
,showScreenStack
|
||||
)
|
||||
where
|
||||
|
||||
@ -84,33 +87,39 @@ suspendSignal = raiseSignal sigSTOP
|
||||
-- A good place to log things of interest while debugging, see commented examples below.
|
||||
|
||||
get' = do
|
||||
x <- get
|
||||
dbguiEv $ "getting state: " ++ (head $ lines $ pshow $ aScreen x)
|
||||
ui <- get
|
||||
dbguiEv $ "getting state: " ++
|
||||
showScreenStack "" showScreenSelection ui
|
||||
-- (head $ lines $ pshow $ aScreen x)
|
||||
-- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x)
|
||||
-- dbguiEv $ ("query: "++) $ pshow' $ x & aopts & uoCliOpts & reportspec_ & _rsQuery
|
||||
-- dbguiScreensEv "getting" screenId x
|
||||
-- dbguiScreensEv "getting, with register descriptions" screenRegisterDescriptions x
|
||||
return x
|
||||
-- dbguiScreensEv "getting" showScreenId x
|
||||
-- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
|
||||
return ui
|
||||
|
||||
put' x = do
|
||||
dbguiEv $ "putting state: " ++ (head $ lines $ pshow $ aScreen x)
|
||||
put' ui = do
|
||||
dbguiEv $ "putting state: " ++
|
||||
showScreenStack "" showScreenSelection ui
|
||||
-- (head $ lines $ pshow $ aScreen x)
|
||||
-- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x)
|
||||
-- dbguiEv $ ("query: "++) $ pshow' $ x & aopts & uoCliOpts & reportspec_ & _rsQuery
|
||||
-- dbguiScreensEv "putting" screenId x
|
||||
-- dbguiScreensEv "putting, with register descriptions" screenRegisterDescriptions x
|
||||
put x
|
||||
-- dbguiScreensEv "putting" showScreenId x
|
||||
-- dbguiScreensEv "putting, with register descriptions" showScreenRegisterDescriptions x
|
||||
put ui
|
||||
|
||||
modify' f = do
|
||||
x <- get
|
||||
let x' = f x
|
||||
dbguiEv $ "modifying state: " ++ (head $ lines $ pshow $ aScreen x')
|
||||
ui <- get
|
||||
let ui' = f ui
|
||||
dbguiEv $ "getting state: " ++ (showScreenStack "" showScreenSelection ui)
|
||||
dbguiEv $ "putting state: " ++ (showScreenStack "" showScreenSelection ui')
|
||||
-- (head $ lines $ pshow $ aScreen x')
|
||||
-- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x')
|
||||
-- dbguiEv $ ("from: "++) $ pshow' $ x & aopts & uoCliOpts & reportspec_ & _rsQuery
|
||||
-- dbguiEv $ ("to: "++) $ pshow' $ x' & aopts & uoCliOpts & reportspec_ & _rsQuery
|
||||
-- dbguiScreensEv "getting" screenId x
|
||||
-- dbguiScreensEv "putting" screenId x'
|
||||
-- dbguiScreensEv "getting, with register descriptions" screenRegisterDescriptions x
|
||||
-- dbguiScreensEv "putting, with register descriptions" screenRegisterDescriptions x'
|
||||
-- dbguiScreensEv "getting" showScreenId x
|
||||
-- dbguiScreensEv "putting" showScreenId x'
|
||||
-- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
|
||||
-- dbguiScreensEv "putting, with register descriptions" showScreenRegisterDescriptions x'
|
||||
modify f
|
||||
|
||||
-- | On posix platforms, suspend the program using the STOP signal,
|
||||
@ -444,42 +453,48 @@ listScrollPushingSelection name listheight scrollamt = do
|
||||
dbgui :: String -> a -> a
|
||||
dbgui = traceLogAt 1
|
||||
|
||||
-- | Like dbgui, but convenient to use in IO.
|
||||
dbguiIO :: String -> IO ()
|
||||
dbguiIO = traceLogAtIO 1
|
||||
|
||||
-- | Like dbgui, but convenient to use in EventM handlers.
|
||||
dbguiEv :: String -> EventM Name s ()
|
||||
dbguiEv s = dbgui s $ return ()
|
||||
|
||||
-- | Like dbguiEv, but log a compact view of the current screen stack,
|
||||
-- | Like dbguiEv, but log a compact view of the current screen stack.
|
||||
-- See showScreenStack.
|
||||
-- To just log the stack: @dbguiScreensEv "" showScreenId ui@
|
||||
dbguiScreensEv :: String -> (Screen -> String) -> UIState -> EventM Name UIState ()
|
||||
dbguiScreensEv postfix showscr ui = dbguiEv $ showScreenStack postfix showscr ui
|
||||
|
||||
-- Render a compact labelled view of the current screen stack,
|
||||
-- adding the given postfix to the label (can be empty),
|
||||
-- from topmost screen to currently-viewed screen,
|
||||
-- from the topmost screen to the currently-viewed screen,
|
||||
-- with each screen rendered by the given rendering function.
|
||||
-- Useful for inspecting states across the whole screen stack.
|
||||
-- Some screen rendering functions are @screenId@ and @screenRegisterDescriptions@.
|
||||
-- To just show the stack: @dbguiScreensEv "" screenId ui@
|
||||
dbguiScreensEv :: String -> (Screen -> String) -> UIState -> EventM Name UIState ()
|
||||
dbguiScreensEv postfix showscr ui =
|
||||
dbguiEv $ concat [
|
||||
"screen stack"
|
||||
,if null postfix then "" else " (" ++ postfix ++ ")"
|
||||
,": "
|
||||
,unwords $ mapScreens showscr ui
|
||||
]
|
||||
-- Some screen rendering functions are
|
||||
-- @showScreenId@, @showScreenSelection@, @showScreenRegisterDescriptions@.
|
||||
--
|
||||
-- Eg to just show the stack: @showScreenStack "" showScreenId ui@
|
||||
--
|
||||
-- To to show the stack plus selected item indexes: @showScreenStack "" showScreenSelection ui@
|
||||
--
|
||||
showScreenStack :: String -> (Screen -> String) -> UIState -> String
|
||||
showScreenStack postfix showscr ui = concat [
|
||||
"screen stack"
|
||||
,if null postfix then "" else ", " ++ postfix
|
||||
,": "
|
||||
,unwords $ mapScreens showscr ui
|
||||
]
|
||||
|
||||
-- | Run a function on each screen in a UIState's screen "stack",
|
||||
-- from topmost screen down to currently-viewed screen.
|
||||
mapScreens :: (Screen -> a) -> UIState -> [a]
|
||||
mapScreens f UIState{aPrevScreens, aScreen} = map f $ reverse $ aScreen : aPrevScreens
|
||||
|
||||
-- Show a screen's compact id, plus for register screens, the transaction descriptions.
|
||||
screenRegisterDescriptions :: Screen -> String
|
||||
screenRegisterDescriptions scr = case scr of
|
||||
RS sst -> ((screenId scr ++ ":") ++) $ -- menu
|
||||
intercalate "," $ map (T.unpack . rsItemDescription) $
|
||||
takeWhile (not . T.null . rsItemDate) $ V.toList $ listElements $ _rssList sst
|
||||
_ -> screenId scr
|
||||
|
||||
-- Show a screen's compact id (first letter of its constructor).
|
||||
screenId :: Screen -> String
|
||||
screenId = \case
|
||||
showScreenId :: Screen -> String
|
||||
showScreenId = \case
|
||||
MS _ -> "M" -- menu
|
||||
AS _ -> "A" -- all accounts
|
||||
BS _ -> "B" -- bs accounts
|
||||
@ -488,6 +503,25 @@ screenId = \case
|
||||
TS _ -> "T" -- transaction
|
||||
ES _ -> "E" -- error
|
||||
|
||||
-- Show a screen's compact id, plus for register screens, the transaction descriptions.
|
||||
showScreenRegisterDescriptions :: Screen -> String
|
||||
showScreenRegisterDescriptions scr = case scr of
|
||||
RS sst -> ((showScreenId scr ++ ":") ++) $ -- menu
|
||||
intercalate "," $ map (T.unpack . rsItemDescription) $
|
||||
takeWhile (not . T.null . rsItemDate) $ V.toList $ listElements $ _rssList sst
|
||||
_ -> showScreenId scr
|
||||
|
||||
-- Show a screen's compact id, plus index of its selected list item if any.
|
||||
showScreenSelection :: Screen -> String
|
||||
showScreenSelection = \case
|
||||
MS MSS{_mssList} -> "M" ++ (maybe "" show $ listSelected _mssList) -- menu
|
||||
AS ASS{_assList} -> "A" ++ (maybe "" show $ listSelected _assList) -- all accounts
|
||||
BS ASS{_assList} -> "B" ++ (maybe "" show $ listSelected _assList) -- bs accounts
|
||||
IS ASS{_assList} -> "I" ++ (maybe "" show $ listSelected _assList) -- is accounts
|
||||
RS RSS{_rssList} -> "R" ++ (maybe "" show $ listSelected _rssList) -- menu
|
||||
TS _ -> "T" -- transaction
|
||||
ES _ -> "E" -- error
|
||||
|
||||
-- | How many blank items to add to lists to fill the full window height.
|
||||
uiNumBlankItems :: Int
|
||||
uiNumBlankItems
|
||||
|
||||
Loading…
Reference in New Issue
Block a user