diff --git a/hledger-web/.hledger/web/static/hledger.js b/hledger-web/.hledger/web/static/hledger.js index 87cca4f0b..db7f9a05c 100644 --- a/hledger-web/.hledger/web/static/hledger.js +++ b/hledger-web/.hledger/web/static/hledger.js @@ -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; } diff --git a/hledger-web/.hledger/web/static/style.css b/hledger-web/.hledger/web/static/style.css index adcef832f..55987638a 100644 --- a/hledger-web/.hledger/web/static/style.css +++ b/hledger-web/.hledger/web/static/style.css @@ -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; } diff --git a/hledger-web/.hledger/web/templates/accountsheading.hamlet b/hledger-web/.hledger/web/templates/accountsheading.hamlet index 0de682acb..6500c1f88 100644 --- a/hledger-web/.hledger/web/templates/accountsheading.hamlet +++ b/hledger-web/.hledger/web/templates/accountsheading.hamlet @@ -1,4 +1,4 @@ - show all +\ | # +show all diff --git a/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet b/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet index 1bc7e14a1..1b411a2dd 100644 --- a/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet +++ b/hledger-web/.hledger/web/templates/accountsheadinglinksmore.hamlet @@ -1,3 +1,2 @@ - \ | # - show more ↑ - |] +\ | # +show more ↑ diff --git a/hledger-web/.hledger/web/templates/addform.hamlet b/hledger-web/.hledger/web/templates/addform.hamlet index 96f3f4126..2a464ced0 100644 --- a/hledger-web/.hledger/web/templates/addform.hamlet +++ b/hledger-web/.hledger/web/templates/addform.hamlet @@ -38,11 +38,11 @@ #{deschelp} - ^{postingfields td 1} - ^{postingfields td 2} + ^{postingfields vd 1} + ^{postingfields vd 2} #{pageTitle pc} - ^{pageHead pc} + #{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} diff --git a/hledger-web/.hledger/web/templates/hledger-layout.hamlet b/hledger-web/.hledger/web/templates/hledger-layout.hamlet deleted file mode 100644 index 1e26d4b27..000000000 --- a/hledger-web/.hledger/web/templates/hledger-layout.hamlet +++ /dev/null @@ -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} -|] diff --git a/hledger-web/.hledger/web/templates/homepage.cassius b/hledger-web/.hledger/web/templates/homepage.cassius deleted file mode 100644 index d6eee1b56..000000000 --- a/hledger-web/.hledger/web/templates/homepage.cassius +++ /dev/null @@ -1,4 +0,0 @@ -h1 - text-align: center -h2##{h2id} - color: #990 diff --git a/hledger-web/.hledger/web/templates/homepage.hamlet b/hledger-web/.hledger/web/templates/homepage.hamlet deleted file mode 100644 index ccab6463c..000000000 --- a/hledger-web/.hledger/web/templates/homepage.hamlet +++ /dev/null @@ -1,2 +0,0 @@ -<h1>Hello -<h2 ##{h2id}>You could have Javascript enabled. \ No newline at end of file diff --git a/hledger-web/.hledger/web/templates/homepage.julius b/hledger-web/.hledger/web/templates/homepage.julius deleted file mode 100644 index 0589b9153..000000000 --- a/hledger-web/.hledger/web/templates/homepage.julius +++ /dev/null @@ -1,3 +0,0 @@ -window.onload = function(){ - document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>"; -} diff --git a/hledger-web/.hledger/web/templates/journal.hamlet b/hledger-web/.hledger/web/templates/journal.hamlet index ef1f925d8..ea94c43e4 100644 --- a/hledger-web/.hledger/web/templates/journal.hamlet +++ b/hledger-web/.hledger/web/templates/journal.hamlet @@ -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} diff --git a/hledger-web/.hledger/web/templates/journalonly.hamlet b/hledger-web/.hledger/web/templates/journalonly.hamlet index a2a7b8df0..0fb99c48a 100644 --- a/hledger-web/.hledger/web/templates/journalonly.hamlet +++ b/hledger-web/.hledger/web/templates/journalonly.hamlet @@ -1,6 +1,7 @@ <div.journal ^{editlinks} - <div#transactions - ^{txns} - ^{addform td} - ^{editform'} + <div#maincontent + ^{maincontent} + ^{addform vd} + ^{editform vd} + ^{importform} diff --git a/hledger-web/.hledger/web/templates/navbar.hamlet b/hledger-web/.hledger/web/templates/navbar.hamlet deleted file mode 100644 index 16ef7ea63..000000000 --- a/hledger-web/.hledger/web/templates/navbar.hamlet +++ /dev/null @@ -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} diff --git a/hledger-web/.hledger/web/templates/register.hamlet b/hledger-web/.hledger/web/templates/register.hamlet index eb0344601..293d79618 100644 --- a/hledger-web/.hledger/web/templates/register.hamlet +++ b/hledger-web/.hledger/web/templates/register.hamlet @@ -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} diff --git a/hledger-web/.hledger/web/templates/registeronly.hamlet b/hledger-web/.hledger/web/templates/registeronly.hamlet new file mode 100644 index 000000000..2329894ea --- /dev/null +++ b/hledger-web/.hledger/web/templates/registeronly.hamlet @@ -0,0 +1,7 @@ +<div.register + ^{editlinks} + <div#maincontent + ^{maincontent} + ^{addform vd} + ^{editform vd} + ^{importform} diff --git a/hledger-web/.hledger/web/templates/topbar.hamlet b/hledger-web/.hledger/web/templates/topbar.hamlet new file mode 100644 index 000000000..a3361f4ec --- /dev/null +++ b/hledger-web/.hledger/web/templates/topbar.hamlet @@ -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} diff --git a/hledger-web/App.hs b/hledger-web/App.hs index df4c5e26c..133f42527 100644 --- a/hledger-web/App.hs +++ b/hledger-web/App.hs @@ -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") diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs index 589356fbb..949f17725 100644 --- a/hledger-web/Handlers.hs +++ b/hledger-web/Handlers.hs @@ -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) " " + 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) " " - 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 "'\"" + diff --git a/hledger-web/routes b/hledger-web/routes index 165aaf796..f83a58747 100644 --- a/hledger-web/routes +++ b/hledger-web/routes @@ -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