web: first cut at preserving encoding during add, assumes utf-8 (#15)

This commit is contained in:
Simon Michael 2009-12-12 22:08:28 +00:00
parent 0716659430
commit 4acc2c55ea

View File

@ -6,6 +6,7 @@ A web-based UI.
module Commands.Web module Commands.Web
where where
import Codec.Binary.UTF8.String (decodeString)
import Control.Applicative.Error (Failing(Success,Failure)) import Control.Applicative.Error (Failing(Success,Failure))
import Control.Concurrent import Control.Concurrent
import Control.Monad.Reader (ask) import Control.Monad.Reader (ask)
@ -243,8 +244,8 @@ searchform env = do
addform :: Hack.Env -> HSP XML addform :: Hack.Env -> HSP XML
addform env = do addform env = do
let inputs = Hack.Contrib.Request.inputs env let inputs = Hack.Contrib.Request.inputs env
date = fromMaybe "" $ lookup "date" inputs date = decodeString $ fromMaybe "" $ lookup "date" inputs
desc = fromMaybe "" $ lookup "desc" inputs desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
<div> <div>
<div id="addform"> <div id="addform">
<form action="" method="POST"> <form action="" method="POST">
@ -267,8 +268,8 @@ addform env = do
transactionfields :: Int -> Hack.Env -> HSP XML transactionfields :: Int -> Hack.Env -> HSP XML
transactionfields n env = do transactionfields n env = do
let inputs = Hack.Contrib.Request.inputs env let inputs = Hack.Contrib.Request.inputs env
acct = fromMaybe "" $ lookup acctvar inputs acct = decodeString $ fromMaybe "" $ lookup acctvar inputs
amt = fromMaybe "" $ lookup amtvar inputs amt = decodeString $ fromMaybe "" $ lookup amtvar inputs
<tr> <tr>
<td> <td>
[NBSP][NBSP] [NBSP][NBSP]
@ -291,12 +292,12 @@ handleAddform l = do
validate :: Hack.Env -> Day -> Failing Transaction validate :: Hack.Env -> Day -> Failing Transaction
validate env today = validate env today =
let inputs = Hack.Contrib.Request.inputs env let inputs = Hack.Contrib.Request.inputs env
date = fromMaybe "" $ lookup "date" inputs date = decodeString $ fromMaybe "" $ lookup "date" inputs
desc = fromMaybe "" $ lookup "desc" inputs desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
acct1 = fromMaybe "" $ lookup "acct1" inputs acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs
amt1 = fromMaybe "" $ lookup "amt1" inputs amt1 = decodeString $ fromMaybe "" $ lookup "amt1" inputs
acct2 = fromMaybe "" $ lookup "acct2" inputs acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs
amt2 = fromMaybe "" $ lookup "amt2" inputs amt2 = decodeString $ fromMaybe "" $ lookup "amt2" inputs
validateDate "" = ["missing date"] validateDate "" = ["missing date"]
validateDate _ = [] validateDate _ = []
validateDesc "" = ["missing description"] validateDesc "" = ["missing description"]