ui,web: Adopt new ReportOptions interface, store literal query string in UIOpts.

2020-09-03 17:12:36 +10:00 · 2020-09-03 17:12:36 +10:00 · fcbe511d42
commit fcbe511d42
parent efc9758f82
8 changed files with 37 additions and 44 deletions
--- a/hledger-ui/Hledger/UI/AccountsScreen.hs
+++ b/hledger-ui/Hledger/UI/AccountsScreen.hs
@ -81,9 +81,7 @@ asInit d reset ui@UIState{
                        as = map asItemAccountName displayitems

    uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
-    ropts' = ropts{accountlistmode_=if tree_ ropts then ALTree else ALFlat}
-
-    q = And [queryFromOpts d ropts, excludeforecastq (forecast_ ropts)]
+    ropts' = ropts{query_=simplifyQuery $ And [query_ ropts, excludeforecastq (forecast_ ropts)]}
      where
        -- Except in forecast mode, exclude future/forecast transactions.
        excludeforecastq (Just _) = Any
@ -94,7 +92,7 @@ asInit d reset ui@UIState{
          ]

    -- run the report
-    (items,_total) = balanceReport ropts' q j
+    (items,_total) = balanceReport ropts' j

    -- pre-render the list items
    displayitem (fullacct, shortacct, indent, bal) =
@ -119,7 +117,7 @@ asInit d reset ui@UIState{
 asInit _ _ _ = error "init function called with wrong screen type, should not happen"  -- PARTIAL:

 asDraw :: UIState -> [Widget Name]
-asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
+asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts},querystring_=query}
              ,ajournal=j
              ,aScreen=s@AccountsScreen{}
              ,aMode=mode
@ -174,7 +172,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
          <+> toggles
          <+> str (" account " ++ if ishistorical then "balances" else "changes")
          <+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
-          <+> borderQueryStr querystr
+          <+> borderQueryStr query
          <+> borderDepthStr mdepth
          <+> str (" ("++curidx++"/"++totidx++")")
          <+> (if ignore_assertions_ $ inputopts_ copts
@ -192,7 +190,6 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
              ,uiShowStatus copts $ statuses_ ropts
              ,if real_ ropts then ["real"] else []
              ]
-            querystr = query_ ropts
            mdepth = depth_ ropts
            curidx = case _asList s ^. listSelectedL of
                       Nothing -> "-"
--- a/hledger-ui/Hledger/UI/Main.hs
+++ b/hledger-ui/Hledger/UI/Main.hs
@ -17,7 +17,6 @@ import Control.Concurrent.Async
 import Control.Monad
 -- import Control.Monad.IO.Class (liftIO)
 -- import Data.Monoid              --
-import Data.List
 import Data.List.Extra (nubSort)
 import Data.Maybe
 -- import Data.Text (Text)
@ -83,10 +82,9 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
         reportopts_= ropts{
            -- incorporate any depth: query args into depth_,
            -- any date: query args into period_
-            depth_ =queryDepth q,
+            depth_ =queryDepth $ query_ ropts,
            period_=periodfromoptsandargs,
-            query_ =unwords -- as in ReportOptions, with same limitations
-                    $ collectopts filteredQueryArg (rawopts_ copts),
+            query_ =filteredQuery $ query_ ropts, -- as in ReportOptions, with same limitations
            -- always disable boring account name eliding, unlike the CLI, for a more regular tree
            no_elide_=True,
            -- flip the default for items with zero amounts, show them by default
@ -97,16 +95,11 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
         }
      }
      where
-        q = queryFromOpts d ropts
-        datespanfromargs = queryDateSpan (date2_ ropts) $ fst $
-                           either error' id $ parseQuery d (T.pack $ query_ ropts)  -- PARTIAL:
+        datespanfromargs = queryDateSpan (date2_ ropts) $ query_ ropts
        periodfromoptsandargs =
          dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs]
-        filteredQueryArg = \case
-            ("args", v)
-                | not $ any (`isPrefixOf` v) ["depth:", "date:"] -- skip depth/date passed as query
-                    -> Just (quoteIfNeeded v)
-            _ -> Nothing
+        filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q]
+          where filtered = filterQuery (\x -> not $ queryIsDepth x || queryIsDate x)

    -- XXX move this stuff into Options, UIOpts
    theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $
