Optimize and refactor payments

1 files changed, 61 insertions, 76 deletions

diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index f685f2e..d4d086e 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -1,75 +1,70 @@
 module Controller.Payment
   ( list
-  , listPaymentCategories
   , create
   , edit
   , delete
+  , searchCategory
   ) where
 
-import           Control.Monad.IO.Class      (liftIO)
-import qualified Data.Map                    as M
-import qualified Data.Time.Clock             as Clock
-import           Data.Validation             (Validation (Failure, Success))
-import qualified Network.HTTP.Types.Status   as Status
-import           Web.Scotty                  (ActionM)
-import qualified Web.Scotty                  as S
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Map               as M
+import qualified Data.Maybe             as Maybe
+import           Data.Text              (Text)
+import qualified Data.Time.Calendar     as Calendar
+import qualified Data.Time.Clock        as Clock
+import           Data.Validation        (Validation (Failure, Success))
+import           Web.Scotty             (ActionM)
+import qualified Web.Scotty             as S
 
-import           Common.Model                (Category (..),
-                                              CreatePaymentForm (..),
-                                              EditPaymentForm (..),
-                                              Frequency (Punctual),
-                                              Payment (..), PaymentHeader (..),
-                                              PaymentId, PaymentPage (..),
-                                              SavedPayment (..), User (..))
-import qualified Common.Model                as CM
-import qualified Common.Msg                  as Msg
-import qualified Controller.Helper           as ControllerHelper
-import           Model.CreatePayment         (CreatePayment (..))
-import           Model.EditPayment           (EditPayment (..))
-import qualified Model.Query                 as Query
-import qualified Persistence.Category        as CategoryPersistence
-import qualified Persistence.Income          as IncomePersistence
-import qualified Persistence.Payment         as PaymentPersistence
-import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
-import qualified Persistence.User            as UserPersistence
+import           Common.Model           (Category (..), CreatePaymentForm (..),
+                                         EditPaymentForm (..), Frequency,
+                                         PaymentHeader (..), PaymentId,
+                                         PaymentPage (..), User (..))
+import qualified Common.Msg             as Msg
+
+import qualified Controller.Helper      as ControllerHelper
+import           Model.CreatePayment    (CreatePayment (..))
+import           Model.EditPayment      (EditPayment (..))
+import qualified Model.Query            as Query
+import qualified Payer                  as Payer
+import qualified Persistence.Category   as CategoryPersistence
+import qualified Persistence.Income     as IncomePersistence
+import qualified Persistence.Payment    as PaymentPersistence
+import qualified Persistence.User       as UserPersistence
 import qualified Secure
-import qualified Util.List                   as L
-import qualified Validation.Payment          as PaymentValidation
+import qualified Validation.Payment     as PaymentValidation
 
-list :: Int -> Int -> ActionM ()
-list page perPage =
+list :: Frequency -> Int -> Int -> Text -> ActionM ()
+list frequency page perPage search =
   Secure.loggedAction (\_ -> do
     currentTime <- liftIO Clock.getCurrentTime
     (liftIO . Query.run $ do
-      count <- PaymentPersistence.count
-      payments <- PaymentPersistence.listActivePage page perPage
-      paymentCategories <- PaymentCategoryPersistence.list
+      count <- PaymentPersistence.count frequency search
+      payments <- PaymentPersistence.listActivePage frequency page perPage search
 
       users <- UserPersistence.list
-      incomes <- IncomePersistence.listAll
-      allPayments <- PaymentPersistence.listActive Punctual
+      incomes <- IncomePersistence.listAll -- TODO optimize
+
+      paymentRange <- PaymentPersistence.getRange
+
+      searchRepartition <-
+        case paymentRange of
+          Just (from, to) ->
+            PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to)
+          Nothing ->
+            return M.empty
 
-      let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments
+      (preIncomeRepartition, postIncomeRepartition) <-
+        PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
 
-          repartition =
-            M.fromList
-              . map (\(u, xs) -> (u, sum . map snd $ xs))
-              . L.groupBy fst
-              . map (\p -> (_payment_user p, _payment_cost p))
-              $ allPayments
+      let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange)
 
           header = PaymentHeader
             { _paymentHeader_exceedingPayers = exceedingPayers
-            , _paymentHeader_repartition     = repartition
+            , _paymentHeader_repartition     = searchRepartition
             }
 
-      return $ PaymentPage header payments paymentCategories count) >>= S.json
-  )
-
-listPaymentCategories :: ActionM ()
-listPaymentCategories =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json
+      return $ PaymentPage page header payments count) >>= S.json
   )
 
 create :: CreatePaymentForm -> ActionM ()
@@ -78,10 +73,8 @@ create form =
     (liftIO . Query.run $ do
       cs <- map _category_id <$> CategoryPersistence.list
       case PaymentValidation.createPayment cs form of
-        Success (CreatePayment name cost date category frequency) -> do
-          pc <- PaymentCategoryPersistence.save name category
-          p <- PaymentPersistence.create (_user_id user) name cost date frequency
-          return . Right $ SavedPayment p pc
+        Success (CreatePayment name cost date category frequency) ->
+          Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
         Failure validationError ->
           return $ Left validationError
     ) >>= ControllerHelper.jsonOrBadRequest
@@ -94,14 +87,11 @@ edit form =
       cs <- map _category_id <$> CategoryPersistence.list
       case PaymentValidation.editPayment cs form of
         Success (EditPayment paymentId name cost date category frequency) -> do
-          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
-          case editedPayment of
-            Just (old, new) -> do
-              pc <- PaymentCategoryPersistence.save name category
-              PaymentCategoryPersistence.deleteIfUnused (_payment_name old)
-              return . Right $ SavedPayment new pc
-            Nothing ->
-              return . Left $ Msg.get Msg.Error_PaymentEdit
+          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
+          if Maybe.isJust editedPayment then
+            return . Right $ editedPayment
+          else
+            return . Left $ Msg.get Msg.Error_PaymentEdit
         Failure validationError ->
           return $ Left validationError
     ) >>= ControllerHelper.jsonOrBadRequest
@@ -109,18 +99,13 @@ edit form =
 
 delete :: PaymentId -> ActionM ()
 delete paymentId =
-  Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ do
-      payment <- PaymentPersistence.find paymentId
-      case payment of
-        Just p | _payment_user p == _user_id user -> do
-          PaymentPersistence.delete (_user_id user) paymentId
-          PaymentCategoryPersistence.deleteIfUnused (_payment_name p)
-          return True
-        _ ->
-          return False
-    if deleted then
-      S.status Status.ok200
-    else
-      S.status Status.badRequest400
+  Secure.loggedAction (\user ->
+    liftIO . Query.run $ PaymentPersistence.delete (_user_id user) paymentId
+  )
+
+searchCategory :: Text -> ActionM ()
+searchCategory paymentName =
+  Secure.loggedAction (\_ -> do
+    (liftIO $ Query.run (PaymentPersistence.searchCategory paymentName))
+      >>= S.json
   )