web: move all hamlet to the filesystem, for now; cleanups

This commit is contained in:
Simon Michael 2011-05-25 02:30:00 +00:00
parent 6c6e6d4caa
commit 94f3ba10bf
32 changed files with 399 additions and 465 deletions

View File

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

View File

@ -0,0 +1 @@
<span#showmoreaccounts>^{showmore} ^{showall}

View File

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

View File

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

View File

@ -0,0 +1,48 @@
<script type=text/javascript>
$(document).ready(function() {
/* dhtmlxcombo setup */
window.dhx_globalImgPath="../static/";
var desccombo = new dhtmlXCombo("description");
var acct1combo = new dhtmlXCombo("account1");
var acct2combo = new dhtmlXCombo("account2");
desccombo.enableFilteringMode(true);
acct1combo.enableFilteringMode(true);
acct2combo.enableFilteringMode(true);
desccombo.setSize(300);
acct1combo.setSize(300);
acct2combo.setSize(300);
/* desccombo.enableOptionAutoHeight(true, 20); */
/* desccombo.setOptionHeight(200); */
});
<form#addform method=POST style=display:none;
<table.form
<tr
<td colspan=4
<table
<tr#descriptionrow
<td
Date:
<td
<input.textinput size=15 name=date value=#{date}
<td style=padding-left:1em;
Description:
<td
<select id=description name=description
<option
$forall d <- descriptions
<option value=#{d}>#{d}
<tr.helprow
<td
<td
<span.help>#{datehelp} #
<td
<td
<span.help>#{deschelp}
^{postingfields td 1}
^{postingfields td 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}

View File

@ -1,8 +1,9 @@
!!! !!!
<html <html
<head <head
<title>#{pageTitle pc} <title>#{pageTitle pc}
^{pageHead 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_js}
<script type=text/javascript src=@{StaticR jquery_url_js} <script type=text/javascript src=@{StaticR jquery_url_js}
<script type=text/javascript src=@{StaticR dhtmlxcommon_js} <script type=text/javascript src=@{StaticR dhtmlxcommon_js}
@ -10,9 +11,7 @@
<script type=text/javascript src=@{StaticR hledger_js} <script type=text/javascript src=@{StaticR hledger_js}
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css} <link rel=stylesheet type=text/css media=all href=@{StaticR style_css}
<body <body
<!-- {navbar td} --> $maybe msg <- mmsg
$maybe msg <- mmsg <div #message>#{msg}
<div #message>#{msg}
<!-- <div#messages>{m} -->
<div#content <div#content
^{pageBody pc} ^{pageBody pc}

View File

@ -0,0 +1,21 @@
<form#editform method=POST style=display:none;
<table.form#editform
$if manyfiles
<tr
<td colspan=2
Editing ^{journalselect $ files j}
<tr
<td colspan=2
<!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
$forall f <- files j
<textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled
#{snd f}
<tr#addbuttonrow
<td
<span.help>^{formathelp}
<td align=right
<span.help Are you sure ? This will overwrite the journal. #
<input type=hidden name=action value=edit
<input type=submit name=submit value="save journal"
\ or #
<a href onclick="return editformToggle(event)">cancel

View File

@ -0,0 +1,4 @@
<a#addformlink href onclick="return addformToggle(event)">add transaction
<a#importformlink href onclick="return importformToggle(event)" style="display:none;">import transactions
\ | #
<a#editformlink href onclick="return editformToggle(event)">edit journal

View File

@ -0,0 +1,25 @@
<div#filterformdiv
<form#filterform.form method=GET style=display:#{visible};
<table.form
<tr.#{filteringperiodclass}
<td
filter by period:
\ #
<td
<input name=p size=60 value=#{p}
^{phelp}
\ #
<td align=right
^{stopfilteringperiod}
<tr.#{filteringclass}
<td
filter by account/description:
\ #
<td
<input name=a size=60 value=#{a}
^{ahelp}
\ #
<input type=submit value=filter #
\ #
<td align=right
^{stopfiltering}

View File

@ -0,0 +1 @@
<a#stopfilterlink href=@?{u}>clear filter

View File

@ -0,0 +1 @@
<a href=#{u} target=hledgerhelp>#{label}

