ui: allow navigating to accounts after --register

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -45,7 +45,7 @@ initAccountsScreen mselacct d st@AppState{
   ajournal=j,
   aScreen=s@AccountsScreen{}
   } =
-  st{aopts=opts', aScreen=s{asState=l'}}
+  st{aopts=uopts', aScreen=s{asState=l'}}
    where
     l = list (Name "accounts") (V.fromList displayitems) 1
 
@@ -59,29 +59,14 @@ initAccountsScreen mselacct d st@AppState{
                  mi = findIndex (\((acct,_,_),_) -> acct==a') items
                  a' = maybe a (flip clipAccountName a) $ depth_ ropts
 
-    -- XXX messing around with depth, which is different from other queries
-    -- In hledger,
-    -- - reportopts{depth_} indicates --depth options
-    -- - reportopts{query_} is the query arguments as a string
-    -- - the report query is based on both of these.
-    -- For hledger-ui, currently, we move depth: arguments out of reportopts{query_}
-    -- and into reportopts{depth_}, so that depth and other kinds of filter query
-    -- can be displayed independently.
-    opts' = uopts{cliopts_=copts{reportopts_=ropts'}}
-    q = queryFromOpts d ropts
-    ropts' = ropts
-            {
-              -- ensure depth_ also reflects depth: args
-              depth_=depthfromoptsandargs,
-              -- remove depth: args from query_
-              query_=unwords $ -- as in ReportOptions, with same limitations
-                     [v | (k,v) <- rawopts_ copts, k=="args", not $ "depth" `isPrefixOf` v],
+    uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
+    ropts' = ropts {
       -- XXX balanceReport doesn't respect this yet
       balancetype_=HistoricalBalance
       }
-      where
-        depthfromoptsandargs = case queryDepth q of 99999 -> Nothing
-                                                    d     -> Just d
+
+    q = queryFromOpts d ropts
+
     -- maybe convert balances to market value
     convert | value_ ropts' = balanceReportValue j valuedate
             | otherwise    = id

hledger-ui/Hledger/UI/Main.hs

@@ -15,7 +15,7 @@ import Control.Monad
 -- import Control.Monad.IO.Class (liftIO)
 -- import Data.Default
 -- import Data.Monoid              -- 
--- import Data.List
+import Data.List
 import Data.Maybe
 -- import Data.Time.Calendar
 import Safe
@@ -56,28 +56,67 @@ withJournalDoUICommand uopts@UIOpts{cliopts_=copts} cmd = do
   either error' (cmd uopts . journalApplyAliases (aliasesFromOpts copts)) ej
 
 runBrickUi :: UIOpts -> Journal -> IO ()
-runBrickUi opts j = do
+runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
   d <- getCurrentDay
 
   let
+
+    -- depth: is a bit different from other queries. In hledger cli,
+    -- - reportopts{depth_} indicates --depth options
+    -- - reportopts{query_} is the query arguments as a string
+    -- - the report query is based on both of these.
+    -- For hledger-ui, for now, move depth: arguments out of reportopts{query_}
+    -- and into reportopts{depth_}, so that depth and other kinds of filter query
+    -- can be displayed independently.
+    uopts' = uopts{
+      cliopts_=copts{
+         reportopts_= ropts{
+            -- ensure depth_ also reflects depth: args
+            depth_=depthfromoptsandargs,
+            -- remove depth: args from query_
+            query_=unwords $ -- as in ReportOptions, with same limitations
+                   [v | (k,v) <- rawopts_ copts, k=="args", not $ "depth" `isPrefixOf` v]
+            }
+         }
+      }
+      where
+        q = queryFromOpts d ropts
+        depthfromoptsandargs = case queryDepth q of 99999 -> Nothing
+                                                    d     -> Just d
+
     -- XXX move this stuff into Options, UIOpts
     theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $
-            maybestringopt "theme" $ rawopts_ $ cliopts_ opts
-    mshowacct = maybestringopt "register" $ rawopts_ $ cliopts_ opts
-    scr = case mshowacct of
-      Nothing -> AS.screen
-      Just apat -> RS.screen{rsAcct=acct}
+            maybestringopt "theme" $ rawopts_ copts
+    mregister = maybestringopt "register" $ rawopts_ copts
+
+    (scr, prevscrs) = case mregister of
+      Nothing   -> (AS.screen, [])
+      -- with --register, start on the register screen, and also put
+      -- the accounts screen on the prev screens stack so you can exit
+      -- to that as usual.
+      Just apat -> (RS.screen{rsAcct=acct}, [ascr'])
         where
           acct = headDef
                  (error' $ "--register "++apat++" did not match any account")
                  $ filter (regexMatches apat) $ journalAccountNames j
+          -- Initialising the accounts screen is awkward, requiring
+          -- another temporary AppState value..
+          ascr = AS.screen
+          ascr' = aScreen $
+                  (sInitFn ascr) d
+                  AppState{
+                    aopts=uopts'
+                   ,ajournal=j
+                   ,aScreen=ascr
+                   ,aPrevScreens=[]
+                   }
 
     st = (sInitFn scr) d
          AppState{
-            aopts=opts
+            aopts=uopts'
            ,ajournal=j
            ,aScreen=scr
-           ,aPrevScreens=[]
+           ,aPrevScreens=prevscrs
            }
          
     app :: App (AppState) V.Event
@@ -86,8 +125,13 @@ runBrickUi opts j = do
       , appStartEvent   = return
       , appAttrMap      = const theme
       , appChooseCursor = showFirstCursor
-      , appHandleEvent  = \st ev -> (sHandleFn $ aScreen st) st ev
-      , appDraw         = \st -> (sDrawFn $ aScreen st) st
+      , appHandleEvent  = \st ev -> sHandleFn (aScreen st) st ev
+      , appDraw         = \st -> sDrawFn (aScreen st) st
+ -- XXX bizarro. removing the st arg and parameter above,
+ -- which according to GHCI does not change the type,
+ -- causes "Exception: draw function called with wrong screen type"
+ -- on entering a register. Likewise, removing the st ev args and parameters
+ -- causes an exception on exiting a register.
       }
 
   void $ defaultMain app st