diff --git a/hledger-lib/Hledger/Reports/TransactionsReports.hs b/hledger-lib/Hledger/Reports/TransactionsReports.hs index 71142db3f..5d5eeb9cd 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReports.hs +++ b/hledger-lib/Hledger/Reports/TransactionsReports.hs @@ -1,7 +1,10 @@ {-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-| -Whole-journal, account-centric, and per-commodity transactions reports, used by hledger-web. +Here are several variants of a transactions report. +Transactions reports are like a postings report, but more +transaction-oriented, and (in the account-centric variant) relative to +a some base account. They are used by hledger-web. -} @@ -58,13 +61,15 @@ triSimpleBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0" -- | Select transactions from the whole journal. This is similar to a -- "postingsReport" except with transaction-based report items which --- are ordered most recent first. This is used by eg hledger-web's journal view. +-- are ordered most recent first. XXX Or an EntriesReport - use that instead ? +-- This is used by hledger-web's journal view. journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport -journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) +journalTransactionsReport opts j q = (totallabel, items) where - ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts - items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts' -- XXX items' first element should be the full transaction with all postings + items = reverse $ accountTransactionsReportItems q Nothing nullmixedamt id ts + ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j + date = transactionDateFn opts ------------------------------------------------------------------------------- @@ -83,16 +88,20 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) -- reporting intervals are not supported, and report items are most -- recent first. accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport -accountTransactionsReport opts j m thisacctquery = (label, items) +accountTransactionsReport opts j q thisacctquery = (label, items) where -- transactions affecting this account, in date order - ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $ + curq = filterQuery queryIsSym q + ts = sortBy (comparing tdate) $ + filter (matchesTransaction thisacctquery) $ + jtxns $ + filterJournalAmounts curq $ journalSelectingAmountFromOpts opts j -- starting balance: if we are filtering by a start date and nothing else, -- the sum of postings to this account before that date; otherwise zero. - (startbal,label) | queryIsNull m = (nullmixedamt, balancelabel) - | queryIsStartDateOnly (date2_ opts) m = (sumPostings priorps, balancelabel) - | otherwise = (nullmixedamt, totallabel) + (startbal,label) | queryIsNull q = (nullmixedamt, balancelabel) + | queryIsStartDateOnly (date2_ opts) q = (sumPostings priorps, balancelabel) + | otherwise = (nullmixedamt, totallabel) where priorps = -- ltrace "priorps" $ filter (matchesPosting @@ -100,8 +109,8 @@ accountTransactionsReport opts j m thisacctquery = (label, items) And [thisacctquery, tostartdatequery])) $ transactionsPostings ts tostartdatequery = Date (DateSpan Nothing startdate) - startdate = queryStartDate (date2_ opts) m - items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts + startdate = queryStartDate (date2_ opts) q + items = reverse $ accountTransactionsReportItems q (Just thisacctquery) startbal negate ts totallabel = "Total" balancelabel = "Balance" @@ -122,10 +131,9 @@ accountTransactionsReportItems query thisacctquery bal signfn (t:ts) = Nothing -> ([],psmatched) numotheraccts = length $ nub $ map paccount psotheracct amt = negate $ sum $ map pamount psthisacct - acct | isNothing thisacctquery = summarisePostings psmatched -- journal register - | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct - | otherwise = prefix ++ summarisePostingAccounts psotheracct - where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt + acct | isNothing thisacctquery = summarisePostingAccounts psmatched + | numotheraccts == 0 = summarisePostingAccounts psthisacct + | otherwise = summarisePostingAccounts psotheracct (i,bal') = case psmatched of [] -> (Nothing,bal) _ -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b) diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index e40ab5b0d..355521d21 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -450,10 +450,16 @@ dbg2 = dbgAt 2 dbgAt :: Show a => Int -> String -> a -> a dbgAt lvl = dbgppshow lvl +-- dbgAtM :: (Monad m, Show a) => Int -> String -> a -> m a +-- dbgAtM lvl lbl x = dbgAt lvl lbl x `seq` return x +-- XXX dbgAtM :: Show a => Int -> String -> a -> IO () -dbgAtM lvl lbl x = dbgAt lvl lbl x `seq` return () +dbgAtM = dbgAtIO --- | Print this string to the console before evaluating the expression, +dbgAtIO :: Show a => Int -> String -> a -> IO () +dbgAtIO lvl lbl x = dbgAt lvl lbl x `seq` return () + +-- | print this string to the console before evaluating the expression, -- if the global debug level is non-zero. Uses unsafePerformIO. dbgtrace :: String -> a -> a dbgtrace diff --git a/hledger-web/Application.hs b/hledger-web/Application.hs index 112aa209f..1114ade83 100644 --- a/hledger-web/Application.hs +++ b/hledger-web/Application.hs @@ -31,9 +31,8 @@ import Network.HTTP.Conduit (def) -- Don't forget to add new modules to your cabal file! import Handler.RootR import Handler.JournalR -import Handler.JournalEditR -import Handler.JournalEntriesR import Handler.RegisterR +import Handler.SidebarR import Hledger.Web.Options (WebOpts(..), defwebopts) import Hledger.Data (Journal, nulljournal) diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index e1e1616d9..0adc8db02 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -104,13 +104,18 @@ instance Yesod App where pc <- widgetToPageContent $ do $(widgetFile "normalize") addStylesheet $ StaticR css_bootstrap_min_css - -- load jquery early: - toWidgetHead [hamlet| |] + -- load these things early, in HEAD: + toWidgetHead [hamlet| + + + |] + addScript $ StaticR js_bootstrap_min_js + -- addScript $ StaticR js_typeahead_bundle_min_js addScript $ StaticR js_jquery_url_js + addScript $ StaticR js_jquery_cookie_js + addScript $ StaticR js_jquery_hotkeys_js addScript $ StaticR js_jquery_flot_min_js toWidget [hamlet| \ |] - addScript $ StaticR select2_min_js - addStylesheet $ StaticR select2_css addStylesheet $ StaticR hledger_css addScript $ StaticR hledger_js $(widgetFile "default-layout") diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index fbd9160d7..24b918e0b 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -6,7 +6,6 @@ module Handler.Common where import Import import Data.List -import Data.Maybe import Data.Text(pack) import Data.Time.Calendar import System.FilePath (takeFileName) @@ -28,20 +27,39 @@ import Hledger.Web.Options import Handler.Utils ------------------------------------------------------------------------------- --- Page components +-- Common page layout + +-- | Standard hledger-web page layout. +hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerT App IO Html +hledgerLayout vd title content = do + defaultLayout $ do + setTitle $ toHtml $ title ++ " - hledger-web" + toWidget [hamlet| + + $if showsidebar vd + + + + ^{sidebar vd} + $else + + + + + ^{topbar vd} + + ^{searchform vd} + ^{content} + |] -- | Global toolbar/heading area. topbar :: ViewData -> HtmlUrl AppRoute topbar VD{..} = [hamlet| - - - hledger-web -
- \#{version} - manual -

#{title} -$maybe m' <- msg - #{m'} +