Can add monthly payments, not visible at the moment though, just the count is printed

6 files changed, 57 insertions, 8 deletions

diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index a6ce4f4..d4a7d50 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -21,6 +21,8 @@ import Data.Int (Int64)
 import Database.Persist.Sqlite
 import Database.Persist.TH
 
+import Model.Frequency
+
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
 User
   creation UTCTime
@@ -35,6 +37,7 @@ Payment
   name Text
   cost Int
   deletedAt UTCTime Maybe
+  frequency Frequency
   deriving Show
 SignIn
   token Text
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
new file mode 100644
index 0000000..2b747b7
--- /dev/null
+++ b/src/server/Model/Frequency.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Model.Frequency
+  ( Frequency(..)
+  ) where
+
+import Web.Scotty
+
+import Database.Persist.TH
+
+data Frequency =
+  Punctual
+  | Monthly
+  deriving (Eq, Show, Read)
+
+derivePersistField "Frequency"
+
+instance Parsable Frequency where parseParam = readEither
diff --git a/src/server/Model/Json/TotalPayment.hs b/src/server/Model/Json/TotalPayment.hs
index 5ae68c9..2b1cd06 100644
--- a/src/server/Model/Json/TotalPayment.hs
+++ b/src/server/Model/Json/TotalPayment.hs
@@ -6,7 +6,6 @@ module Model.Json.TotalPayment
 
 import GHC.Generics
 
-import Data.Text (Text)
 import Data.Aeson
 
 import Model.Database (UserId)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 8a37a2a..163a21f 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -54,5 +54,7 @@ data Key =
   | MoneySymbol
   | Punctual
   | Monthly
+  | SingularMonthlyCount
+  | PluralMonthlyCount
 
   deriving (Enum, Bounded, Show)
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index ec8cf19..501f00f 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -209,3 +209,13 @@ m l Monthly =
   case l of
     English -> "Monthly"
     French  -> "Mensuel"
+
+m l SingularMonthlyCount =
+  case l of
+    English -> "You have {1} monthly payment."
+    French  -> "Vous avez {1} paiement mensuel."
+
+m l PluralMonthlyCount =
+  case l of
+    English -> "You have {1} monthly payments."
+    French  -> "Vous avez {1} paiements mensuels."
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