slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: show start and end dates of current filter period in heading, if any

Browse Source
This commit is contained in:
Simon Michael 2010-08-01 00:15:21 +00:00
parent 56226d72e6
commit cf62482102
3 changed files with 40 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Hledger/Cli/Commands/Web.hs
View File

@ -20,7 +20,7 @@ import Hledger.Cli.Commands.Register
import Hledger.Cli.Options hiding (value) import Hledger.Cli.Options hiding (value)
import Hledger.Cli.Utils import Hledger.Cli.Utils
import Hledger.Cli.Version (version) import Hledger.Cli.Version (version)
import Hledger.Data import Hledger.Data hiding (today)
import Hledger.Read (journalFromPathAndString) import Hledger.Read (journalFromPathAndString)
import Hledger.Read.Journal (someamount) import Hledger.Read.Journal (someamount)
#ifdef MAKE #ifdef MAKE
@ -67,6 +67,7 @@ data TemplateData = TD {
,a :: String -- ^ a (acct/desc filter pattern) parameter ,a :: String -- ^ a (acct/desc filter pattern) parameter
,p :: String -- ^ p (period expression) parameter ,p :: String -- ^ p (period expression) parameter
,j :: Journal -- ^ the current journal ,j :: Journal -- ^ the current journal
,today :: Day -- ^ the current day
} }
mktd = TD { mktd = TD {
@ -76,6 +77,7 @@ mktd = TD {
,a = "" ,a = ""
,p = "" ,p = ""
,j = nulljournal ,j = nulljournal
,today = ModifiedJulianDay 0
} }
-- | The web command. -- | The web command.
@ -171,13 +173,14 @@ getIndexPage = redirect RedirectTemporary defaultpage
getAccountsJournalPage :: Handler HledgerWebApp RepHtml getAccountsJournalPage :: Handler HledgerWebApp RepHtml
getAccountsJournalPage = do getAccountsJournalPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
today <- liftIO getCurrentDay
-- app <- getYesod -- app <- getYesod
-- t <- liftIO $ getCurrentLocalTime -- t <- liftIO $ getCurrentLocalTime
let -- args = appArgs app let -- args = appArgs app
-- fspec' = optsToFilterSpec opts args t -- fspec' = optsToFilterSpec opts args t
br = balanceReportAsHtml opts td $ balanceReport opts fspec j br = balanceReportAsHtml opts td $ balanceReport opts fspec j
jr = journalReportAsHtml opts td $ journalReport opts fspec j jr = journalReportAsHtml opts td $ journalReport opts fspec j
td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j editform' = editform td $ jtext j
hamletToRepHtml $ pageLayout td [$hamlet| hamletToRepHtml $ pageLayout td [$hamlet|
^scripts^ ^scripts^
@ -201,6 +204,7 @@ postAccountsJournalPage = postJournalOnlyPage
getAccountsRegisterPage :: Handler HledgerWebApp RepHtml getAccountsRegisterPage :: Handler HledgerWebApp RepHtml
getAccountsRegisterPage = do getAccountsRegisterPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
today <- liftIO getCurrentDay
-- app <- getYesod -- app <- getYesod
-- t <- liftIO $ getCurrentLocalTime -- t <- liftIO $ getCurrentLocalTime
let -- args = appArgs app let -- args = appArgs app
@ -208,7 +212,7 @@ getAccountsRegisterPage = do
-- fspec' = optsToFilterSpec opts' args t -- fspec' = optsToFilterSpec opts' args t
br = balanceReportAsHtml opts td $ balanceReport opts fspec j br = balanceReportAsHtml opts td $ balanceReport opts fspec j
rr = registerReportAsHtml opts td $ registerReport opts fspec j rr = registerReportAsHtml opts td $ registerReport opts fspec j
td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j editform' = editform td $ jtext j
hamletToRepHtml $ pageLayout td [$hamlet| hamletToRepHtml $ pageLayout td [$hamlet|
^scripts^ ^scripts^
@ -232,7 +236,8 @@ postAccountsRegisterPage = postJournalOnlyPage
getAccountsPage :: Handler HledgerWebApp RepHtml getAccountsPage :: Handler HledgerWebApp RepHtml
getAccountsPage = do getAccountsPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j
-- | Render a balance report as HTML. -- | Render a balance report as HTML.
@ -312,7 +317,8 @@ isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
getJournalOnlyPage :: Handler HledgerWebApp RepHtml getJournalOnlyPage :: Handler HledgerWebApp RepHtml
getJournalOnlyPage = do getJournalOnlyPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j editform' = editform td $ jtext j
txns = journalReportAsHtml opts td $ journalReport opts fspec j txns = journalReportAsHtml opts td $ journalReport opts fspec j
hamletToRepHtml $ pageLayout td [$hamlet| hamletToRepHtml $ pageLayout td [$hamlet|
@ -714,7 +720,8 @@ postImportForm = do
getRegisterOnlyPage :: Handler HledgerWebApp RepHtml getRegisterOnlyPage :: Handler HledgerWebApp RepHtml
getRegisterOnlyPage = do getRegisterOnlyPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
-- | Render a register report as HTML. -- | Render a register report as HTML.
@ -755,11 +762,12 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
getEditPage :: Handler HledgerWebApp RepHtml getEditPage :: Handler HledgerWebApp RepHtml
getEditPage = do getEditPage = do
(a, p, _, _, _, msg, here) <- getHandlerParameters (a, p, _, _, _, msg, here) <- getHandlerParameters
today <- liftIO getCurrentDay
-- reload journal's text without parsing, if changed -- XXX are we doing this right ? -- reload journal's text without parsing, if changed -- XXX are we doing this right ?
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
changed <- liftIO $ journalFileIsNewer j changed <- liftIO $ journalFileIsNewer j
s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ editform td s hamletToRepHtml $ pageLayout td $ editform td s
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -783,7 +791,7 @@ pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
metacontent = "text/html; charset=utf-8" metacontent = "text/html; charset=utf-8"
navbar :: TemplateData -> Hamlet HledgerWebAppRoute navbar :: TemplateData -> Hamlet HledgerWebAppRoute
navbar TD{j=j} = [$hamlet| navbar TD{p=p,j=j,today=today} = [$hamlet|
#navbar #navbar
%a.topleftlink!href=$hledgerurl$ %a.topleftlink!href=$hledgerurl$
hledger hledger
@ -791,8 +799,15 @@ navbar TD{j=j} = [$hamlet|
$version$ $version$
%a.toprightlink!href=$manualurl$!target=hledgerhelp manual %a.toprightlink!href=$manualurl$!target=hledgerhelp manual
%h1 $journaltitle$ %h1 $journaltitle$
\ $
%span#journalinfo $journalinfo$
|] |]
where journaltitle = printf "%s" (takeFileName $ filepath j) :: String where
journaltitle = printf "%s" (takeFileName $ filepath j) :: String
journalinfo = printf "%s" (showspan span) :: String
showspan (DateSpan Nothing Nothing) = ""
showspan s = " (showing " ++ dateSpanAsText s ++ ")"
span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p)
navlinks :: TemplateData -> Hamlet HledgerWebAppRoute navlinks :: TemplateData -> Hamlet HledgerWebAppRoute
navlinks td = [$hamlet| navlinks td = [$hamlet|

8
Hledger/Cli/Options.hs
View File

@ -200,7 +200,9 @@ fixOptDates opts = do
-- others are ignored. -- others are ignored.
dateSpanFromOpts :: Day -> [Opt] -> DateSpan dateSpanFromOpts :: Day -> [Opt] -> DateSpan
dateSpanFromOpts refdate opts dateSpanFromOpts refdate opts
| not $ null popts = snd $ parsePeriodExpr refdate $ last popts | not (null popts) = case parsePeriodExpr refdate $ last popts of
Right (_, s) -> s
Left e -> parseerror e
| otherwise = DateSpan lastb laste | otherwise = DateSpan lastb laste
where where
popts = optValuesForConstructor Period opts popts = optValuesForConstructor Period opts
@ -216,7 +218,9 @@ dateSpanFromOpts refdate opts
intervalFromOpts :: [Opt] -> Interval intervalFromOpts :: [Opt] -> Interval
intervalFromOpts opts = intervalFromOpts opts =
case (periodopts, intervalopts) of case (periodopts, intervalopts) of
((p:_), _) -> fst $ parsePeriodExpr d p where d = parsedate "0001/01/01" -- unused ((p:_), _) -> case parsePeriodExpr (parsedate "0001/01/01") p of
Right (i, _) -> i
Left e -> parseerror e
(_, (DailyOpt:_)) -> Daily (_, (DailyOpt:_)) -> Daily
(_, (WeeklyOpt:_)) -> Weekly (_, (WeeklyOpt:_)) -> Weekly
(_, (MonthlyOpt:_)) -> Monthly (_, (MonthlyOpt:_)) -> Monthly

14
hledger-lib/Hledger/Data/Dates.hs
View File

@ -86,10 +86,16 @@ orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
b = if isJust b1 then b1 else b2 b = if isJust b1 then b1 else b2
-- | Parse a period expression to an Interval and overall DateSpan using -- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date, or raise an error. -- the provided reference date, or return a parse error.
parsePeriodExpr :: Day -> String -> (Interval, DateSpan) parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan)
parsePeriodExpr refdate expr = (interval,span) parsePeriodExpr refdate = parsewith (periodexpr refdate)
where (interval,span) = fromparse $ parsewith (periodexpr refdate) expr
-- | Show a DateSpan as a human-readable pseudo-period-expression string.
dateSpanAsText :: DateSpan -> String
dateSpanAsText (DateSpan Nothing Nothing) = "all"
dateSpanAsText (DateSpan Nothing (Just e)) = printf "to %s" (show e)
dateSpanAsText (DateSpan (Just b) Nothing) = printf "from %s" (show b)
dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e)
-- | Convert a single smart date string to a date span using the provided -- | Convert a single smart date string to a date span using the provided
-- reference date, or raise an error. -- reference date, or raise an error.