{-# LANGUAGE OverloadedStrings #-} module Model.Payment ( getPunctualPayments , getUserMonthlyPayments , getMonthlyPayments , createPayment , deleteOwnPayment , getPaymentsCount ) where import Data.Text (Text) import Data.Time.Clock (getCurrentTime) import Data.Either (lefts) import Control.Monad.IO.Class (liftIO) import Database.Persist import qualified Database.Persist as P import qualified Validation import Model.Database import Model.Frequency import qualified Model.Json.Payment as P import qualified Model.Message.Key as K getPunctualPayments :: Persist [P.Payment] getPunctualPayments = map getJsonPayment <$> selectList [ PaymentDeletedAt P.==. Nothing , PaymentFrequency P.==. Punctual ] [ Desc PaymentCreation ] getUserMonthlyPayments :: UserId -> Persist [P.Payment] getUserMonthlyPayments userId = filter ((==) userId . P.userId) . map getJsonPayment <$> getMonthlyPayments getMonthlyPayments :: Persist [Entity Payment] getMonthlyPayments = selectList [ PaymentDeletedAt P.==. Nothing , PaymentFrequency P.==. Monthly ] [ Desc PaymentName ] getJsonPayment :: Entity Payment -> P.Payment getJsonPayment paymentEntity = let payment = entityVal paymentEntity in P.Payment { P.id = entityKey paymentEntity , P.creation = paymentCreation payment , P.name = paymentName payment , P.cost = paymentCost payment , P.userId = paymentUserId payment } createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId) createPayment userId name cost frequency = case validatePayment name cost of Left err -> return . Left $ err Right (validatedName, validatedCost) -> do now <- liftIO getCurrentTime Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency) validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int) validatePayment name cost = let eitherName = Validation.nonEmpty K.CategoryRequired name eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0) in case (eitherName, eitherCost) of (Right validatedName, Right validatedCost) -> Right (validatedName, validatedCost) _ -> let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName] costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost] in Left (nameErrors ++ costErrors) deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool deleteOwnPayment user paymentId = do mbPayment <- get paymentId case mbPayment of Just payment -> if paymentUserId payment == entityKey user then do now <- liftIO getCurrentTime P.update paymentId [PaymentDeletedAt P.=. Just now] return True else return False Nothing -> return False getPaymentsCount :: Persist Int getPaymentsCount = count [ PaymentDeletedAt P.==. Nothing , PaymentFrequency P.==. Punctual ]