View File

@ -0,0 +1,17 @@
!!!
<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}
|]

View File

@ -0,0 +1,9 @@
<form#importform method=POST style=display:none;
<table.form
<tr
<td
<input type=file name=file
<input type=hidden name=action value=import
<input type=submit name=submit value="import from file"
\ or #
<a href onclick="return importformToggle(event)" cancel

View File

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

View File

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

View File

@ -0,0 +1,3 @@
<table.journalreport>
$forall i <- number items
^{itemAsHtml' i}

View File

@ -0,0 +1,3 @@
<tr.item.#{evenodd} >
<td.transaction>
<pre> #{txn}

View File

@ -0,0 +1,3 @@
<select id=journalselect name=journal onchange="editformJournalSelect(event)"
$forall f <- journalfiles
<option value=#{fst f}>#{fst f}

View File

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

View File

@ -0,0 +1 @@
<a##{s}link.#{style} href=@?{u}>#{s}

View File

@ -0,0 +1,6 @@
<div#navlinks
^{accountsjournallink}
\ | #
^{accountsregisterlink}
\ | #
^{editlinks}

View File

@ -0,0 +1,15 @@
<tr#postingrow
<td align=right>#{acctlabel}:
<td
<select id=#{acctvar} name=#{acctvar}
<option
$forall a <- acctnames
<option value=#{a}>#{a}
^{amtfield}
<tr.helprow
<td
<td
<span.help>#{accthelp}
<td
<td
<span.help>#{amthelp}

View File

@ -0,0 +1,4 @@
<td style=padding-left:1em;
Amount:
<td
<input.textinput size=15 name=#{amtvar} value=""

View File

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

View File

@ -0,0 +1,9 @@
<table.registerreport
<tr.headings
<th.date align=left Date
<th.description align=left Description
<th.account align=left Account
<th.amount align=right Amount
<th.balance align=right Balance
$forall i <- number items
^{itemAsHtml' i}

View File

@ -0,0 +1,7 @@
<tr.item.#{evenodd}.#{firstposting}
<td.date>#{date}
<td.description>#{desc}
<td.account
<a href="@{here}?a=#{acctpat}#{pparam}">#{acct}
<td.amount align=right>#{mixedAmountAsHtml $ pamount posting}
<td.balance align=right>#{mixedAmountAsHtml b}

View File

@ -11,10 +11,8 @@ module App
, StaticRoute (..) , StaticRoute (..)
, lift , lift
, liftIO , liftIO
,getHandlerData
) where ) where
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T import qualified Data.Text as T
@ -23,24 +21,9 @@ import qualified Data.ByteString.Lazy as L
import Yesod.Core import Yesod.Core
import Yesod.Helpers.Static import Yesod.Helpers.Static
import Control.Applicative ((<$>)) --, (<*>))
import Data.Text(Text,pack,unpack)
import System.FilePath (takeFileName) --(</>))
import System.IO.Storage (putValue, getValue)
import Text.Hamlet hiding (hamletFile)
import Text.ParserCombinators.Parsec hiding (string)
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Data import Hledger.Data
import Hledger.Cli.Balance
import Hledger.Cli.Print
import Hledger.Cli.Register
import Hledger.Cli.Options hiding (value)
import Hledger.Cli.Utils
import Hledger.Cli.Version (version)
import Hledger.Data hiding (insert, today)
import Settings import Settings
import StaticFiles import StaticFiles
@ -91,7 +74,6 @@ instance Yesod App where
approot = appRoot approot = appRoot
defaultLayout widget = do defaultLayout widget = do
-- (a, p, opts, fspec, j, msg, here) <- getHandlerData
mmsg <- getMessage mmsg <- getMessage
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
widget widget
@ -117,57 +99,3 @@ instance Yesod App where
unless exists $ liftIO $ L.writeFile fn' content unless exists $ liftIO $ L.writeFile fn' content
return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], []) return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
-- | 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')
where
-- | Get current report parameters for this request.
getReportParameters :: Handler (String, String, [Opt], FilterSpec)
getReportParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
p <- fromMaybe "" <$> lookupGetParam "p"
let (a',p') = (unpack a, unpack p)
opts = appOpts app ++ [Period p']
args = appArgs app ++ words' a'
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
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
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

View File

@ -10,10 +10,10 @@ module AppRun
import App import App
import Settings import Settings
import Yesod.Helpers.Static import Yesod.Helpers.Static
import Data.ByteString (ByteString) -- import Data.ByteString (ByteString)
import Network.Wai (Application) import Network.Wai (Application)
import Data.Dynamic (Dynamic, toDyn) import Data.Dynamic (Dynamic, toDyn)
import System.FilePath ((</>)) -- import System.FilePath ((</>))
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
import Handlers import Handlers
@ -25,14 +25,6 @@ import Hledger.Data (nulljournal)
-- the comments there for more details. -- the comments there for more details.
mkYesodDispatch "App" resourcesApp mkYesodDispatch "App" resourcesApp
-- 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)
-- This function allocates resources (such as a database connection pool), -- This function allocates resources (such as a database connection pool),
-- performs initialization and creates a WAI application. This is also the -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database

