aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2015-09-06 23:49:10 +0200
committerJoris2015-09-06 23:49:10 +0200
commitbb7e0a46882bca0b5cb36c09f531a83759d95cb4 (patch)
tree2ce39ffc86f6ec6b18fe3ce1662c3c567bc30c1e
parent53afb9c96904ab226ccee754419569da16c59871 (diff)
Simplifying paymentJob
-rw-r--r--src/server/Model/Payment.hs30
-rw-r--r--src/server/MonthlyPaymentJob.hs11
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