Optimize and refactor payments

3 files changed, 78 insertions, 103 deletions

diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs
index e536caa..8fbc8c8 100644
--- a/server/src/Controller/Category.hs
+++ b/server/src/Controller/Category.hs
@@ -5,19 +5,18 @@ module Controller.Category
   , delete
   ) where
 
-import           Control.Monad.IO.Class      (liftIO)
-import qualified Data.Text.Lazy              as TL
-import           Network.HTTP.Types.Status   (badRequest400, ok200)
-import           Web.Scotty                  hiding (delete)
+import           Control.Monad.IO.Class    (liftIO)
+import qualified Data.Text.Lazy            as TL
+import           Network.HTTP.Types.Status (badRequest400, ok200)
+import           Web.Scotty                hiding (delete)
 
-import           Common.Model                (CategoryId, CreateCategory (..),
-                                              EditCategory (..))
-import qualified Common.Msg                  as Msg
+import           Common.Model              (CategoryId, CreateCategory (..),
+                                            EditCategory (..))
+import qualified Common.Msg                as Msg
 
-import           Json                        (jsonId)
-import qualified Model.Query                 as Query
-import qualified Persistence.Category        as CategoryPersistence
-import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
+import           Json                      (jsonId)
+import qualified Model.Query               as Query
+import qualified Persistence.Category      as CategoryPersistence
 import qualified Secure
 
 list :: ActionM ()
@@ -45,10 +44,8 @@ delete :: CategoryId -> ActionM ()
 delete categoryId =
   Secure.loggedAction (\_ -> do
     deleted <- liftIO . Query.run $ do
-      paymentCategories <- PaymentCategoryPersistence.listByCategory categoryId
-      if null paymentCategories
-        then CategoryPersistence.delete categoryId
-        else return False
+      -- TODO: delete only if no payment has this category
+      CategoryPersistence.delete categoryId
     if deleted
       then
         status ok200
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 127e3b3..75d0133 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,6 +1,5 @@
 module Controller.Income
   ( list
-  , deprecatedList
   , create
   , edit
   , delete
@@ -17,12 +16,12 @@ import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..), Income (..),
                                             IncomeHeader (..), IncomeId,
                                             IncomePage (..), User (..))
-import qualified Common.Model              as CM
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
 import           Model.EditIncome          (EditIncome (..))
 import qualified Model.Query               as Query
+import qualified Payer                     as Payer
 import qualified Persistence.Income        as IncomePersistence
 import qualified Persistence.Payment       as PaymentPersistence
 import qualified Persistence.User          as UserPersistence
@@ -37,18 +36,18 @@ list page perPage =
       count <- IncomePersistence.count
 
       users <- UserPersistence.list
-      firstPayment <- PaymentPersistence.firstPunctualDay
-      allIncomes <- IncomePersistence.listAll
+      paymentRange <- PaymentPersistence.getRange
+      allIncomes <- IncomePersistence.listAll -- TODO optimize
 
       let since =
-            CM.useIncomesFrom (map _user_id users) allIncomes firstPayment
+            Payer.useIncomesFrom (map _user_id users) allIncomes (fst <$> paymentRange)
 
       let byUser =
             case since of
               Just s ->
                 M.fromList . flip map users $ \user ->
                   ( _user_id user
-                  , CM.cumulativeIncomesSince currentTime s $
+                  , Payer.cumulativeIncomesSince currentTime s $
                     filter ((==) (_user_id user) . _income_userId) allIncomes
                   )
 
@@ -59,12 +58,6 @@ list page perPage =
       return $ IncomePage (IncomeHeader since byUser) incomes count) >>= json
   )
 
-deprecatedList :: ActionM ()
-deprecatedList =
-  Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ IncomePersistence.listAll) >>= json
-  )
-
 create :: CreateIncomeForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
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
   )