added bill validation
parent
fd147af385
commit
65223dcdd3
|
|
@ -0,0 +1,22 @@
|
|||
{
|
||||
"version": "0.2.0",
|
||||
"configurations": [
|
||||
|
||||
{
|
||||
"type": "ghc",
|
||||
"name": "ghci debug viewer Phoityne",
|
||||
"request": "launch",
|
||||
"internalConsoleOptions": "openOnSessionStart",
|
||||
"workspace": "${workspaceRoot}",
|
||||
"startup": "${workspaceRoot}/test/Spec.hs",
|
||||
"logFile": "${workspaceRoot}/.vscode/phoityne.log",
|
||||
"logLevel": "WARNING",
|
||||
"ghciPrompt": "H>>= ",
|
||||
"ghciCmd": "stack ghci --test --no-load --no-build --main-is TARGET",
|
||||
"ghciEnv": {},
|
||||
"stopOnEntry": true,
|
||||
"hackageVersion": "0.0.14.0",
|
||||
"mainArgs": ""
|
||||
}
|
||||
]
|
||||
}
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
{
|
||||
// atuomatically created by phoityne-vscode
|
||||
|
||||
"version": "0.1.0",
|
||||
"isShellCommand": true,
|
||||
"showOutput": "always",
|
||||
"suppressTaskName": true,
|
||||
"windows": {
|
||||
"command": "cmd",
|
||||
"args": ["/c"]
|
||||
},
|
||||
"linux": {
|
||||
"command": "sh",
|
||||
"args": ["-c"]
|
||||
},
|
||||
"osx": {
|
||||
"command": "sh",
|
||||
"args": ["-c"]
|
||||
},
|
||||
"tasks": [
|
||||
{
|
||||
"taskName": "stack build",
|
||||
"args": [ "echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD " ]
|
||||
},
|
||||
{
|
||||
"isBuildCommand": true,
|
||||
"taskName": "stack clean & build",
|
||||
"args": [ "echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD " ]
|
||||
},
|
||||
{
|
||||
"isTestCommand": true,
|
||||
"taskName": "stack test",
|
||||
"args": [ "echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST " ]
|
||||
},
|
||||
{
|
||||
"isWatching": true,
|
||||
"taskName": "stack watch",
|
||||
"args": [ "echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH " ]
|
||||
}
|
||||
]
|
||||
}
|
||||
45
src/App.hs
45
src/App.hs
|
|
@ -13,6 +13,7 @@ import Control.Monad.Trans.Reader
|
|||
import Data.Maybe
|
||||
import Data.String.Conversions
|
||||
import Data.Text
|
||||
import Data.Time.Clock
|
||||
import Database.Persist
|
||||
import Database.Persist.Postgresql
|
||||
import Database.Persist.Sqlite
|
||||
|
|
@ -33,8 +34,11 @@ couponServer pool =
|
|||
|
||||
couponAdd :: Coupon -> IO NoContent
|
||||
couponAdd newCoupon = flip runSqlPersistMPool pool $ do
|
||||
exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
|
||||
when (isNothing exists) $ void $ insert newCoupon
|
||||
-- exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
|
||||
upsert newCoupon [CouponValue =. couponValue newCoupon,
|
||||
CouponMin_price =. couponMin_price newCoupon]
|
||||
-- TODO Add more upsert cols
|
||||
-- when (isNothing exists) $ void $ insert newCoupon
|
||||
return NoContent
|
||||
|
||||
couponGet :: Text -> IO (Maybe Coupon)
|
||||
|
|
@ -55,12 +59,35 @@ billCouponServer pool = liftIO.compute
|
|||
where compute bill = runSqlPersistMPool (query bill) pool
|
||||
query bill = do mcpn <- selectFirst [CouponCode ==. coupon bill] []
|
||||
case mcpn of
|
||||
Just cpn -> withCoupon (entityVal cpn) bill
|
||||
Nothing -> return (Rejected "Coupon Not Found")
|
||||
withCoupon cpn bill = case couponValue cpn of
|
||||
ProductFlat c -> productFlat c bill
|
||||
CartFlat c -> cartFlat c bill
|
||||
CartPercent c -> cartPerCent c bill
|
||||
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
|
||||
cm <- selectFirst [CustomerCouponCode ==. couponCode c,
|
||||
CustomerCouponEmail ==. customer b] []
|
||||
let mcm = customerLimit $ entityVal <$> cm
|
||||
ct <- liftIO getCurrentTime
|
||||
let valid = couponCount && True `elem` pc && mcm && couponTime ct
|
||||
liftIO $ do print pc
|
||||
print couponCount
|
||||
print mcm
|
||||
print $ couponTime ct
|
||||
if valid
|
||||
then return.Applied $ computeBillAmount c b
|
||||
else return.Rejected $ "Rejected Coupon Invalid"
|
||||
where prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c,
|
||||
ProductCouponProduct ==. productName k] []
|
||||
return $ productLimit $ entityVal <$> p
|
||||
couponCount = couponUsed c < couponUsage_limit c
|
||||
couponTime ct = couponValid_from c < ct && couponValid_till c > ct
|
||||
productLimit (Just pc) = productCouponUsage pc > couponProduct_limit c
|
||||
productLimit _ = True
|
||||
customerLimit (Just cp) = customerCouponUsage cp > couponCustomer_limit c
|
||||
customerLimit _ = True
|
||||
|
||||
computeBillAmount :: Coupon -> BillCoupon -> Int
|
||||
computeBillAmount _ _ = 100
|
||||
|
||||
productFlat :: (Monad m) => CouponForProduct -> BillCoupon -> m CouponResult
|
||||
productFlat p bill = return (Rejected "Coupon ProductFlat Found")
|
||||
|
|
@ -104,4 +131,4 @@ mkSqliteApp sqliteFile = do
|
|||
return $ appDebug pool
|
||||
|
||||
run :: String -> IO ()
|
||||
run dbConnStr = Warp.run 3000 =<< mkApp dbConnStr
|
||||
run dbConnStr = Warp.run 3000 =<< mkDebugPgApp dbConnStr
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ Coupon json
|
|||
code Text
|
||||
value CouponType
|
||||
min_price Int
|
||||
product_limit Int
|
||||
customer_limit Int
|
||||
usage_limit Int
|
||||
used Int
|
||||
|
|
|
|||
Loading…
Reference in New Issue