diff options
author | Joris | 2015-09-06 23:49:10 +0200 |
---|---|---|
committer | Joris | 2015-09-06 23:49:10 +0200 |
commit | bb7e0a46882bca0b5cb36c09f531a83759d95cb4 (patch) | |
tree | 2ce39ffc86f6ec6b18fe3ce1662c3c567bc30c1e | |
parent | 53afb9c96904ab226ccee754419569da16c59871 (diff) |
Simplifying paymentJob
-rw-r--r-- | src/server/Model/Payment.hs | 30 | ||||
-rw-r--r-- | src/server/MonthlyPaymentJob.hs | 11 |
2 files changed, 19 insertions, 22 deletions
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index f07cec4..0db2f08 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -27,40 +27,36 @@ import qualified Model.Json.TotalPayment as TP getPunctualPayments :: Int -> Int -> Persist [P.Payment] getPunctualPayments page perPage = do xs <- select $ - from $ \(payment `InnerJoin` user) -> do - on (payment ^. PaymentUserId E.==. user ^. UserId) + from $ \(payment) -> do where_ (isNothing (payment ^. PaymentDeletedAt)) where_ (payment ^. PaymentFrequency E.==. val Punctual) orderBy [desc (payment ^. PaymentCreation)] limit . fromIntegral $ perPage offset . fromIntegral $ (page - 1) * perPage - return (payment, user) + return payment return (map getJsonPayment xs) getUserMonthlyPayments :: UserId -> Persist [P.Payment] getUserMonthlyPayments userId = - filter ((==) userId . P.userId) <$> getMonthlyPayments + filter ((==) userId . P.userId) . map getJsonPayment <$> getMonthlyPayments -getMonthlyPayments :: Persist [P.Payment] -getMonthlyPayments = do - xs <- select $ - from $ \(payment `InnerJoin` user) -> do - on (payment ^. PaymentUserId E.==. user ^. UserId) - where_ (isNothing (payment ^. PaymentDeletedAt)) - where_ (payment ^. PaymentFrequency E.==. val Monthly) - orderBy [desc (payment ^. PaymentCreation)] - return (payment, user) - return (map getJsonPayment xs) +getMonthlyPayments :: Persist [Entity Payment] +getMonthlyPayments = + selectList + [ PaymentDeletedAt P.==. Nothing + , PaymentFrequency P.==. Monthly + ] + [ Desc PaymentCreation ] -getJsonPayment :: (Entity Payment, Entity User) -> P.Payment -getJsonPayment (paymentEntity, userEntity) = +getJsonPayment :: Entity Payment -> P.Payment +getJsonPayment paymentEntity = let payment = entityVal paymentEntity in P.Payment { P.id = entityKey paymentEntity , P.creation = paymentCreation payment , P.name = paymentName payment , P.cost = paymentCost payment - , P.userId = entityKey userEntity + , P.userId = paymentUserId payment } createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId diff --git a/src/server/MonthlyPaymentJob.hs b/src/server/MonthlyPaymentJob.hs index a3be375..f9d89c0 100644 --- a/src/server/MonthlyPaymentJob.hs +++ b/src/server/MonthlyPaymentJob.hs @@ -8,11 +8,12 @@ import Data.Time.Calendar import Control.Concurrent (threadDelay) +import Database.Persist (entityVal, insert) + import Model.Database -import Model.Payment (createPayment, getMonthlyPayments) +import Model.Payment (getMonthlyPayments) import Model.JobKind import Model.Job -import Model.Json.Payment as P import Model.Frequency monthlyPaymentJobListener :: IO () @@ -29,9 +30,9 @@ monthlyPaymentJobListener = do monthlyJob :: Persist () monthlyJob = do - monthlyPayments <- getMonthlyPayments - _ <- sequence $ map (\p -> createPayment (P.userId p) (P.name p) (P.cost p) Punctual) monthlyPayments - return () + monthlyPayments <- map entityVal <$> getMonthlyPayments + let punctualPayments = map (\p -> p { paymentFrequency = Punctual }) monthlyPayments + sequence_ $ map insert punctualPayments belongToCurrentMonth :: UTCTime -> IO Bool belongToCurrentMonth time = do |