simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

web: cleanup, fixes; migration to yesod 0.8 and filesystem templates is complete

Browse Source
This commit is contained in:
Simon Michael 2011-05-27 02:43:03 +00:00
parent b51c77032a
commit 35607f3759
20 changed files with 292 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hledger-web/.hledger/web/static/hledger.js
View File

@ -14,7 +14,7 @@ function filterformToggle() {
var e = document.getElementById('editform');
var f = document.getElementById('filterform');
var i = document.getElementById('importform');
var t = document.getElementById('transactions');
var c = document.getElementById('maincontent');
var alink = document.getElementById('addformlink');
var elink = document.getElementById('editformlink');
var flink = document.getElementById('filterformlink');
@ -37,7 +37,7 @@ function addformToggle(ev) {
var e = document.getElementById('editform');
var f = document.getElementById('filterform');
var i = document.getElementById('importform');
var t = document.getElementById('transactions');
var c = document.getElementById('maincontent');
var alink = document.getElementById('addformlink');
var elink = document.getElementById('editformlink');
var flink = document.getElementById('filterformlink');
@ -54,7 +54,7 @@ function addformToggle(ev) {
if (a) a.style.display = 'block';
if (e) e.style.display = 'none';
if (i) i.style.display = 'none';
if (t) t.style.display = 'none';
if (c) c.style.display = 'none';
} else {
if (alink) alink.style['font-weight'] = 'normal';
if (elink) elink.style['font-weight'] = 'normal';
@ -62,7 +62,7 @@ function addformToggle(ev) {
if (a) a.style.display = 'none';
if (e) e.style.display = 'none';
if (i) i.style.display = 'none';
if (t) t.style.display = 'block';
if (c) c.style.display = 'block';
}
return false;
}
@ -73,7 +73,7 @@ function editformToggle(ev) {
var ej = document.getElementById('journalselect');
var f = document.getElementById('filterform');
var i = document.getElementById('importform');
var t = document.getElementById('transactions');
var c = document.getElementById('maincontent');
var alink = document.getElementById('addformlink');
var elink = document.getElementById('editformlink');
var flink = document.getElementById('filterformlink');
@ -89,7 +89,7 @@ function editformToggle(ev) {
if (rlink) rlink.style['font-weight'] = 'normal';
if (a) a.style.display = 'none';
if (i) i.style.display = 'none';
if (t) t.style.display = 'none';
if (c) c.style.display = 'none';
if (e) e.style.display = 'block';
editformJournalSelect(ev);
} else {
@ -99,7 +99,7 @@ function editformToggle(ev) {
if (a) a.style.display = 'none';
if (e) e.style.display = 'none';
if (i) i.style.display = 'none';
if (t) t.style.display = 'block';
if (c) c.style.display = 'block';
}
return false;
}
@ -133,7 +133,7 @@ function importformToggle(ev) {
var e = document.getElementById('editform');
var f = document.getElementById('filterform');
var i = document.getElementById('importform');
var t = document.getElementById('transactions');
var c = document.getElementById('maincontent');
var alink = document.getElementById('addformlink');
var elink = document.getElementById('editformlink');
var flink = document.getElementById('filterformlink');
@ -150,7 +150,7 @@ function importformToggle(ev) {
if (a) a.style.display = 'none';
if (e) e.style.display = 'none';
if (i) i.style.display = 'block';
if (t) t.style.display = 'none';
if (c) c.style.display = 'none';
} else {
if (alink) alink.style['font-weight'] = 'normal';
if (elink) elink.style['font-weight'] = 'normal';
@ -158,7 +158,7 @@ function importformToggle(ev) {
if (a) a.style.display = 'none';
if (e) e.style.display = 'none';
if (i) i.style.display = 'none';
if (t) t.style.display = 'block';
if (c) c.style.display = 'block';
}
return false;
}

24
hledger-web/.hledger/web/static/style.css
View File

@ -1,10 +1,3 @@
/* LOCAL:
hledger-web executables built in this repo will include these local styles
when generating the web support files
*/
body { border-top: thin solid red; }
/* END LOCAL */
/* hledger web ui styles */
/*------------------------------------------------------------------------------------------*/
@ -25,7 +18,7 @@ body { backgroun
/* .journalreport td { border-color:thin solid #eee; } see below */
.negative { color:#800; }
#messages { color:red; background-color:#fee; }
#message { color:red; background-color:#fee; }
#addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list { background-color:#eee; }
#editform textarea { background-color:#eee; }
@ -54,20 +47,19 @@ input.textinput, .dhx_combo_input, .dhx_combo_list { font-size:small; }
/* 3. layout */
body { margin:0; }
#content { padding:1em 0 0 0.5em; }
#navbar { padding:2px; }
#topbar { padding:2px; }
.topleftlink { float:left; margin-right:1em; padding:2px; }
.toprightlink { float:right; margin-left:1em; padding:2px; }
#navbar h1 { display:inline-block; vertical-align:top; margin:0; }
#topbar h1 { display:inline-block; vertical-align:top; margin:0; }
#journalinfo { vertical-align:middle; margin:0; }
/* #navbar { padding:4px; border-bottom:2px solid #ddd; } */
/* #topbar { padding:4px; border-bottom:2px solid #ddd; } */
#messages { margin:0.5em;}
#message { margin:0.5em;}
.help { font-style: italic; }
.helprow td { padding-bottom:8px; }
#content { padding:4px; }
#sidebar { float:left; padding-right:1em; margin-bottom:5em; }
#main { overflow:auto; border-left:thin solid #ded; padding-left:1em; }
@ -109,8 +101,8 @@ table.registerreport { border-spacing:0; }
.registerreport td { padding-bottom:0.2em; }
.registerreport .date { white-space:nowrap; }
.firstposting td { }
#accountsheading { font-weight:bold; white-space:nowrap; margin-bottom:1em; }
#showmoreaccounts { }
#accountsheading { white-space:nowrap; margin-bottom:1em; }
#showmoreaccounts { font-weight:bold; }
#addform input.textinput, #addform .dhx_combo_input, .dhx_combo_list { padding:4px; }

8
hledger-web/.hledger/web/templates/accountsheading.hamlet
View File

@ -1,4 +1,4 @@
<span#accountsheading
accounts
\ #
^{showlinks}
<div#accountsheading
accounts
\ #
^{showlinks}

4
hledger-web/.hledger/web/templates/accountsheadinglinksall.hamlet
View File

@ -1,2 +1,2 @@
\ | #
<a href=@?{allurl}>show all
\ | #
<a href=@?{allurl}>show all

5
hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet
View File

@ -1,3 +1,2 @@
\ | #
<a href=@?{parenturl}>show more &uarr;
|]
\ | #
<a href=@?{parenturl}>show more &uarr;

6
hledger-web/.hledger/web/templates/addform.hamlet
View File

@ -38,11 +38,11 @@
<td
<td
<span.help>#{deschelp}
^{postingfields td 1}
^{postingfields td 2}
^{postingfields vd 1}
^{postingfields vd 2}
<tr#addbuttonrow
<td colspan=4
<input type=hidden name=action value=add
<input type=submit name=submit value="add transaction"
$if manyfiles
\ to: ^{journalselect $ files $ j td}
\ to: ^{journalselect $ files $ j vd}

9
hledger-web/.hledger/web/templates/default-layout.hamlet
View File

@ -1,8 +1,8 @@
!!!
<html
<head
<title>#{pageTitle pc}
^{pageHead pc}
<title>#{pageTitle pc}
^{pageHead pc}
<meta http-equiv=Content-Type content="text/html; charset=utf-8"
<script type=text/javascript src=@{StaticR jquery_js}
<script type=text/javascript src=@{StaticR jquery_url_js}
@ -11,7 +11,4 @@
<script type=text/javascript src=@{StaticR hledger_js}
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
<body
$maybe msg <- mmsg
<div #message>#{msg}
<div#content
^{pageBody pc}
^{pageBody pc}

17
hledger-web/.hledger/web/templates/hledger-layout.hamlet
View File

@ -1,17 +0,0 @@
!!!
<html
<head
<title>#{title'}
<meta http-equiv=Content-Type content=#{metacontent}
<script type=text/javascript src=@{StaticR jquery_js}
<script type=text/javascript src=@{StaticR jquery_url_js}
<script type=text/javascript src=@{StaticR dhtmlxcommon_js}
<script type=text/javascript src=@{StaticR dhtmlxcombo_js}
<script type=text/javascript src=@{StaticR hledger_js}
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
<body
^{navbar td}
<div#messages>#{m}
<div#content
^{content}
|]

4
hledger-web/.hledger/web/templates/homepage.cassius
View File

@ -1,4 +0,0 @@
h1
text-align: center
h2##{h2id}
color: #990

2
hledger-web/.hledger/web/templates/homepage.hamlet
View File

@ -1,2 +0,0 @@
<h1>Hello
<h2 ##{h2id}>You could have Javascript enabled.

3
hledger-web/.hledger/web/templates/homepage.julius
View File

@ -1,3 +0,0 @@
window.onload = function(){
document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";
}

22
hledger-web/.hledger/web/templates/journal.hamlet
View File

@ -1,10 +1,12 @@
<div#sidebar
^{sidecontent}
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
^{topbar vd}
<div#content
<div#sidebar
^{sidecontent}
<div#main.journal
^{navlinks vd}
<div#maincontent
^{filterform vd}
^{maincontent}
^{addform vd}
^{editform vd}
^{importform}

9
hledger-web/.hledger/web/templates/journalonly.hamlet
View File

@ -1,6 +1,7 @@
<div.journal
^{editlinks}
<div#transactions
^{txns}
^{addform td}
^{editform'}
<div#maincontent
^{maincontent}
^{addform vd}
^{editform vd}
^{importform}

9
hledger-web/.hledger/web/templates/navbar.hamlet
View File

@ -1,9 +0,0 @@
<div#navbar
<a.topleftlink href=#{hledgerorgurl}
hledger-web
<br />
#{version}
<a.toprightlink href=#{manualurl} target=hledgerhelp>manual
<h1>#{title}
\ #
<span#journaldesc>#{desc}

22
hledger-web/.hledger/web/templates/register.hamlet
View File

@ -1,10 +1,12 @@
<div#sidebar
^{sidecontent}
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
^{topbar vd}
<div#content
<div#sidebar
^{sidecontent}
<div#main.register
^{navlinks vd}
<div#maincontent
^{filterform vd}
^{maincontent}
^{addform vd}
^{editform vd}
^{importform}

7
hledger-web/.hledger/web/templates/registeronly.hamlet Normal file
View File

@ -0,0 +1,7 @@
<div.register
^{editlinks}
<div#maincontent
^{maincontent}
^{addform vd}
^{editform vd}
^{importform}

11
hledger-web/.hledger/web/templates/topbar.hamlet Normal file
View File

@ -0,0 +1,11 @@
<div#topbar
<a.topleftlink href=#{hledgerorgurl}
hledger-web
<br />
#{version}
<a.toprightlink href=#{manualurl} target=hledgerhelp>manual
<h1>#{title}
\ #
<span#journaldesc>#{desc}
$maybe m <- msg
<div#message>#{m}

2
hledger-web/App.hs
View File

@ -75,7 +75,7 @@ instance Yesod App where
approot = appRoot
defaultLayout widget = do
mmsg <- return (Nothing :: Maybe String) -- getMessage -- XXX let getHandlerData get it
-- mmsg <- getMessage
pc <- widgetToPageContent $ do
widget
addCassius $(Settings.cassiusFile "default-layout")

431
hledger-web/Handlers.hs
View File

@ -1,4 +1,10 @@
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
{-
hledger-web's request handlers, and helpers.
-}
module Handlers where
import Control.Applicative ((<$>), (<*>))
@ -31,87 +37,91 @@ import Hledger.Utils
import App
import Settings
import StaticFiles
----------------------------------------------------------------------
-- handlers/views
----------------------------------------------------------------------
-- Some default handlers that ship with the Yesod site template. You will
-- very rarely need to modify this.
getFaviconR :: Handler ()
getFaviconR = sendFile "image/x-icon" $ Settings.staticdir </> "favicon.ico"
getRobotsR :: Handler RepPlain
getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
----------------------------------------------------------------------
getRootR :: Handler RepHtml
getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR
----------------------------------------------------------------------
-- main views
-- | The main journal view, with accounts sidebar.
getJournalR :: Handler RepHtml
getJournalR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
-- app <- getYesod
-- t <- liftIO $ getCurrentLocalTime
let -- args = appArgs app
-- fspec' = optsToFilterSpec opts args t
sidecontent = balanceReportAsHtml opts td $ balanceReport opts fspec j
maincontent = journalReportAsHtml opts td $ journalReport opts fspec j
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td
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
editform' = editform vd
defaultLayout $ do
setTitle "hledger-web journal"
addHamlet $(Settings.hamletFile "journal")
postJournalR :: Handler RepPlain
postJournalR = postJournalOnlyR
----------------------------------------------------------------------
postJournalR = handlePost
-- | The main register view, with accounts sidebar.
getRegisterR :: Handler RepHtml
getRegisterR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
-- app <- getYesod
-- t <- liftIO $ getCurrentLocalTime
let -- args = appArgs app
-- opts' = Empty:opts
-- fspec' = optsToFilterSpec opts' args t
sidecontent = balanceReportAsHtml opts td $ balanceReport opts fspec j
maincontent = registerReportAsHtml opts td $ registerReport opts fspec j
td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td
vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
let sidecontent = balanceReportAsHtml opts vd $ balanceReport opts fspec j
maincontent = registerReportAsHtml opts vd $ registerReport opts fspec j
editform' = editform vd
defaultLayout $ do
setTitle "hledger-web register"
addHamlet $(Settings.hamletFile "register")
postRegisterR :: Handler RepPlain
postRegisterR = postJournalOnlyR
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
defaultLayout $ do
setTitle "hledger-web journal only"
addHamlet $ journalReportAsHtml opts vd $ journalReport opts fspec j
postJournalOnlyR :: Handler RepPlain
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
defaultLayout $ do
setTitle "hledger-web register only"
addHamlet $ registerReportAsHtml opts vd $ registerReport opts fspec j
postRegisterOnlyR :: Handler RepPlain
postRegisterOnlyR = handlePost
-- | A simple accounts view, like hledger balance.
getAccountsOnlyR :: Handler RepHtml
getAccountsOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger accounts", msg=msg, a=a, p=p, j=j, today=today}
vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
defaultLayout $ do
setTitle "hledger-web accounts"
addHamlet $ balanceReportAsHtml opts td $ balanceReport opts fspec j
addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts fspec j
-- helpers
-- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute
balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport")
balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
balanceReportAsHtml _ vd@VD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport")
where
itemAsHtml' = itemAsHtml vd
itemAsHtml :: ViewData -> BalanceReportItem -> Hamlet AppRoute
itemAsHtml VD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem")
where
indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
acctpat = accountNameToAccountRegex acct
pparam = if null p then "" else "&p="++p
accountsheading = $(Settings.hamletFile "accountsheading")
where
filteringaccts = not $ null a
@ -128,109 +138,27 @@ balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = $(Settings.hamlet
then $(Settings.hamletFile "accountsheadinglinksall")
else nulltemplate
where allurl = (here, [("p",pack p)])
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute
itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem")
where
indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
acctpat = accountNameToAccountRegex acct
pparam = if null p then "" else "&p="++p
accountNameToAccountRegex :: String -> String
accountNameToAccountRegex "" = ""
accountNameToAccountRegex a = printf "^%s(:|$)" a
accountRegexToAccountName :: String -> String
accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
isAccountRegex :: String -> Bool
isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
----------------------------------------------------------------------
-- | A simple journal view, like hledger print (with editing.)
getJournalOnlyR :: Handler RepHtml
getJournalOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td
txns = journalReportAsHtml opts td $ journalReport opts fspec j
defaultLayout $ do
setTitle "hledger-web journal only"
addHamlet $(Settings.hamletFile "journalonly")
-- | Render a journal report as HTML.
journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute
journalReportAsHtml _ td items = $(Settings.hamletFile "journalreport")
journalReportAsHtml :: [Opt] -> ViewData -> JournalReport -> Hamlet AppRoute
journalReportAsHtml _ vd items = $(Settings.hamletFile "journalreport")
where
number = zip [1..]
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute
itemAsHtml' = itemAsHtml vd
itemAsHtml :: ViewData -> (Int, JournalReportItem) -> Hamlet AppRoute
itemAsHtml _ (n, t) = $(Settings.hamletFile "journalreportitem")
where
evenodd = if even n then "even" else "odd" :: String
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
addform :: TemplateData -> Hamlet AppRoute
addform td = $(Settings.hamletFile "addform")
where
-- datehelplink = helplink "dates" "..."
datehelp = "eg: 2010/7/20" :: String
deschelp = "eg: supermarket (optional)" :: String
date = "today" :: String
descriptions = sort $ nub $ map tdescription $ jtxns $ j td
manyfiles = (length $ files $ j td) > 1
postingfields :: TemplateData -> Int -> Hamlet AppRoute
postingfields TD{j=j} n = $(Settings.hamletFile "postingfields")
where
numbered = (++ show n)
acctvar = numbered "account"
amtvar = numbered "amount"
acctnames = sort $ journalAccountNamesUsed j
(acctlabel, accthelp, amtfield, amthelp)
| n == 1 = ("To account"
,"eg: expenses:food"
,$(Settings.hamletFile "postingfieldsamount")
,"eg: $6"
)
| otherwise = ("From account" :: String
,"eg: assets:bank:checking" :: String
,nulltemplate
,"" :: String
)
editform :: TemplateData -> Hamlet AppRoute
editform TD{j=j} = $(Settings.hamletFile "editform")
where
manyfiles = (length $ files j) > 1
formathelp = helplink "file-format" "file format help"
journalselect :: [(FilePath,String)] -> Hamlet AppRoute
journalselect journalfiles = $(Settings.hamletFile "journalselect")
importform :: Hamlet AppRoute
importform = $(Settings.hamletFile "importform")
----------------------------------------------------------------------
-- | A simple postings view, like hledger register.
getRegisterOnlyR :: Handler RepHtml
getRegisterOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ hledgerLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
-- | Render a register report as HTML.
registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute
registerReportAsHtml _ td items = $(Settings.hamletFile "registerreport")
registerReportAsHtml :: [Opt] -> ViewData -> RegisterReport -> Hamlet AppRoute
registerReportAsHtml _ vd items = $(Settings.hamletFile "registerreport")
where
number = zip [1..]
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute
itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem")
itemAsHtml' = itemAsHtml vd
itemAsHtml :: ViewData -> (Int, RegisterReportItem) -> Hamlet AppRoute
itemAsHtml VD{here=here,p=p} (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)
@ -244,18 +172,19 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
c = case isNegativeMixedAmount b of Just True -> "negative amount"
_ -> "positive amount"
postJournalOnlyR :: Handler RepPlain
postJournalOnlyR = do
-- | Handle a post from any of the edit forms.
handlePost :: Handler RepPlain
handlePost = do
action <- runFormPost' $ maybeStringInput "action"
case action of Just "edit" -> postEditForm
Just "import" -> postImportForm
_ -> postAddForm
case action of Just "add" -> handleAdd
Just "edit" -> handleEdit
Just "import" -> handleImport
_ -> invalidArgs [pack "invalid action"]
-- | Handle a journal add form post.
postAddForm :: Handler RepPlain
postAddForm = do
(_, _, _, _, j, _, _) <- getHandlerData
today <- liftIO getCurrentDay
-- | Handle a post from the transaction add form.
handleAdd :: Handler RepPlain
handleAdd = do
VD{j=j,today=today} <- getViewData
-- get form input values. M means a Maybe value.
(dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
$ (,,,,,,)
@ -309,10 +238,10 @@ postAddForm = do
setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)
redirect RedirectTemporary RegisterR
-- | Handle a journal edit form post.
postEditForm :: Handler RepPlain
postEditForm = do
(_, _, _, _, j, _, _) <- getHandlerData
-- | Handle a post from the journal edit form.
handleEdit :: Handler RepPlain
handleEdit = do
VD{j=j} <- getViewData
-- get form input values, or validation errors.
-- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
(textM, journalM) <- runFormPost'
@ -357,9 +286,9 @@ postEditForm = do
redirect RedirectTemporary JournalR)
jE
-- | Handle an import page post.
postImportForm :: Handler RepPlain
postImportForm = do
-- | Handle post from the journal import form.
handleImport :: Handler RepPlain
handleImport = do
setMessage "can't handle file upload yet"
redirect RedirectTemporary JournalR
-- -- get form input values, or basic validation errors. E means an Either value.
@ -376,36 +305,39 @@ postImportForm = do
-- redirect RedirectTemporary JournalR
----------------------------------------------------------------------
-- common templates, helpers, utilities
----------------------------------------------------------------------
-- | Wrap a template with the standard hledger web ui page layout.
hledgerLayout :: TemplateData -> Hamlet AppRoute -> Hamlet AppRoute
hledgerLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content =
$(Settings.hamletFile "hledger-layout")
where title' = basetitle ++ " - " ++ journaltitle
(journaltitle, _) = journalTitleDesc j p today
metacontent = "text/html; charset=utf-8" :: String
m = fromMaybe "" msg
-- | Other view components.
-- | Global toolbar/heading area.
navbar :: TemplateData -> Hamlet AppRoute
navbar TD{p=p,j=j,today=today} = $(Settings.hamletFile "navbar")
where (title, desc) = journalTitleDesc j p today
topbar :: ViewData -> Hamlet AppRoute
topbar VD{p=p,j=j,msg=msg,today=today} = $(Settings.hamletFile "topbar")
where
(title, desc) = journalTitleDesc j p today
-- | Links to the main views.
navlinks :: TemplateData -> Hamlet AppRoute
navlinks td = $(Settings.hamletFile "navlinks")
-- | 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 ++ ")"
-- | Links to navigate between the main views.
navlinks :: ViewData -> Hamlet AppRoute
navlinks vd = $(Settings.hamletFile "navlinks")
where
accountsjournallink = navlink td "journal" JournalR
accountsregisterlink = navlink td "register" RegisterR
navlink :: TemplateData -> String -> AppRoute -> Hamlet AppRoute
navlink TD{here=here,a=a,p=p} s dest = $(Settings.hamletFile "navlink")
accountsjournallink = navlink vd "journal" JournalR
accountsregisterlink = navlink vd "register" 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)])])
style | dest == here = "navlinkcurrent"
| otherwise = "navlink" :: Text
-- | Links to the various journal editing forms.
editlinks :: Hamlet AppRoute
editlinks = $(Settings.hamletFile "editlinks")
@ -415,8 +347,8 @@ helplink topic label = $(Settings.hamletFile "helplink")
where u = manualurl ++ if null topic then "" else '#':topic
-- | Form controlling journal filtering parameters.
filterform :: TemplateData -> Hamlet AppRoute
filterform TD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
filterform :: ViewData -> Hamlet AppRoute
filterform VD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
where
ahelp = helplink "filter-patterns" "?"
phelp = helplink "period-expressions" "?"
@ -430,58 +362,90 @@ filterform TD{here=here,a=a,p=p} = $(Settings.hamletFile "filterform")
stopfilteringperiod = if filteringperiod then $(Settings.hamletFile "filterformclear") else nulltemplate
where u = (here, if filtering then [("a", pack a)] else [])
-- | Add transaction form.
addform :: ViewData -> Hamlet AppRoute
addform vd = $(Settings.hamletFile "addform")
where
datehelp = "eg: 2010/7/20" :: String
deschelp = "eg: supermarket (optional)" :: String
date = "today" :: String
descriptions = sort $ nub $ map tdescription $ jtxns $ j vd
manyfiles = (length $ files $ j vd) > 1
postingfields VD{j=j} n = $(Settings.hamletFile "postingfields")
where
numbered = (++ show n)
acctvar = numbered "account"
amtvar = numbered "amount"
acctnames = sort $ journalAccountNamesUsed j
(acctlabel, accthelp, amtfield, amthelp)
| n == 1 = ("To account"
,"eg: expenses:food"
,$(Settings.hamletFile "postingfieldsamount")
,"eg: $6"
)
| otherwise = ("From account" :: String
,"eg: assets:bank:checking" :: String
,nulltemplate
,"" :: String
)
-- | Edit journal form.
editform :: ViewData -> Hamlet AppRoute
editform VD{j=j} = $(Settings.hamletFile "editform")
where
manyfiles = (length $ files j) > 1
formathelp = helplink "file-format" "file format help"
-- | Import journal form.
importform :: Hamlet AppRoute
importform = $(Settings.hamletFile "importform")
journalselect :: [(FilePath,String)] -> Hamlet AppRoute
journalselect journalfiles = $(Settings.hamletFile "journalselect")
----------------------------------------------------------------------
-- utilities
nulltemplate :: Hamlet AppRoute
nulltemplate = [$hamlet||]
-- | 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 ++ ")"
-- | A bundle of useful data passed to templates.
data TemplateData = TD {
here :: AppRoute -- ^ the current page's route
,title :: String -- ^ page's title
,msg :: Maybe Html -- ^ transient message
,a :: String -- ^ a (acct/desc filter pattern) parameter
,p :: String -- ^ p (period expression) parameter
,j :: Journal -- ^ the current journal
,today :: Day -- ^ the current day
-- | A bundle of data useful for handlers and their templates.
data ViewData = VD {
opts :: [Opt] -- ^ command-line options at startup
,a :: String -- ^ current a parameter (a hledger account/description filter pattern)
,p :: String -- ^ current p parameter (a hledger period expression)
,fspec :: FilterSpec -- ^ a journal filter specification based on the above
,j :: Journal -- ^ an up-to-date parsed 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
}
mktd :: TemplateData
mktd = TD {
here = RootR
,title = "hledger"
,msg = Nothing
,a = ""
,p = ""
,j = nulljournal
mkvd :: ViewData
mkvd = VD {
opts = []
,a = ""
,p = ""
,fspec = nullfilterspec
,j = nulljournal
,today = ModifiedJulianDay 0
,here = RootR
,msg = Nothing
}
-- | Gather the data useful for a hledger web request handler, including:
-- initial command-line options, current a and p query string values, a
-- journal filter specification based on the above and the current time,
-- an up-to-date parsed journal, the current route, and the current ui
-- message if any.
getHandlerData :: Handler (String, String, [Opt], FilterSpec, Journal, Maybe Html, AppRoute)
getHandlerData = do
Just here' <- getCurrentRoute
(a, p, opts, fspec) <- getReportParameters
(j, err) <- getLatestJournal opts
msg <- getMessage' err
return (a, p, opts, fspec, j, msg, here')
-- | Gather data useful for a hledger-web request handler and its templates.
getViewData :: Handler ViewData
getViewData = do
Just here' <- getCurrentRoute
(a, p, opts, fspec) <- getCurrentParameters
(j, err) <- getCurrentJournal opts
msg <- getMessageOr err
today <- liftIO getCurrentDay
return mkvd{opts=opts, a=a, p=p, fspec=fspec, j=j, today=today, here=here', msg=msg}
where
-- | Get current report parameters for this request.
getReportParameters :: Handler (String, String, [Opt], FilterSpec)
getReportParameters = do
getCurrentParameters :: Handler (String, String, [Opt], FilterSpec)
getCurrentParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
@ -492,18 +456,11 @@ getHandlerData = do
fspec = optsToFilterSpec opts args t
return (a', p', opts, fspec)
-- | Quote-sensitive words, ie don't split on spaces which are inside quotes.
words' :: String -> [String]
words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
where
pattern = many (noneOf " \n\r\"")
quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
-- | 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.
getLatestJournal :: [Opt] -> Handler (Journal, Maybe String)
getLatestJournal opts = do
getCurrentJournal :: [Opt] -> Handler (Journal, Maybe String)
getCurrentJournal opts = do
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
@ -514,8 +471,26 @@ getHandlerData = do
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Helper to work around a yesod feature (can't set and get a message in the same request.)
getMessage' :: Maybe String -> Handler (Maybe Html)
getMessage' newmsgstr = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . toHtml) newmsgstr
-- | Get the message set by the last request, or the newer message provided, if any.
getMessageOr :: Maybe String -> Handler (Maybe Html)
getMessageOr mnewmsg = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . toHtml) mnewmsg
accountNameToAccountRegex :: String -> String
accountNameToAccountRegex "" = ""
accountNameToAccountRegex a = printf "^%s(:|$)" a
accountRegexToAccountName :: String -> String
accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1"
isAccountRegex :: String -> Bool
isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
-- | Quote-aware version of words - don't split on spaces which are inside quotes.
words' :: String -> [String]
words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
where
pattern = many (noneOf " \n\r\"")
quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""

17
hledger-web/routes
View File

@ -1,8 +1,9 @@
/static StaticR Static getStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ RootR GET
/journal JournalR GET POST
/register RegisterR GET POST
/journalonly JournalOnlyR GET POST
/accountsonly AccountsOnlyR GET
/static StaticR Static getStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ RootR GET
/journal JournalR GET POST
/register RegisterR GET POST
/journalonly JournalOnlyR GET POST
/registeronly RegisterOnlyR GET POST
/accountsonly AccountsOnlyR GET