From 24633871359ec9fbd63fdfebf79a6351b2792f77 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 6 Sep 2015 00:05:50 +0200
Subject: Can add monthly payments, not visible at the moment though, just the
 count is printed

---
 src/server/Model/Payment.hs | 30 +++++++++++++++++++++++-------
 1 file changed, 23 insertions(+), 7 deletions(-)

(limited to 'src/server/Model/Payment.hs')

diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index d7632f0..381578a 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,5 +1,6 @@
 module Model.Payment
-  ( getPayments
+  ( getPunctualPayments
+  , getMonthlyPayments
   , createPayment
   , deleteOwnPayment
   , getTotalPayments
@@ -18,25 +19,38 @@ import Database.Esqueleto
 import qualified Database.Esqueleto as E
 
 import Model.Database
+import Model.Frequency
 import qualified Model.Json.Payment as P
 import qualified Model.Json.TotalPayment as TP
 
-getPayments :: Int -> Int -> Persist [P.Payment]
-getPayments page perPage = do
+getPunctualPayments :: Int -> Int -> Persist [P.Payment]
+getPunctualPayments page perPage = do
   xs <- select $
         from $ \(payment `InnerJoin` user) -> do
           on (payment ^. PaymentUserId E.==. user ^. UserId)
           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 (map getJsonPayment xs)
 
+getMonthlyPayments :: UserId -> Persist [P.Payment]
+getMonthlyPayments userId = do
+  xs <- select $
+        from $ \(payment `InnerJoin` user) -> do
+          on (payment ^. PaymentUserId E.==. user ^. UserId)
+          where_ (isNothing (payment ^. PaymentDeletedAt))
+          where_ (payment ^. PaymentFrequency E.==. val Monthly)
+          where_ (payment ^. PaymentUserId E.==. val userId)
+          orderBy [desc (payment ^. PaymentCreation)]
+          return (payment, user)
+  return (map getJsonPayment xs)
+
 getJsonPayment :: (Entity Payment, Entity User) -> P.Payment
 getJsonPayment (paymentEntity, userEntity) =
   let payment = entityVal paymentEntity
-      user = entityVal userEntity
   in  P.Payment
         { P.id = entityKey paymentEntity
         , P.creation = paymentCreation payment
@@ -45,10 +59,10 @@ getJsonPayment (paymentEntity, userEntity) =
         , P.userId = entityKey userEntity
         }
 
-createPayment :: UserId -> Text -> Int -> Persist PaymentId
-createPayment userId name cost = do
+createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId
+createPayment userId name cost frequency = do
   now <- liftIO getCurrentTime
-  insert $ Payment userId now name cost Nothing
+  insert $ Payment userId now name cost Nothing frequency
 
 deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
 deleteOwnPayment user paymentId = do
@@ -71,6 +85,7 @@ getTotalPayments = do
             from $ \(payment `InnerJoin` user) -> do
               on (payment ^. PaymentUserId E.==. user ^. UserId)
               where_ (isNothing (payment ^. PaymentDeletedAt))
+              where_ (payment ^. PaymentFrequency E.==. val Punctual)
               groupBy (payment ^. PaymentUserId)
               return (user ^. UserId, sum_ (payment ^. PaymentCost))
   return $ catMaybes . map (getTotalPayment . unValueTuple) $ values
@@ -88,4 +103,5 @@ getPaymentsCount =
     (select $
     from $ \payment -> do
       where_ (isNothing (payment ^. PaymentDeletedAt))
+      where_ (payment ^. PaymentFrequency E.==. val Punctual)
       return countRows) :: Persist Int
-- 
cgit v1.2.3