lark
/
coupon-servant
mirror of https://github.com/alaudidaelark/coupon-servant.git
1
0
Fork 0
Code Issues Releases Wiki Activity

fixed issues

master
Alaudidae Lark 2017-05-07 18:36:15 +05:30
parent c982276f89
commit ae16b63e75
2 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/App.hs
View File

@ -37,7 +37,6 @@ couponServer pool =
CouponValid_from =. couponValid_from newCoupon, CouponValid_from =. couponValid_from newCoupon,
CouponValid_till =. couponValid_till newCoupon] CouponValid_till =. couponValid_till newCoupon]
-- TODO Add more upsert cols -- TODO Add more upsert cols
-- when (isNothing exists) $ void $ insert newCoupon
return NoContent return NoContent
couponGet :: Text -> IO (Maybe Coupon) couponGet :: Text -> IO (Maybe Coupon)
@ -47,6 +46,8 @@ couponServer pool =
couponDel :: Text -> IO NoContent couponDel :: Text -> IO NoContent
couponDel code = flip runSqlPersistMPool pool $ do couponDel code = flip runSqlPersistMPool pool $ do
deleteWhere [CustomerCouponCode ==. code]
deleteWhere [ProductCouponCode ==. code]
deleteWhere [CouponCode ==. code] deleteWhere [CouponCode ==. code]
return NoContent return NoContent
@ -74,11 +75,11 @@ computeBill c b = do productLimit <- couponApplicable
"Coupon Expired/Not yet valid"] "Coupon Expired/Not yet valid"]
let rejLookup = zip validityList rejectionStrings let rejLookup = zip validityList rejectionStrings
let rsl = map snd $ filter (not.fst) rejLookup let rsl = map snd $ filter (not.fst) rejLookup
let rejectionString = intercalate "\n" rsl let rejectionString = intercalate " " rsl
liftIO $ mapM_ print rejLookup liftIO $ mapM_ print rejLookup
if and validityList if and validityList
then do upsProdCoupon (couponValue c) then do upsProdCoupon (couponValue c)
upsert (newCustCoupon b) [CustomerCouponCused +=. 1] upsertBy (newUCust b) (newCustCoupon b) [CustomerCouponCused +=. 1]
updateWhere [CouponCode ==. couponCode c] [CouponUsed +=. 1] updateWhere [CouponCode ==. couponCode c] [CouponUsed +=. 1]
return $ Applied couponAmount return $ Applied couponAmount
else return $ Rejected rejectionString else return $ Rejected rejectionString
@ -92,15 +93,15 @@ computeBill c b = do productLimit <- couponApplicable
custCoupon = do cm <- selectFirst [CustomerCouponCode ==. couponCode c, custCoupon = do cm <- selectFirst [CustomerCouponCode ==. couponCode c,
CustomerCouponEmail ==. customer b] [] CustomerCouponEmail ==. customer b] []
return $ customerLimit $ entityVal <$> cm return $ customerLimit $ entityVal <$> cm
upsProdCoupon (ProductFlat cf) = do upsert (newProdCoupon cf b) [ProductCouponPused +=. 1] upsProdCoupon (ProductFlat cf) = do upsertBy (newUprod cf) (newProdCoupon cf b) [ProductCouponPused +=. 1]
return () return ()
upsProdCoupon _ = return () upsProdCoupon _ = return ()
priceLimit = couponMin_price c < billAmount b priceLimit = couponMin_price c < billAmount b
couponUsageLimit = couponUsed c < couponUsage_limit c couponUsageLimit = couponUsed c < couponUsage_limit c
couponTime ct = couponValid_from c < ct && couponValid_till c > ct couponTime ct = couponValid_from c < ct && couponValid_till c > ct
prodLimit (Just pc) = productCouponPused pc > couponProduct_limit c prodLimit (Just pc) = productCouponPused pc < couponProduct_limit c
prodLimit _ = True prodLimit _ = True
customerLimit (Just cp) = customerCouponCused cp > couponCustomer_limit c customerLimit (Just cp) = customerCouponCused cp < couponCustomer_limit c
customerLimit _ = True customerLimit _ = True
billAmount :: BillCoupon -> Int billAmount :: BillCoupon -> Int

8
src/Models.hs
View File

@ -55,9 +55,13 @@ Coupon json
newProdCoupon :: CouponForProduct -> BillCoupon -> ProductCoupon newProdCoupon :: CouponForProduct -> BillCoupon -> ProductCoupon
newProdCoupon c p = ProductCoupon { productCouponProduct = couponProductName c, newProdCoupon c p = ProductCoupon { productCouponProduct = couponProductName c,
productCouponCode = coupon p, productCouponCode = coupon p,
productCouponPused = 1} productCouponPused = 0}
newCustCoupon :: BillCoupon -> CustomerCoupon newCustCoupon :: BillCoupon -> CustomerCoupon
newCustCoupon b = CustomerCoupon { customerCouponEmail = customer b, newCustCoupon b = CustomerCoupon { customerCouponEmail = customer b,
customerCouponCode = coupon b, customerCouponCode = coupon b,
customerCouponCused = 1} customerCouponCused = 0}
newUCust b = UniqueEmail (customer b)
newUprod c = UniqueProduct (couponProductName c)