From 041dfac11c171d0235685d6d15baee225e42265e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 10 Aug 2010 00:48:04 +0000 Subject: [PATCH] web: add a runtime-reloaded add form for testing --- Hledger/Cli/Commands/Web.hs | 89 ++++++++++++++++++- data/web/templates/addform.hamlet | 45 ++++++++++ .../web/templates/addformpostingfields.hamlet | 15 ++++ 3 files changed, 147 insertions(+), 2 deletions(-) create mode 100644 data/web/templates/addform.hamlet create mode 100644 data/web/templates/addformpostingfields.hamlet diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index ff42f3fb1..5e0cd5c84 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -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| diff --git a/data/web/templates/addform.hamlet b/data/web/templates/addform.hamlet new file mode 100644 index 000000000..bfeba5fb0 --- /dev/null +++ b/data/web/templates/addform.hamlet @@ -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" diff --git a/data/web/templates/addformpostingfields.hamlet b/data/web/templates/addformpostingfields.hamlet new file mode 100644 index 000000000..ff44e1088 --- /dev/null +++ b/data/web/templates/addformpostingfields.hamlet @@ -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$