1 files changed, 116 insertions, 0 deletions
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
new file mode 100644
index 0000000..d6aa34f
--- /dev/null
+++ b/server/src/Controller/Payment.hs
@@ -0,0 +1,116 @@
+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.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 (\_ ->
+    (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, paymentEnd))  ->
+            IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) paymentEnd
+
+          _ ->
+            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
+  )