--- a/hledger-ui/Hledger/UI/RegisterScreen.hs
+++ b/hledger-ui/Hledger/UI/RegisterScreen.hs
@ -69,7 +69,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
    ropts' = ropts{
               depth_=Nothing
              }
-    q = And [queryFromOpts d ropts', excludeforecastq (forecast_ ropts)]
+    q = And [query_ ropts', excludeforecastq (forecast_ ropts)]
      where
        -- Except in forecast mode, exclude future/forecast transactions.
        excludeforecastq (Just _) = Any
@ -138,7 +138,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
 rsInit _ _ _ = error "init function called with wrong screen type, should not happen"  -- PARTIAL:

 rsDraw :: UIState -> [Widget Name]
-rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
+rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts},querystring_=query}
              ,aScreen=RegisterScreen{..}
              ,aMode=mode
              } =
@ -201,7 +201,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
          <+> togglefilters
          <+> str " transactions"
          -- <+> str (if ishistorical then " historical total" else " period total")
-          <+> borderQueryStr (query_ ropts)
+          <+> borderQueryStr query
          -- <+> str " and subs"
          <+> borderPeriodStr "in" (period_ ropts)
          <+> str " ("
--- a/hledger-ui/Hledger/UI/TransactionScreen.hs
+++ b/hledger-ui/Hledger/UI/TransactionScreen.hs
@ -58,7 +58,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
 tsInit _ _ _ = error "init function called with wrong screen type, should not happen"  -- PARTIAL:

 tsDraw :: UIState -> [Widget Name]
-tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
+tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts},querystring_=query}
              ,ajournal=j
              ,aScreen=TransactionScreen{tsTransaction=(i,t)
                                        ,tsTransactions=nts
@ -98,7 +98,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
          <+> withAttr ("border" <> "bold") (str $ show i)
          <+> str (" of "++show (length nts))
          <+> togglefilters
-          <+> borderQueryStr (query_ ropts)
+          <+> borderQueryStr query
          <+> str (" in "++T.unpack (replaceHiddenAccountsNameWith "All" acct)++")")
          <+> (if ignore_assertions_ $ inputopts_ copts then withAttr ("border" <> "query") (str " ignoring balance assertions") else str "")
          where
@ -173,7 +173,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
            Right j' -> do
              continue $
                regenerateScreens j' d $
-                regenerateTransactions ropts d j' s acct i $   -- added (inline) 201512 (why ?)
+                regenerateTransactions ropts j' s acct i $   -- added (inline) 201512 (why ?)
                clearCostValue $
                ui
        VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
@ -208,13 +208,13 @@ tsHandle _ _ = error "event handler called with wrong screen type, should not ha

 -- Got to redo the register screen's transactions report, to get the latest transactions list for this screen.
 -- XXX Duplicates rsInit. Why do we have to do this as well as regenerateScreens ?
-regenerateTransactions :: ReportOpts -> Day -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState
-regenerateTransactions ropts d j s acct i ui =
+regenerateTransactions :: ReportOpts -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState
+regenerateTransactions ropts j s acct i ui =
  let
    ropts' = ropts {depth_=Nothing
                   ,balancetype_=HistoricalBalance
                   }
-    q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
+    q = filterQuery (not . queryIsDepth) $ query_ ropts'
    thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
    items = reverse $ snd $ accountTransactionsReport ropts j q thisacctq
    ts = map first6 items
