upserting customer/product coupon usage data

src/App.hs

@@ -6,13 +6,11 @@
 module App where
 
 import           Api
-import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger                 (runStderrLoggingT)
 import           Control.Monad.Trans.Reader
-import           Data.Maybe
 import           Data.String.Conversions
-import           Data.Text                            (Text)
+import           Data.Text                            (Text, intercalate)
 import           Data.Time.Clock
 import           Database.Persist
 import           Database.Persist.Postgresql
@@ -34,7 +32,6 @@ couponServer pool =
 
     couponAdd :: Coupon -> IO NoContent
     couponAdd newCoupon = flip runSqlPersistMPool pool $ do
-      -- exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
       upsert newCoupon [CouponValue =. couponValue newCoupon,
                         CouponMin_price =. couponMin_price newCoupon,
                         CouponValid_from =. couponValid_from newCoupon,
@@ -53,61 +50,70 @@ couponServer pool =
       deleteWhere [CouponCode ==. code]
       return NoContent
 
--- computeBillCoupon :: Coupon -> BillCoupon -> CouponResult
--- computeBillCoupon c b = Applied 1000
-
 billCouponServer :: ConnectionPool -> Server BillCouponApi
-billCouponServer pool = liftIO.compute
+billCouponServer pool = liftIO.process
-                        where compute bill = runSqlPersistMPool (query bill) pool
+                        where process bill = runSqlPersistMPool (query bill) pool
                               query bill = do mcpn <- selectFirst [CouponCode ==. coupon bill] []
                                               case mcpn of
                                                 Just cpn -> computeBill (entityVal cpn) bill
                                                 Nothing -> return $ Rejected "Coupon Not Found"
 
 computeBill ::  ( MonadIO m) => Coupon -> BillCoupon -> ReaderT SqlBackend m CouponResult
-computeBill c b = do  pc <- mapM prodCoupon $ productList b
+computeBill c b = do  productLimit <- couponApplicable
-                      cm <- selectFirst [CustomerCouponCode ==. couponCode c,
+                      customerUsageLimit <- custCoupon
-                                          CustomerCouponEmail ==. customer b] []
+                      let (couponWorthy,couponAmount) = couponWorth (couponValue c) b
-                      let mcm = customerLimit $ entityVal <$> cm
                       ct <- liftIO getCurrentTime
-                      let valid = couponCount && minLimit && True `elem` pc && mcm && couponTime ct
+                      let timeLimit = couponTime ct
-                      liftIO $ do print pc
+                      let validityList = [productLimit,couponUsageLimit,priceLimit,
-                                  print minLimit
+                                          couponWorthy,customerUsageLimit,timeLimit]
-                                  print couponCount
+                      let rejectionStrings = ["Coupon not available for product anymore",
-                                  print mcm
+                                              "Coupon not available anymore",
-                                  print $ couponTime ct
+                                              "Cart value not enough for coupon",
-                      if valid
+                                              "Coupon not applicable for cart",
-                        then return.Applied $ computeDiscountAmount (couponValue c) b
+                                              "Coupon usage limit exceeded",
-                        else return.Rejected $ "Rejected Coupon Invalid"
+                                              "Coupon Expired/Not yet valid"]
-                      where prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c,
+                      let rejLookup = zip validityList rejectionStrings
+                      let rsl = map snd $ filter (not.fst) rejLookup
+                      let rejectionString = intercalate "\n" rsl
+                      liftIO $ mapM_ print rejLookup
+                      if and validityList
+                        then do upsProdCoupon (couponValue c)
+                                upsert (newCustCoupon b) [CustomerCouponCused +=. 1]
+                                updateWhere [CouponCode ==. couponCode c] [CouponUsed +=. 1]
+                                return $ Applied couponAmount
+                        else return $ Rejected rejectionString
+                      where couponApplicable = case couponValue c of
+                                                    ProductFlat _ -> do pc <-mapM prodCoupon $ productList b
+                                                                        return $ and pc
+                                                    _ -> return True
+                            prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c,
                                                                 ProductCouponProduct ==. productName k] []
-                                              return $ productLimit $ entityVal <$> p
+                                              return $ prodLimit $ entityVal <$> p
-                            minLimit = couponMin_price c < billAmount b
+                            custCoupon = do cm <- selectFirst [CustomerCouponCode ==. couponCode c,
-                            couponCount = couponUsed c < couponUsage_limit c
+                                                               CustomerCouponEmail ==. customer b] []
+                                            return $ customerLimit $ entityVal <$> cm
+                            upsProdCoupon (ProductFlat cf) = do upsert (newProdCoupon cf b) [ProductCouponPused +=. 1]
+                                                                return ()
+                            upsProdCoupon _                = return ()
+                            priceLimit = couponMin_price c < billAmount b
+                            couponUsageLimit = couponUsed c < couponUsage_limit c
                             couponTime ct = couponValid_from c < ct && couponValid_till c > ct
