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

discount computation implemented

master
Alaudidae Lark 2017-05-07 10:59:29 +05:30
parent 65223dcdd3
commit 032b61b9b9
2 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/App.hs
View File

@ -12,7 +12,7 @@ import Control.Monad.Logger (runStderrLoggingT)
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Data.Maybe import Data.Maybe
import Data.String.Conversions import Data.String.Conversions
import Data.Text import Data.Text (Text)
import Data.Time.Clock import Data.Time.Clock
import Database.Persist import Database.Persist
import Database.Persist.Postgresql import Database.Persist.Postgresql
@ -36,7 +36,9 @@ couponServer pool =
couponAdd newCoupon = flip runSqlPersistMPool pool $ do couponAdd newCoupon = flip runSqlPersistMPool pool $ do
-- exists <- selectFirst [CouponCode ==. couponCode newCoupon] [] -- exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
upsert newCoupon [CouponValue =. couponValue newCoupon, upsert newCoupon [CouponValue =. couponValue newCoupon,
CouponMin_price =. couponMin_price newCoupon] CouponMin_price =. couponMin_price newCoupon,
CouponValid_from =. couponValid_from newCoupon,
CouponValid_till =. couponValid_till newCoupon]
-- TODO Add more upsert cols -- TODO Add more upsert cols
-- when (isNothing exists) $ void $ insert newCoupon -- when (isNothing exists) $ void $ insert newCoupon
return NoContent return NoContent
@ -68,17 +70,19 @@ computeBill c b = do pc <- mapM prodCoupon $ productList b
CustomerCouponEmail ==. customer b] [] CustomerCouponEmail ==. customer b] []
let mcm = customerLimit $ entityVal <$> cm let mcm = customerLimit $ entityVal <$> cm
ct <- liftIO getCurrentTime ct <- liftIO getCurrentTime
let valid = couponCount && True `elem` pc && mcm && couponTime ct let valid = couponCount && minLimit && True `elem` pc && mcm && couponTime ct
liftIO $ do print pc liftIO $ do print pc
print minLimit
print couponCount print couponCount
print mcm print mcm
print $ couponTime ct print $ couponTime ct
if valid if valid
then return.Applied $ computeBillAmount c b then return.Applied $ computeDiscountAmount (couponValue c) b
else return.Rejected $ "Rejected Coupon Invalid" else return.Rejected $ "Rejected Coupon Invalid"
where prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c, where prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c,
ProductCouponProduct ==. productName k] [] ProductCouponProduct ==. productName k] []
return $ productLimit $ entityVal <$> p return $ productLimit $ entityVal <$> p
minLimit = couponMin_price c < billAmount b
couponCount = couponUsed c < couponUsage_limit c couponCount = 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
productLimit (Just pc) = productCouponUsage pc > couponProduct_limit c productLimit (Just pc) = productCouponUsage pc > couponProduct_limit c
@ -86,8 +90,15 @@ computeBill c b = do pc <- mapM prodCoupon $ productList b
customerLimit (Just cp) = customerCouponUsage cp > couponCustomer_limit c customerLimit (Just cp) = customerCouponUsage cp > couponCustomer_limit c
customerLimit _ = True customerLimit _ = True
computeBillAmount :: Coupon -> BillCoupon -> Int billAmount :: BillCoupon -> Int
computeBillAmount _ _ = 100 billAmount b = sum (map productPrice (productList b))
computeDiscountAmount :: CouponType -> BillCoupon -> Int
computeDiscountAmount (ProductFlat c) b = couponProductDiscount c * productCount
where matchProducts p = couponProductName c == productName p
productCount = length $ filter matchProducts (productList b)
computeDiscountAmount (CartFlat c) b = billAmount b - c
computeDiscountAmount (CartPercent c) b = (billAmount b * c) `div` 100
productFlat :: (Monad m) => CouponForProduct -> BillCoupon -> m CouponResult productFlat :: (Monad m) => CouponForProduct -> BillCoupon -> m CouponResult
productFlat p bill = return (Rejected "Coupon ProductFlat Found") productFlat p bill = return (Rejected "Coupon ProductFlat Found")

4
src/Coupon.hs
View File

@ -35,8 +35,8 @@ data CouponResult = Applied Int | Rejected String
deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema) deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema)
data CouponForProduct = CouponForProduct { data CouponForProduct = CouponForProduct {
product ::Text, couponProductName ::Text,
productDiscount ::Int couponProductDiscount ::Int
} deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema) } deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema)
data CouponType = ProductFlat CouponForProduct | CartFlat Int | CartPercent Int data CouponType = ProductFlat CouponForProduct | CartFlat Int | CartPercent Int