module Controller.Payment ( list , listPaymentCategories , create , edit , delete ) 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 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 qualified Secure import qualified Util.List as L import qualified Validation.Payment as PaymentValidation list :: Int -> Int -> ActionM () list page perPage = Secure.loggedAction (\_ -> do currentTime <- liftIO Clock.getCurrentTime (liftIO . Query.run $ do count <- PaymentPersistence.count payments <- PaymentPersistence.listActivePage page perPage paymentCategories <- PaymentCategoryPersistence.list users <- UserPersistence.list incomes <- IncomePersistence.listAll allPayments <- PaymentPersistence.listActive Punctual let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments repartition = M.fromList . map (\(u, xs) -> (u, sum . map snd $ xs)) . L.groupBy fst . map (\p -> (_payment_user p, _payment_cost p)) $ allPayments header = PaymentHeader { _paymentHeader_exceedingPayers = exceedingPayers , _paymentHeader_repartition = repartition } return $ PaymentPage header payments paymentCategories count) >>= S.json ) listPaymentCategories :: ActionM () listPaymentCategories = Secure.loggedAction (\_ -> (liftIO . Query.run $ PaymentCategoryPersistence.list) >>= S.json ) create :: CreatePaymentForm -> ActionM () create form = Secure.loggedAction (\user -> (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 Failure validationError -> return $ Left validationError ) >>= ControllerHelper.jsonOrBadRequest ) edit :: EditPaymentForm -> ActionM () edit form = Secure.loggedAction (\user -> (liftIO . Query.run $ do 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 Failure validationError -> return $ Left validationError ) >>= ControllerHelper.jsonOrBadRequest ) 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 )