imp: ui: improve debug logging helpers, log screen stack on each event

hledger-ui/Hledger/UI/UIUtils.hs

@@ -33,12 +33,15 @@ module Hledger.UI.UIUtils (
   ,reportSpecSetFutureAndForecast
   ,listScrollPushingSelection
   ,dbgui
+  ,dbguiIO
   ,dbguiEv
   ,dbguiScreensEv
-  ,screenRegisterDescriptions
+  ,showScreenId
-  ,screenId
+  ,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
+  ui <- get
-  dbguiEv $ "getting state: " ++ (head $ lines $ pshow $ aScreen x)
+  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" showScreenId x
-  -- dbguiScreensEv "getting, with register descriptions" screenRegisterDescriptions x
+  -- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
-  return x
+  return ui
 
-put' x = do
+put' ui = do
-  dbguiEv $ "putting state: " ++ (head $ lines $ pshow $ aScreen x)
+  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" showScreenId x
-  -- dbguiScreensEv "putting, with register descriptions" screenRegisterDescriptions x
+  -- dbguiScreensEv "putting, with register descriptions" showScreenRegisterDescriptions x
-  put x
+  put ui
 
 modify' f = do
-  x <- get
+  ui <- get
-  let x' = f x
+  let ui' = f ui
-  dbguiEv $ "modifying state: " ++ (head $ lines $ pshow $ aScreen x')
+  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 "getting" showScreenId x
-  -- dbguiScreensEv "putting" screenId x'
+  -- dbguiScreensEv "putting" showScreenId x'
-  -- dbguiScreensEv "getting, with register descriptions" screenRegisterDescriptions x
+  -- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
-  -- dbguiScreensEv "putting, with register descriptions" screenRegisterDescriptions 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@.
+-- Some screen rendering functions are 
--- To just show the stack: @dbguiScreensEv "" screenId ui@
+-- @showScreenId@, @showScreenSelection@, @showScreenRegisterDescriptions@.
-dbguiScreensEv :: String -> (Screen -> String) -> UIState -> EventM Name UIState ()
+--
-dbguiScreensEv postfix showscr ui =
+-- Eg to just show the stack: @showScreenStack "" showScreenId ui@
-  dbguiEv $ concat [
+--
-     "screen stack"
+-- To to show the stack plus selected item indexes: @showScreenStack "" showScreenSelection ui@
-    ,if null postfix then "" else " (" ++ postfix ++ ")"
+--
-    ,": "
+showScreenStack :: String -> (Screen -> String) -> UIState -> String
-    ,unwords $ mapScreens showscr ui
+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
+showScreenId :: Screen -> String
-screenId = \case
+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