View File

@ -2,10 +2,10 @@
{-| {-|
Support files (static files and templates) used by the web app are Support files (static files and templates) used by the web app are
embedded in this module at compile time. Since hamlet can not use the embedded in this module at compile time. Since hamlet can not easily use
embedded files directly, we also provide a way to write them out to the these directly, we provide a way to write them out to the filesystem at
filesystem at startup, when needed. This simplifies installation for startup, when needed. This simplifies installation for end-users, and
end-users, and customisation too. customisation too.
-} -}
module EmbeddedFiles module EmbeddedFiles

View File

@ -2,8 +2,9 @@
module Handlers where module Handlers where
import Control.Applicative ((<$>)) --, (<*>)) import Control.Applicative ((<$>)) --, (<*>))
import Data.ByteString (ByteString)
import Data.Text(Text,pack,unpack) import Data.Text(Text,pack,unpack)
import System.FilePath (takeFileName) --(</>)) import System.FilePath (takeFileName, (</>))
import System.IO.Storage (putValue, getValue) import System.IO.Storage (putValue, getValue)
import Text.Hamlet hiding (hamletFile) import Text.Hamlet hiding (hamletFile)
import Text.ParserCombinators.Parsec hiding (string) import Text.ParserCombinators.Parsec hiding (string)
@ -25,40 +26,22 @@ import StaticFiles
-- handlers/views -- 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 :: Handler RepHtml
getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR getRootR = redirect RedirectTemporary defaultroute where defaultroute = JournalR
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A combined accounts and journal view. -- | The main journal view, with accounts sidebar.
-- old inline version
getJournalR1 :: Handler RepHtml
getJournalR1 = 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
hamletToRepHtml $ pageLayout td [$hamlet|
<div#content
<div#sidebar
^{sidecontent}
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
|]
-- new widget file version
getJournalR :: Handler RepHtml getJournalR :: Handler RepHtml
getJournalR = do getJournalR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
@ -72,8 +55,7 @@ getJournalR = do
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today} td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
defaultLayout $ do defaultLayout $ do
h2id <- lift newIdent setTitle "hledger-web journal"
setTitle "hledger-web journal view"
addHamlet $(Settings.hamletFile "journal") addHamlet $(Settings.hamletFile "journal")
-- postJournalR :: Handler RepPlain -- postJournalR :: Handler RepPlain
@ -81,7 +63,7 @@ getJournalR = do
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A combined accounts and register view. -- | The main register view, with accounts sidebar.
getRegisterR :: Handler RepHtml getRegisterR :: Handler RepHtml
getRegisterR = do getRegisterR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
@ -95,83 +77,49 @@ getRegisterR = do
maincontent = registerReportAsHtml opts td $ registerReport 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} td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
hamletToRepHtml $ pageLayout td [$hamlet| defaultLayout $ do
<div#content setTitle "hledger-web register"
<div#sidebar addHamlet $(Settings.hamletFile "register")
^{sidecontent}
<div#main.journal
^{navlinks td}
<div#transactions
^{filterform td}
^{maincontent}
^{addform td}
^{editform'}
^{importform}
|]
-- postRegisterR :: Handler RepPlain -- postRegisterR :: Handler RepPlain
-- postRegisterR = postJournalOnlyR -- postRegisterR = postJournalOnlyR
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A simple accounts and balances view like hledger balance. -- | A simple accounts view, like hledger balance.
getAccountsOnlyR :: Handler RepHtml getAccountsOnlyR :: Handler RepHtml
getAccountsOnlyR = do getAccountsOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger accounts", msg=msg, a=a, p=p, j=j, today=today} let td = mktd{here=here, title="hledger accounts", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j defaultLayout $ do
setTitle "hledger-web accounts"
addHamlet $ balanceReportAsHtml opts td $ balanceReport opts fspec j
-- | Render a balance report as HTML. -- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet AppRoute
balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [$hamlet| balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = $(Settings.hamletFile "balancereport")
^{accountsheading}
<table.balancereport>
$forall i <- items
^{itemAsHtml' i}
<tr.totalrule>
<td colspan=2>
<tr>
<td>
<td align=right>#{mixedAmountAsHtml total}
|]
where where
accountsheading = [$hamlet| accountsheading = $(Settings.hamletFile "accountsheading")
<span#accountsheading
accounts
\ #
^{showlinks}
|] :: Hamlet AppRoute
where where
filteringaccts = not $ null a filteringaccts = not $ null a
showlinks = [$hamlet|<span#showmoreaccounts>^{showmore} ^{showall}|] :: Hamlet AppRoute showlinks = $(Settings.hamletFile "accountsheadinglinks")
showmore = case (filteringaccts, items) of showmore = case (filteringaccts, items) of
-- cunning parent account logic -- cunning parent account logic
(True, ((acct, _, _, _):_)) -> (True, ((acct, _, _, _):_)) ->
let a' = if isAccountRegex a then a else acct let a' = if isAccountRegex a then a else acct
a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a'
parenturl = (here, [("a",pack a''), ("p",pack p)]) parenturl = (here, [("a",pack a''), ("p",pack p)])
in [$hamlet| in $(Settings.hamletFile "accountsheadinglinksmore")
\ | #
<a href=@?{parenturl}>show more &uarr;
|]
_ -> nulltemplate _ -> nulltemplate
showall = if filteringaccts showall = if filteringaccts
then [$hamlet| then $(Settings.hamletFile "accountsheadinglinksall")
\ | #
<a href=@?{allurl}>show all
|]
else nulltemplate else nulltemplate
where allurl = (here, [("p",pack p)]) where allurl = (here, [("p",pack p)])
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet AppRoute
itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = [$hamlet| itemAsHtml TD{p=p} (acct, adisplay, adepth, abal) = $(Settings.hamletFile "balancereportitem")
<tr.item where
<td.account
#{indent}
<a href="@{here}?a=#{acctpat}#{pparam}">#{adisplay}
<td.balance align=right>#{mixedAmountAsHtml abal}
|] where
indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;" indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
acctpat = accountNameToAccountRegex acct acctpat = accountNameToAccountRegex acct
pparam = if null p then "" else "&p="++p pparam = if null p then "" else "&p="++p
@ -188,7 +136,7 @@ isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:("
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A basic journal view, like hledger print, with editing. -- | A simple journal view, like hledger print (with editing.)
getJournalOnlyR :: Handler RepHtml getJournalOnlyR :: Handler RepHtml
getJournalOnlyR = do getJournalOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
@ -196,86 +144,24 @@ getJournalOnlyR = do
let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today} let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td editform' = editform td
txns = journalReportAsHtml opts td $ journalReport opts fspec j txns = journalReportAsHtml opts td $ journalReport opts fspec j
hamletToRepHtml $ pageLayout td [$hamlet| defaultLayout $ do
<div#journal setTitle "hledger-web journal only"
<div.nav2 addHamlet $(Settings.hamletFile "journalonly")
<a#addformlink href onclick="return addformToggle(event)" add one transaction
\ | #
<a#editformlink href onclick="return editformToggle(event)" edit the whole journal
<div#transactions ^{txns}
^{addform td}
^{editform'}
|]
-- | Render a journal report as HTML. -- | Render a journal report as HTML.
journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet AppRoute
journalReportAsHtml _ td items = [$hamlet| journalReportAsHtml _ td items = $(Settings.hamletFile "journalreport")
<table.journalreport>
$forall i <- number items
^{itemAsHtml' i}
|]
where where
number = zip [1..] number = zip [1..]
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet AppRoute
itemAsHtml _ (n, t) = [$hamlet| itemAsHtml _ (n, t) = $(Settings.hamletFile "journalreportitem")
<tr.item.#{evenodd} > where
<td.transaction>
<pre> #{txn}
|] where
evenodd = if even n then "even" else "odd" :: String evenodd = if even n then "even" else "odd" :: String
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
addform :: TemplateData -> Hamlet AppRoute addform :: TemplateData -> Hamlet AppRoute
addform td = [$hamlet| addform td = $(Settings.hamletFile "addform")
<script type=text/javascript>
$(document).ready(function() {
/* dhtmlxcombo setup */
window.dhx_globalImgPath="../static/";
var desccombo = new dhtmlXCombo("description");
var acct1combo = new dhtmlXCombo("account1");
var acct2combo = new dhtmlXCombo("account2");
desccombo.enableFilteringMode(true);
acct1combo.enableFilteringMode(true);
acct2combo.enableFilteringMode(true);
desccombo.setSize(300);
acct1combo.setSize(300);
acct2combo.setSize(300);
/* desccombo.enableOptionAutoHeight(true, 20); */
/* desccombo.setOptionHeight(200); */
});
<form#addform method=POST style=display:none;
<table.form
<tr
<td colspan=4
<table
<tr#descriptionrow
<td
Date:
<td
<input.textinput size=15 name=date value=#{date}
<td style=padding-left:1em;
Description:
<td
<select id=description name=description
<option
$forall d <- descriptions
<option value=#{d}>#{d}
<tr.helprow
<td
<td
<span.help>#{datehelp} #
<td
<td
<span.help>#{deschelp}
^{postingsfields td}
<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}
|]
where where
-- datehelplink = helplink "dates" "..." -- datehelplink = helplink "dates" "..."
datehelp = "eg: 2010/7/20" :: String datehelp = "eg: 2010/7/20" :: String
@ -284,33 +170,8 @@ addform td = [$hamlet|
descriptions = sort $ nub $ map tdescription $ jtxns $ j td descriptions = sort $ nub $ map tdescription $ jtxns $ j td
manyfiles = (length $ files $ j td) > 1 manyfiles = (length $ files $ j td) > 1
postingsfields :: TemplateData -> Hamlet AppRoute
postingsfields td = [$hamlet|
^{p1}
^{p2}
|]
where
p1 = postingfields td 1
p2 = postingfields td 2
postingfields :: TemplateData -> Int -> Hamlet AppRoute postingfields :: TemplateData -> Int -> Hamlet AppRoute
postingfields TD{j=j} n = [$hamlet| postingfields TD{j=j} n = $(Settings.hamletFile "postingfields")
<tr#postingrow
<td align=right>#{acctlabel}:
<td
<select id=#{acctvar} name=#{acctvar}
<option
$forall a <- acctnames
<option value=#{a}>#{a}
^{amtfield}
<tr.helprow
<td
<td
<span.help>#{accthelp}
<td
<td
<span.help>#{amthelp}
|]
where where
numbered = (++ show n) numbered = (++ show n)
acctvar = numbered "account" acctvar = numbered "account"
@ -319,12 +180,7 @@ postingfields TD{j=j} n = [$hamlet|
(acctlabel, accthelp, amtfield, amthelp) (acctlabel, accthelp, amtfield, amthelp)
| n == 1 = ("To account" | n == 1 = ("To account"
,"eg: expenses:food" ,"eg: expenses:food"
,[$hamlet| ,$(Settings.hamletFile "postingfieldsamount")
<td style=padding-left:1em;
Amount:
<td
<input.textinput size=15 name=#{amtvar} value=""
|]
,"eg: $6" ,"eg: $6"
) )
| otherwise = ("From account" :: String | otherwise = ("From account" :: String
@ -334,51 +190,16 @@ postingfields TD{j=j} n = [$hamlet|
) )
editform :: TemplateData -> Hamlet AppRoute editform :: TemplateData -> Hamlet AppRoute
editform TD{j=j} = [$hamlet| editform TD{j=j} = $(Settings.hamletFile "editform")
<form#editform method=POST style=display:none;
<table.form#editform
$if manyfiles
<tr
<td colspan=2
Editing ^{journalselect $ files j}
<tr
<td colspan=2
$forall f <- files j
<textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled
#{snd f}
<tr#addbuttonrow
<td
<span.help ^{formathelp}
<td align=right
<span.help Are you sure ? This will overwrite the journal. #
<input type=hidden name=action value=edit
<input type=submit name=submit value="save journal"
\ or #
<a href onclick="return editformToggle(event)">cancel
|] -- XXX textarea ids are unquoted journal file paths, which is not valid html
where where
manyfiles = (length $ files j) > 1 manyfiles = (length $ files j) > 1
formathelp = helplink "file-format" "file format help" formathelp = helplink "file-format" "file format help"
journalselect :: [(FilePath,String)] -> Hamlet AppRoute journalselect :: [(FilePath,String)] -> Hamlet AppRoute
journalselect journalfiles = [$hamlet| journalselect journalfiles = $(Settings.hamletFile "journalselect")
<select id=journalselect name=journal onchange="editformJournalSelect(event)"
$forall f <- journalfiles
<option value=#{fst f}>#{fst f}
|]
importform :: Hamlet AppRoute importform :: Hamlet AppRoute
importform = [$hamlet| importform = $(Settings.hamletFile "importform")
<form#importform method=POST style=display:none;
<table.form
<tr
<td
<input type=file name=file
<input type=hidden name=action value=import
<input type=submit name=submit value="import from file"
\ or #
<a href onclick="return importformToggle(event)" cancel
|]
{- {-
postJournalOnlyR :: Handler RepPlain postJournalOnlyR :: Handler RepPlain
@ -521,37 +342,17 @@ getRegisterOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData (a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today} let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j hamletToRepHtml $ hledgerLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
-- | Render a register report as HTML. -- | Render a register report as HTML.
registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute
registerReportAsHtml _ td items = [$hamlet| registerReportAsHtml _ td items = $(Settings.hamletFile "registerreport")
<table.registerreport
<tr.headings
^{headings}
$forall i <- number items
^{itemAsHtml' i}
|]
where where
number = zip [1..] number = zip [1..]
headings = [$hamlet|
<th.date align=left Date
<th.description align=left Description
<th.account align=left Account
<th.amount align=right Amount
<th.balance align=right Balance
|] :: Hamlet AppRoute
itemAsHtml' = itemAsHtml td itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute
itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = [$hamlet| itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem")
<tr.item.#{evenodd}.#{firstposting} where
<td.date>#{date}
<td.description>#{desc}
<td.account
<a href="@{here}?a=#{acctpat}#{pparam}">#{acct}
<td.amount align=right>#{mixedAmountAsHtml $ pamount posting}
<td.balance align=right>#{mixedAmountAsHtml b}
|] where
evenodd = if even n then "even" else "odd" :: String evenodd = if even n then "even" else "odd" :: String
(firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
Nothing -> ("", "", "") :: (String,String,String) Nothing -> ("", "", "") :: (String,String,String)
@ -565,12 +366,74 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
_ -> "positive amount" _ -> "positive amount"
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- utilities, common templates -- 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
-- | 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
-- | Links to the main views.
navlinks :: TemplateData -> Hamlet AppRoute
navlinks td = $(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")
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
editlinks :: Hamlet AppRoute
editlinks = $(Settings.hamletFile "editlinks")
-- | Link to a topic in the manual.
helplink :: String -> String -> Hamlet AppRoute
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")
where
ahelp = helplink "filter-patterns" "?"
phelp = helplink "period-expressions" "?"
filtering = not $ null a
filteringperiod = not $ null p
visible = "block" :: String
filteringclass = if filtering then "filtering" else "" :: String
filteringperiodclass = if filteringperiod then "filtering" else "" :: String
stopfiltering = if filtering then $(Settings.hamletFile "filterformclear") else nulltemplate
where u = (here, if filteringperiod then [("p", pack p)] else [])
stopfilteringperiod = if filteringperiod then $(Settings.hamletFile "filterformclear") else nulltemplate
where u = (here, if filtering then [("a", pack a)] else [])
nulltemplate :: Hamlet AppRoute nulltemplate :: Hamlet AppRoute
nulltemplate = [$hamlet||] 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. -- | A bundle of useful data passed to templates.
data TemplateData = TD { data TemplateData = TD {
here :: AppRoute -- ^ the current page's route here :: AppRoute -- ^ the current page's route
@ -593,126 +456,57 @@ mktd = TD {
,today = ModifiedJulianDay 0 ,today = ModifiedJulianDay 0
} }
-- | Wrap a template with the standard hledger web ui page layout. -- | Gather the data useful for a hledger web request handler, including:
pageLayout :: TemplateData -> Hamlet AppRoute -> Hamlet AppRoute -- initial command-line options, current a and p query string values, a
pageLayout td@TD{title=basetitle, msg=msg, p=p, j=j, today=today} content = [$hamlet| -- journal filter specification based on the above and the current time,
!!! -- an up-to-date parsed journal, the current route, and the current ui
<html -- message if any.
<head getHandlerData :: Handler (String, String, [Opt], FilterSpec, Journal, Maybe Html, AppRoute)
<title>#{title'} getHandlerData = do
<meta http-equiv=Content-Type content=#{metacontent} Just here' <- getCurrentRoute
<script type=text/javascript src=@{StaticR jquery_js} (a, p, opts, fspec) <- getReportParameters
<script type=text/javascript src=@{StaticR jquery_url_js} (j, err) <- getLatestJournal opts
<script type=text/javascript src=@{StaticR dhtmlxcommon_js} msg <- getMessage' err
<script type=text/javascript src=@{StaticR dhtmlxcombo_js} return (a, p, opts, fspec, j, msg, here')
<script type=text/javascript src=@{StaticR hledger_js} where
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css} -- | Get current report parameters for this request.
<body getReportParameters :: Handler (String, String, [Opt], FilterSpec)
^{navbar td} getReportParameters = do
<div#messages>#{m} app <- getYesod
<div#content t <- liftIO $ getCurrentLocalTime
^{content} a <- fromMaybe "" <$> lookupGetParam "a"
|] p <- fromMaybe "" <$> lookupGetParam "p"
where title' = basetitle ++ " - " ++ journaltitle let (a',p') = (unpack a, unpack p)
(journaltitle, _) = journalTitleDesc j p today opts = appOpts app ++ [Period p']
metacontent = "text/html; charset=utf-8" :: String args = appArgs app ++ words' a'
m = fromMaybe "" msg fspec = optsToFilterSpec opts args t
return (a', p', opts, fspec)
-- | Global toolbar/heading area. -- | Quote-sensitive words, ie don't split on spaces which are inside quotes.
navbar :: TemplateData -> Hamlet AppRoute words' :: String -> [String]
navbar TD{p=p,j=j,today=today} = [$hamlet| words' = fromparse . parsewith ((quotedPattern <|> pattern) `sepBy` many1 spacenonewline)
<div#navbar where
<a.topleftlink href=#{hledgerorgurl} pattern = many (noneOf " \n\r\"")
hledger-web quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""
<br />
#{version}
<a.toprightlink href=#{manualurl} target=hledgerhelp>manual
<h1>#{title}
\ #
<span#journaldesc>#{desc}
|]
where (title, desc) = journalTitleDesc j p today
-- | Generate a title and description for the given journal, period -- | Update our copy of the journal if the file changed. If there is an
-- expression, and date. -- error while reloading, keep the old one and return the error, and set a
journalTitleDesc :: Journal -> String -> Day -> (String, String) -- ui message.
journalTitleDesc j p today = (title, desc) getLatestJournal :: [Opt] -> Handler (Journal, Maybe String)
where getLatestJournal opts = do
title = printf "%s" (takeFileName $ journalFilePath j) :: String j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
desc = printf "%s" (showspan span) :: String (jE, changed) <- liftIO $ journalReloadIfChanged opts j
span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p) if not changed
showspan (DateSpan Nothing Nothing) = "" then return (j,Nothing)
showspan s = " (" ++ dateSpanAsText s ++ ")" else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Links to the main views. -- | Helper to work around a yesod feature (can't set and get a message in the same request.)
navlinks :: TemplateData -> Hamlet AppRoute getMessage' :: Maybe String -> Handler (Maybe Html)
navlinks td = [$hamlet| getMessage' newmsgstr = do
<div#navlinks oldmsg <- getMessage
^{accountsjournallink} return $ maybe oldmsg (Just . toHtml) newmsgstr
\ | #
^{accountsregisterlink}
\ | #
<a#addformlink href onclick="return addformToggle(event)">add transaction
<a#importformlink href onclick="return importformToggle(event)" style="display:none;">import transactions
\ | #
<a#editformlink href onclick="return editformToggle(event)">edit journal
|]
-- \ | #
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 = [$hamlet|<a##{s}link.#{style} href=@?{u}>#{s}|]
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
-- | Form controlling journal filtering parameters.
filterform :: TemplateData -> Hamlet AppRoute
filterform TD{here=here,a=a,p=p} = [$hamlet|
<div#filterformdiv
<form#filterform.form method=GET style=display:#{visible};
<table.form
<tr.#{filteringperiodclass}
<td
filter by period:
\ #
<td
<input name=p size=60 value=#{p}
^{phelp}
\ #
<td align=right
^{stopfilteringperiod}
<tr.#{filteringclass}
<td
filter by account/description:
\ #
<td
<input name=a size=60 value=#{a}
^{ahelp}
\ #
<input type=submit value=filter #
\ #
<td align=right
^{stopfiltering}
|]
where
ahelp = helplink "filter-patterns" "?"
phelp = helplink "period-expressions" "?"
filtering = not $ null a
filteringperiod = not $ null p
visible = "block" :: String
filteringclass = if filtering then "filtering" else "" :: String
filteringperiodclass = if filteringperiod then "filtering" else "" :: String
stopfiltering = if filtering then [$hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate
where u = (here, if filteringperiod then [("p", pack p)] else [])
stopfilteringperiod = if filteringperiod then [$hamlet|<a#stopfilterlink href=@?{u}>clear filter|] else nulltemplate
where u = (here, if filtering then [("a", pack a)] else [])
-- | Link to a topic in the manual.
helplink :: String -> String -> Hamlet AppRoute
helplink topic label = [$hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
where u = manualurl ++ if null topic then "" else '#':topic

View File

@ -8,18 +8,17 @@ Released under GPL version 3 or later.
module Main module Main
where where
import Prelude hiding (putStr, putStrLn)
-- import Control.Concurrent (forkIO, threadDelay)
import Data.Text(pack)
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
#if PRODUCTION #if PRODUCTION
#else #else
import Network.Wai.Middleware.Debug (debug) import Network.Wai.Middleware.Debug (debug)
#endif #endif
import System.Console.GetOpt
import Prelude hiding (putStr, putStrLn)
-- import Control.Concurrent (forkIO, threadDelay)
import Data.Text(pack)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.IO.Storage (withStore, putValue,) import System.IO.Storage (withStore, putValue,)
import System.Console.GetOpt
import Yesod.Helpers.Static import Yesod.Helpers.Static
import Hledger.Cli.Options import Hledger.Cli.Options
@ -31,7 +30,6 @@ import Hledger.Data.UTF8 (putStr, putStrLn)
import App import App
import AppRun (withApp) import AppRun (withApp)
import EmbeddedFiles (createFilesIfMissing) import EmbeddedFiles (createFilesIfMissing)
import Settings (defhost, defport, datadir, staticdir) -- , browserstartdelay)
progname_web = progname_cli ++ "-web" progname_web = progname_cli ++ "-web"

View File

@ -2,6 +2,7 @@
/favicon.ico FaviconR GET /favicon.ico FaviconR GET
/robots.txt RobotsR GET /robots.txt RobotsR GET
/ RootR GET / RootR GET
/accounts AccountsOnlyR GET
/journal JournalR GET /journal JournalR GET
/register RegisterR GET /register RegisterR GET
/accounts AccountsOnlyR GET
/journalonly JournalOnlyR GET