web: add a runtime-reloaded add form for testing

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|

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"

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$