aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Controller')
-rw-r--r--server/src/Controller/Category.hs27
-rw-r--r--server/src/Controller/Income.hs17
-rw-r--r--server/src/Controller/Payment.hs137
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
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 14:36:47 +0000