From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- server/src/Controller/Payment.hs | 137 +++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 76 deletions(-) (limited to 'server/src/Controller/Payment.hs') diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs index f685f2e..d4d086e 100644 --- a/server/src/Controller/Payment.hs +++ b/server/src/Controller/Payment.hs @@ -1,75 +1,70 @@ module Controller.Payment ( list - , listPaymentCategories , create , edit , delete + , searchCategory ) where -import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M -import qualified Data.Time.Clock as Clock -import Data.Validation (Validation (Failure, Success)) -import qualified Network.HTTP.Types.Status as Status -import Web.Scotty (ActionM) -import qualified Web.Scotty as S +import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Time.Calendar as Calendar +import qualified Data.Time.Clock as Clock +import Data.Validation (Validation (Failure, Success)) +import Web.Scotty (ActionM) +import qualified Web.Scotty as S -import Common.Model (Category (..), - CreatePaymentForm (..), - EditPaymentForm (..), - Frequency (Punctual), - Payment (..), PaymentHeader (..), - PaymentId, PaymentPage (..), - SavedPayment (..), User (..)) -import qualified Common.Model as CM -import qualified Common.Msg as Msg -import qualified Controller.Helper as ControllerHelper -import Model.CreatePayment (CreatePayment (..)) -import Model.EditPayment (EditPayment (..)) -import qualified Model.Query as Query -import qualified Persistence.Category as CategoryPersistence -import qualified Persistence.Income as IncomePersistence -import qualified Persistence.Payment as PaymentPersistence -import qualified Persistence.PaymentCategory as PaymentCategoryPersistence -import qualified Persistence.User as UserPersistence +import Common.Model (Category (..), CreatePaymentForm (..), + EditPaymentForm (..), Frequency, + PaymentHeader (..), PaymentId, + PaymentPage (..), User (..)) +import qualified Common.Msg as Msg + +import qualified Controller.Helper as ControllerHelper +import Model.CreatePayment (CreatePayment (..)) +import Model.EditPayment (EditPayment (..)) +import qualified Model.Query as Query +import qualified Payer as Payer +import qualified Persistence.Category as CategoryPersistence +import qualified Persistence.Income as IncomePersistence +import qualified Persistence.Payment as PaymentPersistence +import qualified Persistence.User as UserPersistence import qualified Secure -import qualified Util.List as L -import qualified Validation.Payment as PaymentValidation +import qualified Validation.Payment as PaymentValidation -list :: Int -> Int -> ActionM () -list page perPage = +list :: Frequency -> Int -> Int -> Text -> ActionM () +list frequency page perPage search = Secure.loggedAction (\_ -> do currentTime <- liftIO Clock.getCurrentTime (liftIO . Query.run $ do - count <- PaymentPersistence.count - payments <- PaymentPersistence.listActivePage page perPage - paymentCategories <- PaymentCategoryPersistence.list + count <- PaymentPersistence.count frequency search + payments <- PaymentPersistence.listActivePage frequency page perPage search users <- UserPersistence.list - incomes <- IncomePersistence.listAll - allPayments <- PaymentPersistence.listActive Punctual + incomes <- IncomePersistence.listAll -- TODO optimize + + paymentRange <- PaymentPersistence.getRange + + searchRepartition <- + case paymentRange of + Just (from, to) -> + PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to) + Nothing -> + return M.empty - let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments + (preIncomeRepartition, postIncomeRepartition) <- + PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users - repartition = - M.fromList - . map (\(u, xs) -> (u, sum . map snd $ xs)) - . L.groupBy fst - . map (\p -> (_payment_user p, _payment_cost p)) - $ allPayments + let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange) header = PaymentHeader { _paymentHeader_exceedingPayers = exceedingPayers - , _paymentHeader_repartition = repartition + , _paymentHeader_repartition = searchRepartition } - return $ PaymentPage header payments paymentCategories count) >>= S.json - ) - -listPaymentCategories :: ActionM () -listPaymentCategories = - Secure.loggedAction (\_ -> - (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json + return $ PaymentPage page header payments count) >>= S.json ) create :: CreatePaymentForm -> ActionM () @@ -78,10 +73,8 @@ create form = (liftIO . Query.run $ do cs <- map _category_id <$> CategoryPersistence.list case PaymentValidation.createPayment cs form of - Success (CreatePayment name cost date category frequency) -> do - pc <- PaymentCategoryPersistence.save name category - p <- PaymentPersistence.create (_user_id user) name cost date frequency - return . Right $ SavedPayment p pc + Success (CreatePayment name cost date category frequency) -> + Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency Failure validationError -> return $ Left validationError ) >>= ControllerHelper.jsonOrBadRequest @@ -94,14 +87,11 @@ edit form = cs <- map _category_id <$> CategoryPersistence.list case PaymentValidation.editPayment cs form of Success (EditPayment paymentId name cost date category frequency) -> do - editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency - case editedPayment of - Just (old, new) -> do - pc <- PaymentCategoryPersistence.save name category - PaymentCategoryPersistence.deleteIfUnused (_payment_name old) - return . Right $ SavedPayment new pc - Nothing -> - return . Left $ Msg.get Msg.Error_PaymentEdit + editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency + if Maybe.isJust editedPayment then + return . Right $ editedPayment + else + return . Left $ Msg.get Msg.Error_PaymentEdit Failure validationError -> return $ Left validationError ) >>= ControllerHelper.jsonOrBadRequest @@ -109,18 +99,13 @@ edit form = delete :: PaymentId -> ActionM () delete paymentId = - Secure.loggedAction (\user -> do - deleted <- liftIO . Query.run $ do - payment <- PaymentPersistence.find paymentId - case payment of - Just p | _payment_user p == _user_id user -> do - PaymentPersistence.delete (_user_id user) paymentId - PaymentCategoryPersistence.deleteIfUnused (_payment_name p) - return True - _ -> - return False - if deleted then - S.status Status.ok200 - else - S.status Status.badRequest400 + Secure.loggedAction (\user -> + liftIO . Query.run $ PaymentPersistence.delete (_user_id user) paymentId + ) + +searchCategory :: Text -> ActionM () +searchCategory paymentName = + Secure.loggedAction (\_ -> do + (liftIO $ Query.run (PaymentPersistence.searchCategory paymentName)) + >>= S.json ) -- cgit v1.2.3