aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Payment.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Controller/Payment.hs')
-rw-r--r--server/src/Controller/Payment.hs118
1 files changed, 0 insertions, 118 deletions
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
deleted file mode 100644
index 4fb4d54..0000000
--- a/server/src/Controller/Payment.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-module Controller.Payment
- ( list
- , create
- , edit
- , delete
- , searchCategory
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Time.Clock as Clock
-import qualified Data.Time.Calendar as Calendar
-import Data.Validation (Validation (Failure, Success))
-import Web.Scotty (ActionM)
-import qualified Web.Scotty as S
-
-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 Validation.Payment as PaymentValidation
-
-list :: Frequency -> Int -> Int -> Text -> ActionM ()
-list frequency page perPage search =
- Secure.loggedAction (\_ -> do
- currentUtctDay <- liftIO $ Clock.utctDay <$> Clock.getCurrentTime
- (liftIO . Query.run $ do
- count <- PaymentPersistence.count frequency search
- payments <- PaymentPersistence.listActivePage frequency page perPage search
-
- users <- UserPersistence.list
-
- paymentRange <- PaymentPersistence.getRange
- incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
-
- cumulativeIncome <-
- case (incomeDefinedForAll, paymentRange) of
- (Just incomeStart, Just (paymentStart, _)) ->
- IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) currentUtctDay
-
- _ ->
- return M.empty
-
- searchRepartition <-
- case paymentRange of
- Just (from, to) ->
- PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to)
- Nothing ->
- return M.empty
-
- (preIncomeRepartition, postIncomeRepartition) <-
- PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
-
- let exceedingPayers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
-
- header = PaymentHeader
- { _paymentHeader_exceedingPayers = exceedingPayers
- , _paymentHeader_repartition = searchRepartition
- }
-
- return $ PaymentPage page frequency header payments count) >>= S.json
- )
-
-create :: CreatePaymentForm -> ActionM ()
-create form =
- Secure.loggedAction (\user ->
- (liftIO . Query.run $ do
- cs <- map _category_id <$> CategoryPersistence.listAll
- case PaymentValidation.createPayment cs form of
- Success (CreatePayment name cost date category frequency) ->
- Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
- Failure validationError ->
- return $ Left validationError
- ) >>= ControllerHelper.okOrBadRequest
- )
-
-edit :: EditPaymentForm -> ActionM ()
-edit form =
- Secure.loggedAction (\user ->
- (liftIO . Query.run $ do
- cs <- map _category_id <$> CategoryPersistence.listAll
- case PaymentValidation.editPayment cs form of
- Success (EditPayment paymentId name cost date category frequency) -> do
- isSuccess <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
- return $ if isSuccess then
- Right ()
- else
- Left $ Msg.get Msg.Error_PaymentEdit
- Failure validationError ->
- return $ Left validationError
- ) >>= ControllerHelper.okOrBadRequest
- )
-
-delete :: PaymentId -> ActionM ()
-delete paymentId =
- 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
- )