diff --git a/hledger-web/.hledger/web/static/style.css b/hledger-web/.hledger/web/static/style.css index 7ef63a575..063b736e1 100644 --- a/hledger-web/.hledger/web/static/style.css +++ b/hledger-web/.hledger/web/static/style.css @@ -39,7 +39,7 @@ input.textinput, .dhx_combo_input, .dhx_combo_list { font-size:small; } .journalreport { font-size:small; } .balancereport { font-size:small; } .registerreport { font-size:small; } -#showmoreaccounts { font-size:small; } +.showall { font-size:small; } /* #addformlink { font-size:small; } */ /* #editformlink { font-size:small; } */ @@ -77,7 +77,7 @@ body { margin:0; } #main .journal { } #main .register { } -/* .current { font-weight:bold; } */ +.current { font-weight:bold; } .description { padding-left:1em; white-space:normal; } .account { white-space:normal; padding-left:1em; } .amount { white-space:nowrap; padding-left:1em; } @@ -102,7 +102,6 @@ table.registerreport { border-spacing:0; } .registerreport .date { white-space:nowrap; } .firstposting td { } #accountsheading { white-space:nowrap; margin-bottom:1em; } -#showmoreaccounts { font-weight:bold; } #addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list { padding:4px; } diff --git a/hledger-web/.hledger/web/templates/accountsheading.hamlet b/hledger-web/.hledger/web/templates/accountsheading.hamlet index 6500c1f88..cd224083e 100644 --- a/hledger-web/.hledger/web/templates/accountsheading.hamlet +++ b/hledger-web/.hledger/web/templates/accountsheading.hamlet @@ -1,4 +1,6 @@ show all diff --git a/hledger-web/.hledger/web/templates/accountsheadinglinks.hamlet b/hledger-web/.hledger/web/templates/accountsheadinglinks.hamlet deleted file mode 100644 index 06c1eae6c..000000000 --- a/hledger-web/.hledger/web/templates/accountsheadinglinks.hamlet +++ /dev/null @@ -1 +0,0 @@ -^{showmore} ^{showall} \ No newline at end of file diff --git a/hledger-web/.hledger/web/templates/accountsheadinglinksall.hamlet b/hledger-web/.hledger/web/templates/accountsheadinglinksall.hamlet deleted file mode 100644 index c1e88a2d5..000000000 --- a/hledger-web/.hledger/web/templates/accountsheadinglinksall.hamlet +++ /dev/null @@ -1,2 +0,0 @@ -\ | # -show all diff --git a/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet b/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet deleted file mode 100644 index 1b411a2dd..000000000 --- a/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet +++ /dev/null @@ -1,2 +0,0 @@ -\ | # -show more ↑ diff --git a/hledger-web/.hledger/web/templates/balancereportitem.hamlet b/hledger-web/.hledger/web/templates/balancereportitem.hamlet index 1c4ffb020..577ebf997 100644 --- a/hledger-web/.hledger/web/templates/balancereportitem.hamlet +++ b/hledger-web/.hledger/web/templates/balancereportitem.hamlet @@ -1,5 +1,5 @@ #{adisplay} + #{adisplay} #{mixedAmountAsHtml abal} diff --git a/hledger-web/.hledger/web/templates/filterform.hamlet b/hledger-web/.hledger/web/templates/filterform.hamlet index deca599b8..e785a6b4c 100644 --- a/hledger-web/.hledger/web/templates/filterform.hamlet +++ b/hledger-web/.hledger/web/templates/filterform.hamlet @@ -7,6 +7,7 @@ \ # show all diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs index 48ab68f7e..9788c41a5 100644 --- a/hledger-web/Handlers.hs +++ b/hledger-web/Handlers.hs @@ -18,7 +18,6 @@ import Data.Time.Calendar import System.FilePath (takeFileName, ()) import System.IO.Storage (putValue, getValue) import Text.Hamlet hiding (hamletFile) -import Text.ParserCombinators.Parsec -- hiding (string) import Text.Printf import Text.RegexPR import Yesod.Form @@ -56,9 +55,9 @@ getRootR = redirect RedirectTemporary defaultroute where defaultroute = Register -- | The main journal view, with accounts sidebar. getJournalR :: Handler RepHtml getJournalR = do - vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData - let sidecontent = balanceReportAsHtml opts vd $ balanceReport opts fspec j - maincontent = journalReportAsHtml opts vd $ journalReport opts fspec j + vd@VD{opts=opts,m=m,j=j} <- getViewData + let sidecontent = balanceReportAsHtml opts vd{q=""} $ balanceReport opts nullfilterspec j + maincontent = journalReportAsHtml opts vd $ journalReport opts nullfilterspec $ filterJournalTransactions2 m j defaultLayout $ do setTitle "hledger-web journal" addHamlet $(Settings.hamletFile "journal") @@ -69,9 +68,9 @@ postJournalR = handlePost -- | The main register view, with accounts sidebar. getRegisterR :: Handler RepHtml getRegisterR = do - vd@VD{opts=opts,fspec=fspec,m=m,j=j} <- getViewData - let sidecontent = balanceReportAsHtml opts vd $ balanceReport opts fspec $ filterJournalPostings2 m j - maincontent = registerReportAsHtml opts vd $ registerReport opts fspec $ filterJournalPostings2 m j + vd@VD{opts=opts,m=m,j=j} <- getViewData + let sidecontent = balanceReportAsHtml opts vd{q=""} $ balanceReport opts nullfilterspec j + maincontent = registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j editform' = editform vd defaultLayout $ do setTitle "hledger-web register" @@ -83,10 +82,10 @@ postRegisterR = handlePost -- | A simple journal view, like hledger print (with editing.) getJournalOnlyR :: Handler RepHtml getJournalOnlyR = do - vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData + vd@VD{opts=opts,m=m,j=j} <- getViewData defaultLayout $ do setTitle "hledger-web journal only" - addHamlet $ journalReportAsHtml opts vd $ journalReport opts fspec j + addHamlet $ journalReportAsHtml opts vd $ journalReport opts nullfilterspec $ filterJournalTransactions2 m j postJournalOnlyR :: Handler RepPlain postJournalOnlyR = handlePost @@ -94,63 +93,60 @@ postJournalOnlyR = handlePost -- | A simple postings view, like hledger register (with editing.) getRegisterOnlyR :: Handler RepHtml getRegisterOnlyR = do - vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData + vd@VD{opts=opts,m=m,j=j} <- getViewData defaultLayout $ do setTitle "hledger-web register only" - addHamlet $ registerReportAsHtml opts vd $ registerReport opts fspec j + addHamlet $ registerReportAsHtml opts vd $ registerReport opts nullfilterspec $ filterJournalPostings2 m j postRegisterOnlyR :: Handler RepPlain postRegisterOnlyR = handlePost -- | A simple accounts view, like hledger balance. If the Accept header -- specifies json, returns the chart of accounts as json. -getAccountsOnlyR :: Handler RepHtmlJson -getAccountsOnlyR = do - vd@VD{opts=opts,fspec=fspec,j=j,a=a} <- getViewData - let accountNames = journalAccountNames j :: [AccountName] - accountNames' = filter (matchpats [a]) $ accountNames - json = jsonMap [("accounts", toJSON $ accountNames')] +getAccountsR :: Handler RepHtmlJson +getAccountsR = do + vd@VD{opts=opts,m=m,j=j} <- getViewData + let j' = filterJournalPostings2 m j html = do setTitle "hledger-web accounts" - addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts fspec j + addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts nullfilterspec j' + json = jsonMap [("accounts", toJSON $ journalAccountNames j')] defaultLayoutJson html json -- | Return the chart of accounts as json, without needing a special Accept header. getAccountsJsonR :: Handler RepJson getAccountsJsonR = do - VD{a=a,j=j} <- getViewData - let accountNames = journalAccountNames j :: [AccountName] - accountNames' = filter (matchpats [a]) $ accountNames - jsonToRepJson $ jsonMap [("accounts", toJSON $ accountNames')] + VD{m=m,j=j} <- getViewData + let j' = filterJournalPostings2 m j + jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')] -- helpers -- | Render a balance report as HTML. balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute -balanceReportAsHtml _ vd@VD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport") +balanceReportAsHtml _ vd@VD{here=here,q=q} (items,total) = $(Settings.hamletFile "balancereport") where itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute - itemAsHtml VD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem") + itemAsHtml VD{here=here,q=q} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem") where indent = preEscapedString $ concat $ replicate (2 * adepth) " " - acctpat = accountNameToAccountRegex acct - pparam = if null p then "" else "&p="++p + accturl = (here, [("q", pack $ "otheracct:" ++ quoteIfSpaced (accountNameToAccountRegex acct))]) accountsheading = $(Settings.hamletFile "accountsheading") where - filteringaccts = not $ null a - showlinks = $(Settings.hamletFile "accountsheadinglinks") - showmore = case (filteringaccts, items) of - -- cunning parent account logic - (True, ((acct, _, _, _):_)) -> - let a' = if isAccountRegex a then a else acct - a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' - parenturl = (here, [("a",pack a''), ("p",pack p)]) - in $(Settings.hamletFile "accountsheadinglinksmore") - _ -> nulltemplate - showall = if filteringaccts - then $(Settings.hamletFile "accountsheadinglinksall") - else nulltemplate - where allurl = (here, [("p",pack p)]) + filtering = not $ null q + -- showlinks = $(Settings.hamletFile "accountsheadinglinks") + -- showmore = case (filteringaccts, items) of + -- -- cunning parent account logic + -- (True, ((acct, _, _, _):_)) -> + -- let a' = if isAccountRegex a then a else acct + -- a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' + -- parenturl = (here, [("a",pack a''), ("p",pack p)]) + -- in $(Settings.hamletFile "accountsheadinglinksmore") + -- _ -> nulltemplate + -- showall = if filteringaccts + -- then $(Settings.hamletFile "accountsheadinglinksall") + -- else nulltemplate + -- where allurl = (here, []) -- | Render a journal report as HTML. journalReportAsHtml :: [Opt] -> ViewData -> JournalReport -> Hamlet AppRoute @@ -167,14 +163,13 @@ registerReportAsHtml :: [Opt] -> ViewData -> RegisterReport -> Hamlet AppRoute registerReportAsHtml _ vd items = $(Settings.hamletFile "registerreport") where itemAsHtml :: ViewData -> (Int, RegisterReportItem) -> Hamlet AppRoute - itemAsHtml VD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") + itemAsHtml VD{here=here} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") where evenodd = if even n then "even" else "odd" :: String (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) Nothing -> ("", "", "") :: (String,String,String) acct = paccount posting - acctpat = accountNameToAccountRegex acct - pparam = if null p then "" else "&p="++p + accturl = (here, [("q", pack $ "otheracct:" ++ quoteIfSpaced (accountNameToAccountRegex acct))]) mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ show b where addclass = printf "%s" (c :: String) @@ -318,20 +313,9 @@ handleImport = do -- | Global toolbar/heading area. topbar :: ViewData -> Hamlet AppRoute -topbar VD{p=p,j=j,msg=msg,today=today} = $(Settings.hamletFile "topbar") +topbar VD{j=j,msg=msg,today=today} = $(Settings.hamletFile "topbar") where - (title, desc) = journalTitleDesc j p today - --- | Generate a title and description for the given journal, period --- expression, and date. -journalTitleDesc :: Journal -> String -> Day -> (String, String) -journalTitleDesc j p today = (title, desc) - where - title = printf "%s" (takeFileName $ journalFilePath j) :: String - desc = printf "%s" (showspan span) :: String - span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p) - showspan (DateSpan Nothing Nothing) = "" - showspan s = " (" ++ dateSpanAsText s ++ ")" + title = takeFileName $ journalFilePath j -- | Links to navigate between the main views. navlinks :: ViewData -> Hamlet AppRoute @@ -340,9 +324,8 @@ navlinks vd = $(Settings.hamletFile "navlinks") accountsjournallink = navlink vd "transactions" JournalR accountsregisterlink = navlink vd "postings" RegisterR navlink :: ViewData -> String -> AppRoute -> Hamlet AppRoute - navlink VD{here=here,a=a,p=p} s dest = $(Settings.hamletFile "navlink") - where u = (dest, concat [(if null a then [] else [("a", pack a)]) - ,(if null p then [] else [("p", pack p)])]) + navlink VD{here=here,q=q} s dest = $(Settings.hamletFile "navlink") + where u = (dest, if null q then [] else [("q", pack q)]) style | dest == here = "navlinkcurrent" | otherwise = "navlink" :: Text @@ -357,10 +340,10 @@ helplink topic label = $(Settings.hamletFile "helplink") -- | Form controlling journal filtering parameters. filterform :: ViewData -> Hamlet AppRoute -filterform VD{here=here,a=a,p=p,q=q} = $(Settings.hamletFile "filterform") +filterform VD{here=here,q=q} = $(Settings.hamletFile "filterform") where - ahelp = helplink "filter-patterns" "?" - phelp = helplink "period-expressions" "?" + -- ahelp = helplink "filter-patterns" "?" + -- phelp = helplink "period-expressions" "?" filtering = not $ null q visible = "block" :: String filteringclass = if filtering then "filtering" else "" :: String @@ -413,17 +396,14 @@ journalselect journalfiles = $(Settings.hamletFile "journalselect") -- utilities nulltemplate :: Hamlet AppRoute -nulltemplate = [$hamlet||] +nulltemplate = [hamlet||] -- | A bundle of data useful for handlers and their templates. data ViewData = VD { opts :: [Opt] -- ^ command-line options at startup - ,a :: String -- ^ current a (query) parameter - ,p :: String -- ^ current p (query) parameter ,q :: String -- ^ current q (query) parameter - ,fspec :: FilterSpec -- ^ a journal filter specification based on the above ,m :: Matcher -- ^ a search/filter expression based on the above - ,j :: Journal -- ^ an up-to-date parsed journal + ,j :: Journal -- ^ the up-to-date parsed unfiltered journal ,today :: Day -- ^ the current day ,here :: AppRoute -- ^ the current route ,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request @@ -432,10 +412,7 @@ data ViewData = VD { mkvd :: ViewData mkvd = VD { opts = [] - ,a = "" - ,p = "" ,q = "" - ,fspec = nullfilterspec ,m = MatchOr [] ,j = nulljournal ,today = ModifiedJulianDay 0 @@ -446,25 +423,16 @@ mkvd = VD { -- | Gather data useful for a hledger-web request handler and its templates. getViewData :: Handler ViewData getViewData = do - Just here' <- getCurrentRoute - (q, opts, fspec, m) <- getCurrentParameters - (j, err) <- getCurrentJournal opts - msg <- getMessageOr err - today <- liftIO getCurrentDay - return mkvd{opts=opts, q=q, fspec=fspec, m=m, j=j, today=today, here=here', msg=msg} + app <- getYesod + let opts = appOpts app + (j, err) <- getCurrentJournal opts + msg <- getMessageOr err + Just here' <- getCurrentRoute + today <- liftIO getCurrentDay + q <- getParameter "q" + let m = parseMatcher today q + return mkvd{opts=opts, q=q, m=m, j=j, today=today, here=here', msg=msg} where - -- | Get current report parameters for this request. - getCurrentParameters :: Handler (String, [Opt], FilterSpec, Matcher) - getCurrentParameters = do - app <- getYesod - t <- liftIO $ getCurrentLocalTime - q <- unpack `fmap` fromMaybe "" <$> lookupGetParam "q" - let opts = appOpts app -- ++ [Period p'] - args = appArgs app -- ++ words' a' - fspec = optsToFilterSpec opts args t - m = parseMatcher q - return (q, opts, fspec, m) - -- | Update our copy of the journal if the file changed. If there is an -- error while reloading, keep the old one and return the error, and set a -- ui message. @@ -480,18 +448,9 @@ getViewData = do Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-} return (j, Just e) - -parseMatcher :: String -> Matcher -parseMatcher s = MatchOr $ map (MatchAcct True) $ words' s - -parseMatcher2 :: String -> Matcher -parseMatcher2 s = either (const (MatchOr [])) id $ runParser matcher () "" $ lexmatcher s - -lexmatcher :: String -> [String] -lexmatcher s = words' s - -matcher :: GenParser String () Matcher -matcher = undefined + -- | Get the named request parameter. + getParameter :: String -> Handler String + getParameter p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) -- | Get the message set by the last request, or the newer message provided, if any. getMessageOr :: Maybe String -> Handler (Maybe Html) diff --git a/hledger-web/routes b/hledger-web/routes index 3e9d6d92c..4824aa132 100644 --- a/hledger-web/routes +++ b/hledger-web/routes @@ -6,5 +6,5 @@ /register RegisterR GET POST /journalonly JournalOnlyR GET POST /registeronly RegisterOnlyR GET POST -/accountsonly AccountsOnlyR GET +/accounts AccountsR GET /accountsjson AccountsJsonR GET