From 65223dcdd3d17d5c1b26789d1e2a6236b949a442 Mon Sep 17 00:00:00 2001 From: Alaudidae Lark Date: Sun, 7 May 2017 09:21:28 +0530 Subject: [PATCH] added bill validation --- .vscode/launch.json | 22 ++++++++++++++++++++++ .vscode/tasks.json | 41 +++++++++++++++++++++++++++++++++++++++++ src/App.hs | 45 ++++++++++++++++++++++++++++++++++++--------- src/Models.hs | 1 + 4 files changed, 100 insertions(+), 9 deletions(-) create mode 100644 .vscode/launch.json create mode 100644 .vscode/tasks.json diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 0000000..713b015 --- /dev/null +++ b/.vscode/launch.json @@ -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": "" + } + ] +} \ No newline at end of file diff --git a/.vscode/tasks.json b/.vscode/tasks.json new file mode 100644 index 0000000..25f7b57 --- /dev/null +++ b/.vscode/tasks.json @@ -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 " ] + } + ] +} \ No newline at end of file diff --git a/src/App.hs b/src/App.hs index 0987acf..60771f4 100644 --- a/src/App.hs +++ b/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 diff --git a/src/Models.hs b/src/Models.hs index 79b018d..183b4ea 100644 --- a/src/Models.hs +++ b/src/Models.hs @@ -41,6 +41,7 @@ Coupon json code Text value CouponType min_price Int + product_limit Int customer_limit Int usage_limit Int used Int