web: support full date syntax in add form
This commit is contained in:
		
							parent
							
								
									37f08a35c0
								
							
						
					
					
						commit
						0ddd3ca05a
					
				@ -275,10 +275,11 @@ transactionfields n env = do
 | 
				
			|||||||
handleAddform :: Ledger -> AppUnit
 | 
					handleAddform :: Ledger -> AppUnit
 | 
				
			||||||
handleAddform l = do
 | 
					handleAddform l = do
 | 
				
			||||||
  env <- getenv
 | 
					  env <- getenv
 | 
				
			||||||
  handle $ validate env
 | 
					  d <- io getCurrentDay
 | 
				
			||||||
 | 
					  handle $ validate env d
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
    validate :: Hack.Env -> Failing LedgerTransaction
 | 
					    validate :: Hack.Env -> Day -> Failing LedgerTransaction
 | 
				
			||||||
    validate env =
 | 
					    validate env today =
 | 
				
			||||||
        let inputs = Hack.Contrib.Request.inputs env
 | 
					        let inputs = Hack.Contrib.Request.inputs env
 | 
				
			||||||
            date  = fromMaybe "" $ lookup "date"  inputs
 | 
					            date  = fromMaybe "" $ lookup "date"  inputs
 | 
				
			||||||
            desc  = fromMaybe "" $ lookup "desc"  inputs
 | 
					            desc  = fromMaybe "" $ lookup "desc"  inputs
 | 
				
			||||||
@ -299,7 +300,7 @@ handleAddform l = do
 | 
				
			|||||||
            validateAmt2 "" = ["missing amount 2"]
 | 
					            validateAmt2 "" = ["missing amount 2"]
 | 
				
			||||||
            validateAmt2 s  = []
 | 
					            validateAmt2 s  = []
 | 
				
			||||||
            t = LedgerTransaction {
 | 
					            t = LedgerTransaction {
 | 
				
			||||||
                            ltdate = parsedate date
 | 
					                            ltdate = parsedate $ fixSmartDateStr today date
 | 
				
			||||||
                           ,lteffectivedate=Nothing
 | 
					                           ,lteffectivedate=Nothing
 | 
				
			||||||
                           ,ltstatus=False
 | 
					                           ,ltstatus=False
 | 
				
			||||||
                           ,ltcode=""
 | 
					                           ,ltcode=""
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user