{-# LANGUAGE OverloadedStrings #-} module Model.Payment ( getPayments , getMonthlyPayments , createPayment , deleteOwnPayment ) 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 Validation import Model.Database import Model.Frequency import qualified Model.Json.Payment as P import qualified Model.Message.Key as K getPayments :: Persist [P.Payment] getPayments = map getJsonPayment <$> selectList [ PaymentDeletedAt ==. Nothing ] [ Desc PaymentCreation ] getMonthlyPayments :: Persist [Entity Payment] getMonthlyPayments = selectList [ PaymentDeletedAt ==. Nothing , PaymentFrequency ==. 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 , P.frequency = paymentFrequency 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 update paymentId [PaymentDeletedAt =. Just now] return True else return False Nothing -> return False