web: add a runtime-reloaded add form for testing
This commit is contained in:
Simon Michael
parent
8c8395778c
commit
041dfac11c
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
|
||||
{-|
|
||||
A web-based UI.
|
||||
-}
|
||||
@ -7,11 +8,14 @@ module Hledger.Cli.Commands.Web
|
||||
where
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
import Control.Failure
|
||||
import Data.Either
|
||||
import System.FilePath ((</>), takeFileName)
|
||||
import System.IO.Storage (withStore, putValue, getValue)
|
||||
import Text.ParserCombinators.Parsec (parse)
|
||||
import Yesod
|
||||
import Yesod hiding (defaultHamletSettings)
|
||||
import Text.Hamlet.Parse (defaultHamletSettings)
|
||||
import Text.Hamlet.RT
|
||||
import Yesod.Helpers.Static
|
||||
|
||||
import Hledger.Cli.Commands.Add (journalAddTransaction)
|
||||
@ -29,7 +33,6 @@ import Paths_hledger_make (getDataFileName)
|
||||
#else
|
||||
import Paths_hledger (getDataFileName)
|
||||
#endif
|
||||
-- import Hledger.Cli.Commands.Web.Templates
|
||||
|
||||
|
||||
defhost = "localhost"
|
||||
@ -55,6 +58,7 @@ mkYesod "HledgerWebApp" [$parseRoutes|
|
||||
/accounts AccountsOnlyR GET
|
||||
/journal JournalR GET POST
|
||||
/register RegisterR GET POST
|
||||
/addformrt AddformRTR GET
|
||||
|]
|
||||
|
||||
style_css = StaticRoute ["style.css"]
|
||||
@ -660,6 +664,87 @@ getEditR = do
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
-- | Get the add form from template files reloaded at run-time.
|
||||
getAddformRTR :: Handler HledgerWebApp RepHtml
|
||||
getAddformRTR = do
|
||||
(a, p, _, _, j, msg, here) <- getHandlerParameters
|
||||
today <- liftIO getCurrentDay
|
||||
let td = mktd{here=here, title="hledger add transaction", msg=msg, a=a, p=p, j=j, today=today}
|
||||
descriptions = sort $ nub $ map tdescription $ jtxns j
|
||||
acctnames = sort $ journalAccountNamesUsed j
|
||||
postingData n = HDMap [
|
||||
("acctlabel", hdstring acctlabel)
|
||||
,("acctvar", hdstring acctvar)
|
||||
,("acctnames", HDList $ map hdstring acctnames)
|
||||
,("amtfield", HDHtml $ renderHamlet' amtfield)
|
||||
,("accthelp", hdstring accthelp)
|
||||
,("amthelp", hdstring amthelp)
|
||||
] :: HamletData HledgerWebAppRoute
|
||||
where
|
||||
numbered = (++ show n)
|
||||
acctvar = numbered "account"
|
||||
amtvar = numbered "amount"
|
||||
(acctlabel, accthelp, amtfield, amthelp)
|
||||
| n == 1 = ("To account"
|
||||
,"eg: expenses:food"
|
||||
,[$hamlet|
|
||||
%td!style=padding-left:1em;
|
||||
Amount:
|
||||
%td
|
||||
%input.textinput!size=15!name=$amtvar$!value=""
|
||||
|]
|
||||
,"eg: $6"
|
||||
)
|
||||
| otherwise = ("From account"
|
||||
,"eg: assets:bank:checking"
|
||||
,nulltemplate
|
||||
,""
|
||||
)
|
||||
pfields1 <- renderHamletFile "addformpostingfields.hamlet" (postingData 1)
|
||||
pfields2 <- renderHamletFile "addformpostingfields.hamlet" (postingData 2)
|
||||
addform <- renderHamletFile "addform.hamlet" (HDMap [
|
||||
("date", hdstring "today")
|
||||
,("desc", hdstring "")
|
||||
,("descriptions", HDList $ map hdstring descriptions)
|
||||
,("datehelp", hdstring "eg: 2010/7/20")
|
||||
,("deschelp", hdstring "eg: supermarket (optional)")
|
||||
,("postingfields1", HDHtml pfields1)
|
||||
,("postingfields2", HDHtml pfields2)
|
||||
])
|
||||
hamletToRepHtml $ pageLayout td $ htmlAsHamlet addform
|
||||
|
||||
hdstring = HDHtml . string
|
||||
|
||||
instance Failure HamletException (Handler HledgerWebApp)
|
||||
where failure = error . show
|
||||
|
||||
renderHamletFile :: FilePath -> HamletData HledgerWebAppRoute -> Handler HledgerWebApp (Html ())
|
||||
renderHamletFile hfile hdata = do
|
||||
hrt <- readHamletFile hfile >>= parseHamletRT defaultHamletSettings
|
||||
renderHamletRT hrt hdata show
|
||||
|
||||
readHamletFile :: FilePath -> Handler HledgerWebApp String
|
||||
readHamletFile hfile = do
|
||||
dir <- ((</> "templates") . appDir) `fmap` getYesod
|
||||
liftIO $ readFile $ dir </> hfile
|
||||
|
||||
htmlAsHamlet :: Html () -> Hamlet HledgerWebAppRoute
|
||||
htmlAsHamlet h = [$hamlet|$h$|]
|
||||
|
||||
parseHamletRT' :: Failure HamletException m => String -> m HamletRT
|
||||
parseHamletRT' s = parseHamletRT defaultHamletSettings s
|
||||
|
||||
renderHamletRT' :: Failure HamletException m => HamletData HledgerWebAppRoute -> HamletRT -> m (Html ())
|
||||
renderHamletRT' d h = renderHamletRT h d show
|
||||
|
||||
renderHamlet' :: Hamlet HledgerWebAppRoute -> Html ()
|
||||
renderHamlet' h = h show
|
||||
|
||||
-- hamletToHamletRT :: Failure HamletException m => Hamlet HledgerWebAppRoute -> m HamletRT
|
||||
-- hamletToHamletRT h = stringToHamletRT $ show $ unsafeByteString $ renderHamlet show h
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
-- | Wrap a template with the standard hledger web ui page layout.
|
||||
pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
|
||||
pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
|
||||
|
||||
45
data/web/templates/addform.hamlet
Normal file
45
data/web/templates/addform.hamlet
Normal file
@ -0,0 +1,45 @@
|
||||
%script!type=text/javascript
|
||||
$$(document).ready(function() {
|
||||
/* dhtmlxcombo setup */
|
||||
window.dhx_globalImgPath="../static/images/";
|
||||
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);
|
||||
});
|
||||
|
||||
%form#addform!method=POST;
|
||||
%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 descriptions d
|
||||
%option!value=$d$ $d$
|
||||
%tr.helprow
|
||||
%td
|
||||
%td
|
||||
.help $datehelp$ $
|
||||
%td
|
||||
%td
|
||||
.help $deschelp$
|
||||
$postingfields1$
|
||||
$postingfields2$
|
||||
%tr#addbuttonrow
|
||||
%td!colspan=4
|
||||
%input!type=hidden!name=action!value=add
|
||||
%input!type=submit!name=submit!value="add transaction"
|
||||
15
data/web/templates/addformpostingfields.hamlet
Normal file
15
data/web/templates/addformpostingfields.hamlet
Normal file
@ -0,0 +1,15 @@
|
||||
%tr#postingrow
|
||||
%td!align=right $acctlabel$:
|
||||
%td
|
||||
%select!id=$acctvar$!name=$acctvar$
|
||||
%option
|
||||
$forall acctnames a
|
||||
%option!value=$a$ $a$
|
||||
$amtfield$
|
||||
%tr.helprow
|
||||
%td
|
||||
%td
|
||||
.help $accthelp$
|
||||
%td
|
||||
%td
|
||||
.help $amthelp$
|
||||
Loading…
Reference in New Issue
Block a user