webyesod: ui cleanups, more user-friendly add form
This commit is contained in:
Simon Michael
parent
206f5eeacd
commit
460cf2c774
@ -133,22 +133,26 @@ template here msg a p title content = [$hamlet|
|
||||
%body
|
||||
^navbar'^
|
||||
#messages $m$
|
||||
^addform^
|
||||
^addform'^
|
||||
#content
|
||||
%pre $string.content$
|
||||
|]
|
||||
where m = fromMaybe (string "") msg
|
||||
navbar' = navbar here a p
|
||||
addform' | here == TransactionsPage = addform
|
||||
| otherwise = nulltemplate
|
||||
stylesheet = StyleCss
|
||||
metacontent = "text/html; charset=utf-8"
|
||||
|
||||
nulltemplate = [$hamlet||]
|
||||
|
||||
navbar :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes
|
||||
navbar here a p = [$hamlet|
|
||||
#navbar
|
||||
%a#hledgerorglink!href=$string.hledgerurl$ hledger.org
|
||||
%a.toprightlink!href=$string.hledgerurl$ hledger.org
|
||||
%a.toprightlink!href=$string.manualurl$ manual
|
||||
^navlinks'^
|
||||
^searchform'^
|
||||
%a#helplink!href=$string.manualurl$ help
|
||||
|]
|
||||
where navlinks' = navlinks a p
|
||||
searchform' = searchform here a p
|
||||
@ -180,76 +184,111 @@ searchform here a p = [$hamlet|
|
||||
^resetlink^
|
||||
|]
|
||||
where
|
||||
ahelp = helplink "filter-patterns"
|
||||
phelp = helplink "period-expressions"
|
||||
ahelp = helplink "filter-patterns" "?"
|
||||
phelp = helplink "period-expressions" "?"
|
||||
resetlink
|
||||
| null a && null p = [$hamlet||]
|
||||
| null a && null p = nulltemplate
|
||||
| otherwise = [$hamlet|%span#resetlink $
|
||||
%a!href=@here@ reset|]
|
||||
|
||||
helplink topic = [$hamlet|%a!href=$string.u$ ?|]
|
||||
helplink topic label = [$hamlet|%a!href=$string.u$ $string.label$|]
|
||||
where u = manualurl ++ if null topic then "" else '#':topic
|
||||
|
||||
addform :: Hamlet HledgerWebAppRoutes
|
||||
addform = [$hamlet|
|
||||
%form#addform!method=POST
|
||||
%table!border=0
|
||||
%form!method=POST
|
||||
%table#addform!cellpadding=0!cellspacing=0!!border=0
|
||||
%tr.formheading
|
||||
%td!colspan=4
|
||||
%span!style=float:right; ^formhelp^
|
||||
%span#formheading Add a transaction:
|
||||
%tr
|
||||
%td
|
||||
Date:
|
||||
%input!size=15!name=date!value=$string.date$
|
||||
^datehelp^ $
|
||||
Description:
|
||||
%input!size=35!name=desc!value=$string.desc$ $
|
||||
%td!colspan=4
|
||||
%table!cellpadding=0!cellspacing=0!border=0
|
||||
%tr#descriptionrow
|
||||
%td
|
||||
Date:
|
||||
%td
|
||||
%input!size=15!name=date!value=$string.date$
|
||||
%td
|
||||
Description:
|
||||
%td
|
||||
%input!size=35!name=description!value=$string.desc$
|
||||
%tr.helprow
|
||||
%td
|
||||
%td
|
||||
#help $string.datehelp$ ^datehelplink^ $
|
||||
%td
|
||||
%td
|
||||
#help $string.deschelp$
|
||||
^transactionfields1^
|
||||
^transactionfields2^
|
||||
%tr#addbuttonrow
|
||||
%td
|
||||
%td!colspan=4
|
||||
%input!type=submit!value=$string.addlabel$
|
||||
^addhelp^
|
||||
<br clear="all" />
|
||||
|]
|
||||
where
|
||||
datehelp = helplink "dates"
|
||||
formhelp = helplink "file-format" "?"
|
||||
datehelplink = helplink "dates" "..."
|
||||
datehelp = "eg: 7/20, 2010/1/1, "
|
||||
deschelp = "eg: supermarket (optional)"
|
||||
addlabel = "add transaction"
|
||||
addhelp = helplink "file-format"
|
||||
date = ""
|
||||
date = "today"
|
||||
desc = ""
|
||||
transactionfields1 = transactionfields 1
|
||||
transactionfields2 = transactionfields 2
|
||||
|
||||
-- transactionfields :: Int -> Hamlet String
|
||||
transactionfields n = [$hamlet|
|
||||
%tr
|
||||
%tr#postingrow
|
||||
%td!align=right
|
||||
$string.label$:
|
||||
%td
|
||||
|
||||
Account:
|
||||
%input!size=35!name=$string.acctvar$!value=$string.acct$
|
||||
|
||||
Amount:
|
||||
%input!size=15!name=$string.amtvar$!value=$string.amt$ $
|
||||
^amtfield^
|
||||
%tr.helprow
|
||||
%td
|
||||
%td
|
||||
#help $string.accthelp$
|
||||
%td
|
||||
%td
|
||||
#help $string.amthelp$
|
||||
|]
|
||||
where
|
||||
label | n == 1 = "To account"
|
||||
| otherwise = "From account"
|
||||
accthelp | n == 1 = "eg: expenses:food"
|
||||
| otherwise = "eg: assets:bank:checking"
|
||||
amtfield | n == 1 = [$hamlet|
|
||||
%td
|
||||
Amount:
|
||||
%td
|
||||
%input!size=15!name=$string.amtvar$!value=$string.amt$
|
||||
|]
|
||||
| otherwise = nulltemplate
|
||||
amthelp | n == 1 = "eg: 5, $9.01, €7" -- XXX , £75 <- misencoded
|
||||
| otherwise = ""
|
||||
acct = ""
|
||||
amt = ""
|
||||
numbered = (++ show n)
|
||||
acctvar = numbered "acct"
|
||||
amtvar = numbered "amt"
|
||||
acctvar = numbered "accountname"
|
||||
amtvar = numbered "amount"
|
||||
|
||||
postTransactionsPage :: Handler HledgerWebApp RepPlain
|
||||
postTransactionsPage = do
|
||||
today <- liftIO getCurrentDay
|
||||
-- get form input values, or basic validation errors. E means an Either value.
|
||||
dateE <- runFormPost $ catchFormError $ notEmpty $ required $ input "date"
|
||||
descE <- runFormPost $ catchFormError $ required $ input "desc"
|
||||
acct1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct1"
|
||||
amt1E <- runFormPost $ catchFormError $ required $ input "amt1"
|
||||
acct2E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct2"
|
||||
amt2E <- runFormPost $ catchFormError $ required $ input "amt2"
|
||||
descE <- runFormPost $ catchFormError $ required $ input "description"
|
||||
acct1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "accountname1"
|
||||
amt1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "amount1"
|
||||
acct2E <- runFormPost $ catchFormError $ notEmpty $ required $ input "accountname2"
|
||||
amt2E <- runFormPost $ catchFormError $ input "amount2"
|
||||
-- supply defaults and parse date and amounts, or get errors.
|
||||
let dateE' = either Left (either (\e -> Left [("date", showDateParseError e)]) Right . fixSmartDateStrEither today) dateE
|
||||
amt1E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt1E -- XXX missingamt only when missing/empty
|
||||
amt2E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt2E
|
||||
amt2E' = case amt2E of Right [] -> Right missingamt
|
||||
_ -> either Left (either (const (Right missingamt)) Right . parse someamount "" . head) amt2E
|
||||
strEs = [dateE', descE, acct1E, acct2E]
|
||||
amtEs = [amt1E', amt2E']
|
||||
errs = lefts strEs ++ lefts amtEs
|
||||
@ -275,7 +314,7 @@ postTransactionsPage = do
|
||||
case tE of
|
||||
Left errs -> do
|
||||
-- save current form values in session
|
||||
setMessage $ string $ intercalate ", " $ map (intercalate ", " . map (\(a,b) -> a++": "++b)) errs
|
||||
setMessage $ string $ intercalate "; " $ map (intercalate ", " . map (\(a,b) -> a++": "++b)) errs
|
||||
redirect RedirectTemporary TransactionsPage
|
||||
|
||||
Right t -> do
|
||||
|
||||
@ -5,11 +5,16 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; }
|
||||
#navlinks { display:inline; }
|
||||
.navlink { font-weight:normal; }
|
||||
#searchform { font-size:small; display:inline; margin-left:1em; }
|
||||
#hledgerorglink { font-size:small; float:right; }
|
||||
#helplink { font-size:small; margin-left:1em; }
|
||||
#resetlink { font-size:small; }
|
||||
.toprightlink { font-size:small; margin-left:1em; float:right; }
|
||||
#messages { color:red; background-color:#ffeeee; margin:0.5em;}
|
||||
#content { padding:0 4px 0 4px; }
|
||||
#addform { margin-left:1em; font-size:small; float:right;}
|
||||
#addform table { background-color:#eeeeee; border:2px solid #dddddd; }
|
||||
#addform #addbuttonrow td { text-align:left; }
|
||||
#addform { margin:1em; font-size:small; }
|
||||
#addform { background-color:#eeeeee; border:2px solid #dddddd; cell-padding:0; cell-spacing:0; }
|
||||
#addform #descriptionrow { }
|
||||
#addform #postingrow { }
|
||||
#addform #addbuttonrow { text-align:right; }
|
||||
#content { margin:1em; }
|
||||
.formheading td { padding-bottom:8px; }
|
||||
#formheading { font-size:medium; font-weight:bold; }
|
||||
.helprow td { padding-bottom:8px; }
|
||||
#help {font-style: italic; font-size:smaller; }
|
||||
Loading…
Reference in New Issue
Block a user