Merge punctual and monthly payments in client model

3 files changed, 18 insertions, 16 deletions

diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index 2b747b7..a6ba55c 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -5,15 +6,21 @@ module Model.Frequency
   ( Frequency(..)
   ) where
 
+import GHC.Generics
+
 import Web.Scotty
 
 import Database.Persist.TH
 
+import Data.Aeson
+
 data Frequency =
   Punctual
   | Monthly
-  deriving (Eq, Show, Read)
+  deriving (Eq, Show, Read, Generic)
 
 derivePersistField "Frequency"
 
 instance Parsable Frequency where parseParam = readEither
+instance FromJSON Frequency
+instance ToJSON Frequency
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 8923c13..7f4de15 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -11,6 +11,7 @@ import Data.Text (Text)
 import Data.Aeson
 
 import Model.Database (PaymentId, UserId)
+import Model.Frequency
 
 data Payment = Payment
   { id :: PaymentId
@@ -18,6 +19,7 @@ data Payment = Payment
   , name :: Text
   , cost :: Int
   , userId :: UserId
+  , frequency :: Frequency
   } deriving (Show, Generic)
 
 instance FromJSON Payment
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 5c7d940..47397ff 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.Payment
-  ( getPunctualPayments
-  , getUserMonthlyPayments
+  ( getPayments
   , getMonthlyPayments
   , createPayment
   , deleteOwnPayment
@@ -15,7 +14,6 @@ import Data.Either (lefts)
 import Control.Monad.IO.Class (liftIO)
 
 import Database.Persist
-import qualified Database.Persist as P
 
 import qualified Validation
 
@@ -24,23 +22,17 @@ import Model.Frequency
 import qualified Model.Json.Payment as P
 import qualified Model.Message.Key as K
 
-getPunctualPayments :: Persist [P.Payment]
-getPunctualPayments =
+getPayments :: Persist [P.Payment]
+getPayments =
   map getJsonPayment <$> selectList
-    [ PaymentDeletedAt P.==. Nothing
-    , PaymentFrequency P.==. Punctual
-    ]
+    [ PaymentDeletedAt ==. Nothing ]
     [ Desc PaymentCreation ]
 
-getUserMonthlyPayments :: UserId -> Persist [P.Payment]
-getUserMonthlyPayments userId =
-  filter ((==) userId . P.userId) . map getJsonPayment <$> getMonthlyPayments
-
 getMonthlyPayments :: Persist [Entity Payment]
 getMonthlyPayments =
   selectList
-    [ PaymentDeletedAt P.==. Nothing
-    , PaymentFrequency P.==. Monthly
+    [ PaymentDeletedAt ==. Nothing
+    , PaymentFrequency ==. Monthly
     ]
     [ Desc PaymentName ]
 
@@ -53,6 +45,7 @@ getJsonPayment paymentEntity =
         , P.name = paymentName payment
         , P.cost = paymentCost payment
         , P.userId = paymentUserId payment
+        , P.frequency = paymentFrequency payment
         }
 
 createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId)
@@ -84,7 +77,7 @@ deleteOwnPayment user paymentId = do
       if paymentUserId payment == entityKey user
         then do
           now <- liftIO getCurrentTime
-          P.update paymentId [PaymentDeletedAt P.=. Just now]
+          update paymentId [PaymentDeletedAt =. Just now]
           return True
         else
           return False