web: move all hamlet to the filesystem, for now; cleanups
This commit is contained in:
parent
6c6e6d4caa
commit
94f3ba10bf
@ -0,0 +1,4 @@
|
|||||||
|
<span#accountsheading
|
||||||
|
accounts
|
||||||
|
\ #
|
||||||
|
^{showlinks}
|
||||||
@ -0,0 +1 @@
|
|||||||
|
<span#showmoreaccounts>^{showmore} ^{showall}
|
||||||
@ -0,0 +1,2 @@
|
|||||||
|
\ | #
|
||||||
|
<a href=@?{allurl}>show all
|
||||||
@ -0,0 +1,3 @@
|
|||||||
|
\ | #
|
||||||
|
<a href=@?{parenturl}>show more ↑
|
||||||
|
|]
|
||||||
48
hledger-web/.hledger/web/templates/addform.hamlet
Normal file
48
hledger-web/.hledger/web/templates/addform.hamlet
Normal 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}
|
||||||
@ -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}
|
||||||
|
|||||||
21
hledger-web/.hledger/web/templates/editform.hamlet
Normal file
21
hledger-web/.hledger/web/templates/editform.hamlet
Normal 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
|
||||||
4
hledger-web/.hledger/web/templates/editlinks.hamlet
Normal file
4
hledger-web/.hledger/web/templates/editlinks.hamlet
Normal 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
|
||||||
25
hledger-web/.hledger/web/templates/filterform.hamlet
Normal file
25
hledger-web/.hledger/web/templates/filterform.hamlet
Normal 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}
|
||||||
@ -0,0 +1 @@
|
|||||||
|
<a#stopfilterlink href=@?{u}>clear filter
|
||||||
1
hledger-web/.hledger/web/templates/helplink.hamlet
Normal file
1
hledger-web/.hledger/web/templates/helplink.hamlet
Normal file
@ -0,0 +1 @@
|
|||||||
|
<a href=#{u} target=hledgerhelp>#{label}
|
||||||
17
hledger-web/.hledger/web/templates/hledger-layout.hamlet
Normal file
17
hledger-web/.hledger/web/templates/hledger-layout.hamlet
Normal 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}
|
||||||
|
|]
|
||||||
9
hledger-web/.hledger/web/templates/importform.hamlet
Normal file
9
hledger-web/.hledger/web/templates/importform.hamlet
Normal 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
|
||||||
10
hledger-web/.hledger/web/templates/journal.hamlet
Normal file
10
hledger-web/.hledger/web/templates/journal.hamlet
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
<div#sidebar
|
||||||
|
^{sidecontent}
|
||||||
|
<div#main.journal
|
||||||
|
^{navlinks td}
|
||||||
|
<div#transactions
|
||||||
|
^{filterform td}
|
||||||
|
^{maincontent}
|
||||||
|
^{addform td}
|
||||||
|
^{editform'}
|
||||||
|
^{importform}
|
||||||
6
hledger-web/.hledger/web/templates/journalonly.hamlet
Normal file
6
hledger-web/.hledger/web/templates/journalonly.hamlet
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
<div.journal
|
||||||
|
^{editlinks}
|
||||||
|
<div#transactions
|
||||||
|
^{txns}
|
||||||
|
^{addform td}
|
||||||
|
^{editform'}
|
||||||
3
hledger-web/.hledger/web/templates/journalreport.hamlet
Normal file
3
hledger-web/.hledger/web/templates/journalreport.hamlet
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
<table.journalreport>
|
||||||
|
$forall i <- number items
|
||||||
|
^{itemAsHtml' i}
|
||||||
@ -0,0 +1,3 @@
|
|||||||
|
<tr.item.#{evenodd} >
|
||||||
|
<td.transaction>
|
||||||
|
<pre> #{txn}
|
||||||
3
hledger-web/.hledger/web/templates/journalselect.hamlet
Normal file
3
hledger-web/.hledger/web/templates/journalselect.hamlet
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
<select id=journalselect name=journal onchange="editformJournalSelect(event)"
|
||||||
|
$forall f <- journalfiles
|
||||||
|
<option value=#{fst f}>#{fst f}
|
||||||
9
hledger-web/.hledger/web/templates/navbar.hamlet
Normal file
9
hledger-web/.hledger/web/templates/navbar.hamlet
Normal 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}
|
||||||
1
hledger-web/.hledger/web/templates/navlink.hamlet
Normal file
1
hledger-web/.hledger/web/templates/navlink.hamlet
Normal file
@ -0,0 +1 @@
|
|||||||
|
<a##{s}link.#{style} href=@?{u}>#{s}
|
||||||
6
hledger-web/.hledger/web/templates/navlinks.hamlet
Normal file
6
hledger-web/.hledger/web/templates/navlinks.hamlet
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
<div#navlinks
|
||||||
|
^{accountsjournallink}
|
||||||
|
\ | #
|
||||||
|
^{accountsregisterlink}
|
||||||
|
\ | #
|
||||||
|
^{editlinks}
|
||||||
15
hledger-web/.hledger/web/templates/postingfields.hamlet
Normal file
15
hledger-web/.hledger/web/templates/postingfields.hamlet
Normal 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}
|
||||||
@ -0,0 +1,4 @@
|
|||||||
|
<td style=padding-left:1em;
|
||||||
|
Amount:
|
||||||
|
<td
|
||||||
|
<input.textinput size=15 name=#{amtvar} value=""
|
||||||
10
hledger-web/.hledger/web/templates/register.hamlet
Normal file
10
hledger-web/.hledger/web/templates/register.hamlet
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
<div#sidebar
|
||||||
|
^{sidecontent}
|
||||||
|
<div#main.journal
|
||||||
|
^{navlinks td}
|
||||||
|
<div#transactions
|
||||||
|
^{filterform td}
|
||||||
|
^{maincontent}
|
||||||
|
^{addform td}
|
||||||
|
^{editform'}
|
||||||
|
^{importform}
|
||||||
9
hledger-web/.hledger/web/templates/registerreport.hamlet
Normal file
9
hledger-web/.hledger/web/templates/registerreport.hamlet
Normal 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}
|
||||||
@ -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}
|
||||||
@ -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
|
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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 ↑
|
|
||||||
|]
|
|
||||||
_ -> 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) " "
|
indent = preEscapedString $ concat $ replicate (2 * adepth) " "
|
||||||
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
|
|
||||||
|
|
||||||
|
|||||||
@ -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"
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user