Merge punctual and monthly payments in client model

6 files changed, 20 insertions, 30 deletions

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index a9d1acb..204794a 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -2,7 +2,6 @@
 
 module Controller.Payment
   ( getPayments
-  , getMonthlyPayments
   , createPayment
   , deletePayment
   ) where
@@ -32,13 +31,7 @@ import Model.Message.Key (Key(PaymentNotDeleted))
 getPayments :: ActionM ()
 getPayments =
   Secure.loggedAction (\_ -> do
-    (liftIO $ runDb P.getPunctualPayments) >>= json
-  )
-
-getMonthlyPayments :: ActionM ()
-getMonthlyPayments =
-  Secure.loggedAction (\user -> do
-    (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json
+    (liftIO $ runDb P.getPayments) >>= json
   )
 
 createPayment :: Text -> Text -> Frequency -> ActionM ()
diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs
index e44bce7..c4f9332 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/Header.hs
@@ -49,8 +49,5 @@ headerDesign =
       ".user" <> ".icon" ? do
         paddingLeft headerPadding
         paddingRight headerPadding
-        borderLeft solid (px 1) darkenedRed
 
-      ".icon" ? do
-        fontSize iconFontSize
-        borderRight solid (px 1) darkenedRed
+      ".icon" ? fontSize iconFontSize
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 1cb324e..9734781 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -76,8 +76,6 @@ api conf = do
 
   get "/api/payments" getPayments
 
-  get "/api/monthlyPayments" getMonthlyPayments
-
   post "/api/payment/add" $ do
     name <- param "name" :: ActionM Text
     cost <- param "cost" :: ActionM Text
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