--- a/hledger-ui/Hledger/UI/UIOptions.hs
+++ b/hledger-ui/Hledger/UI/UIOptions.hs
@ -58,15 +58,17 @@ uimode =  (mode "hledger-ui" (setopt "command" "ui" def)

 -- hledger-ui options, used in hledger-ui and above
 data UIOpts = UIOpts {
-     watch_   :: Bool
-    ,change_  :: Bool
-    ,cliopts_ :: CliOpts
+     watch_       :: Bool
+    ,change_      :: Bool
+    ,cliopts_     :: CliOpts
+    ,querystring_ :: String
 } deriving (Show)

 defuiopts = UIOpts
    def
    def
    def
+    ""

 -- instance Default CliOpts where def = defcliopts

@ -74,9 +76,10 @@ rawOptsToUIOpts :: RawOpts -> IO UIOpts
 rawOptsToUIOpts rawopts = checkUIOpts <$> do
  cliopts <- rawOptsToCliOpts rawopts
  return defuiopts {
-              watch_   = boolopt "watch" rawopts
-             ,change_  = boolopt "change" rawopts
-             ,cliopts_ = cliopts
+              watch_       = boolopt "watch" rawopts
+             ,change_      = boolopt "change" rawopts
+             ,cliopts_     = cliopts
+             ,querystring_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts
             }

 checkUIOpts :: UIOpts -> UIOpts
@ -94,4 +97,3 @@ getHledgerUIOpts = do
  let args' = replaceNumericFlags args
  let cmdargopts = either usageError id $ process uimode args'
  rawOptsToUIOpts cmdargopts
-
--- a/hledger-ui/Hledger/UI/UIState.hs
+++ b/hledger-ui/Hledger/UI/UIState.hs
@ -8,10 +8,11 @@ module Hledger.UI.UIState
 where

 import Brick.Widgets.Edit
-import Data.List
+import Data.List ((\\), foldl', sort)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
 import Data.Text.Zipper (gotoEOL)
 import Data.Time.Calendar (Day)
-import Data.Maybe (fromMaybe)

 import Hledger
 import Hledger.Cli.CliOptions
@ -239,7 +240,8 @@ resetReportPeriod = setReportPeriod PeriodAll
 -- | Apply a new filter query.
 setFilter :: String -> UIState -> UIState
 setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
-  ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{query_=s}}}}
+    ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{query_=q}},querystring_=s}}
+  where q = either (const None) fst . parseQuery undefined $ T.pack s

 -- | Reset some filters & toggles.
 resetFilter :: UIState -> UIState
@ -248,7 +250,7 @@ resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=rop
     empty_=True
    ,statuses_=[]
    ,real_=False
-    ,query_=""
+    ,query_=Any
    --,period_=PeriodAll
    }}}}

@ -305,7 +307,7 @@ showMinibuffer :: UIState -> UIState
 showMinibuffer ui = setMode (Minibuffer e) ui
  where
    e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq
-    oldq = query_ $ reportopts_ $ cliopts_ $ aopts ui
+    oldq = querystring_ $ aopts ui

 -- | Close the minibuffer, discarding any edit in progress.
 closeMinibuffer :: UIState -> UIState
--- a/hledger-web/Hledger/Web/Foundation.hs
+++ b/hledger-web/Hledger/Web/Foundation.hs
@ -130,7 +130,7 @@ instance Yesod App where
          }
        accounts =
          balanceReportAsHtml (JournalR, RegisterR) here hideEmptyAccts j q qopts $
-          balanceReport ropts' m j
+          balanceReport ropts'{query_=m} j

        topShowmd = if showSidebar then "col-md-4" else "col-any-0" :: Text
        topShowsm = if showSidebar then "col-sm-4" else "" :: Text
@ -265,7 +265,7 @@ getCurrentJournal jref opts d = do
  j <- liftIO (readIORef jref)
  (ej, changed) <- liftIO $ journalReloadIfChanged opts d j
  -- re-apply any initial filter specified at startup
-  let initq = queryFromOpts d (reportopts_ opts)
+  let initq = query_ $ reportopts_ opts
  case (changed, filterJournalTransactions initq <$> ej) of
    (False, _) -> return (j, Nothing)
    (True, Right j') -> do
--- a/hledger-web/Hledger/Web/Main.hs
+++ b/hledger-web/Hledger/Web/Main.hs
@ -58,8 +58,7 @@ runWith opts
 -- | The web command.
 web :: WebOpts -> Journal -> IO ()
 web opts j = do
-  d <- getCurrentDay
-  let initq = queryFromOpts d $ reportopts_ $ cliopts_ opts
+  let initq = query_ . reportopts_ $ cliopts_ opts
      j' = filterJournalTransactions initq j
      h = host_ opts
      p = port_ opts