-                            productLimit (Just pc) = productCouponUsage pc > couponProduct_limit c
+                            prodLimit (Just pc) = productCouponPused pc > couponProduct_limit c
-                            productLimit _ = True
+                            prodLimit _ = True
-                            customerLimit (Just cp) = customerCouponUsage cp > couponCustomer_limit c
+                            customerLimit (Just cp) = customerCouponCused cp > couponCustomer_limit c
                             customerLimit _ = True
 
 billAmount :: BillCoupon -> Int
 billAmount b = sum (map productPrice (productList b))
 
-computeDiscountAmount :: CouponType -> BillCoupon -> Int
+couponWorth :: CouponType -> BillCoupon -> (Bool,Int)
-computeDiscountAmount (ProductFlat c) b = couponProductDiscount c * productCount
+couponWorth (ProductFlat c) b = if productCount == 0
+                                      then (False ,0)
+                                      else(True ,couponProductDiscount c * productCount)
                                     where matchProducts p = couponProductName c == productName p
                                           productCount = length $ filter matchProducts (productList b)
-computeDiscountAmount (CartFlat c) b    = billAmount b - c
+couponWorth (CartFlat c) b    = (True ,billAmount b - c)
-computeDiscountAmount (CartPercent c) b = (billAmount b * c) `div` 100
+couponWorth (CartPercent c) b = (True ,(billAmount b * c) `div` 100)
-
-productFlat ::  (Monad m) => CouponForProduct -> BillCoupon -> m CouponResult
-productFlat p bill = return (Rejected "Coupon ProductFlat Found")
-
-cartFlat ::  (Monad m) => Int -> BillCoupon -> m CouponResult
-cartFlat p bill = return (Rejected "Coupon CartFlat Found")
-
-cartPerCent ::  (Monad m) => Int -> BillCoupon -> m CouponResult
-cartPerCent p bill = return (Rejected "Coupon CartPercent Found")
 
 swaggerServer :: Server SwaggerApi
 swaggerServer = liftIO $ return $ swaggerDoc couponApi
@@ -115,7 +121,6 @@ swaggerServer = liftIO $ return $ swaggerDoc couponApi
 server :: ConnectionPool -> Server ServerApi
 server pool = couponServer pool :<|> billCouponServer pool :<|> swaggerServer
 
-
 app :: ConnectionPool -> Application
 app pool = serve couponApi $ couponServer pool :<|> billCouponServer pool
 

src/Coupon.hs

@@ -31,7 +31,7 @@ data BillCoupon = BillCoupon {
   productList :: [Product]
 } deriving (Eq, Read, Show, Generic, FromJSON, ToJSON, ToSchema)
 
-data CouponResult = Applied Int | Rejected String
+data CouponResult = Applied Int | Rejected Text
     deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema)
 
 data CouponForProduct = CouponForProduct {

src/Models.hs

@@ -22,7 +22,7 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
 CustomerCoupon
   email Text
   code Text
-  usage Int
+  cused Int
   UniqueEmail email
   Primary email
   Foreign Coupon fkcoupon code
@@ -31,7 +31,7 @@ CustomerCoupon
 ProductCoupon
   product Text
   code Text
-  usage Int
+  pused Int
   UniqueProduct product
   Primary product
   Foreign Coupon fkcoupon code
@@ -40,14 +40,24 @@ ProductCoupon
 Coupon json
   code Text
   value  CouponType
-  min_price Int
-  product_limit Int
-  customer_limit Int
-  usage_limit Int
   used Int
   valid_from UTCTime default=now()
   valid_till UTCTime default=now()
+  min_price Int
+  usage_limit Int
+  product_limit Int
+  customer_limit Int
   UniqueCode code
   Primary code
   deriving Eq Read Show Generic
 |]
+
+newProdCoupon :: CouponForProduct -> BillCoupon -> ProductCoupon
+newProdCoupon c p = ProductCoupon { productCouponProduct = couponProductName c,
+                                    productCouponCode = coupon p,
+                                    productCouponPused = 1}
+
+newCustCoupon :: BillCoupon -> CustomerCoupon
+newCustCoupon b = CustomerCoupon { customerCouponEmail = customer b,
+                                   customerCouponCode = coupon b,
+                                   customerCouponCused = 1}