web: first cut at preserving encoding during add, assumes utf-8 (#15)
This commit is contained in:
		
							parent
							
								
									0716659430
								
							
						
					
					
						commit
						4acc2c55ea
					
				| @ -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"] | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user