module Model.Payment ( getPayments , createPayment , deleteOwnPayment , getTotalPayments , getPaymentsCount ) where import Data.Text (Text) import Data.Time.Clock (getCurrentTime) import Data.Maybe (catMaybes) import Control.Monad.IO.Class (liftIO) import Database.Persist import qualified Database.Persist as P import Database.Esqueleto import qualified Database.Esqueleto as E import Model.Database import qualified Model.Json.Payment as P import qualified Model.Json.TotalPayment as TP getPayments :: Int -> Int -> Persist [P.Payment] getPayments page perPage = do xs <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) orderBy [desc (payment ^. PaymentCreation)] limit . fromIntegral $ perPage offset . fromIntegral $ (page - 1) * perPage return (payment, user) return (map getJsonPayment xs) getJsonPayment :: (Entity Payment, Entity User) -> P.Payment getJsonPayment (paymentEntity, userEntity) = let payment = entityVal paymentEntity user = entityVal userEntity in P.Payment { P.id = entityKey paymentEntity , P.creation = paymentCreation payment , P.name = paymentName payment , P.cost = paymentCost payment , P.userId = entityKey userEntity } createPayment :: UserId -> Text -> Int -> Persist PaymentId createPayment userId name cost = do now <- liftIO getCurrentTime insert $ Payment userId now name cost Nothing 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 getTotalPayments :: Persist [TP.TotalPayment] getTotalPayments = do values <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) groupBy (payment ^. PaymentUserId) return (user ^. UserId, sum_ (payment ^. PaymentCost)) return $ catMaybes . map (getTotalPayment . unValueTuple) $ values getTotalPayment :: (UserId, Maybe Int) -> Maybe TP.TotalPayment getTotalPayment (userId, Just cost) = Just (TP.TotalPayment userId cost) getTotalPayment (_, Nothing) = Nothing unValueTuple :: (Value a, Value b) -> (a, b) unValueTuple (Value a, Value b) = (a, b) getPaymentsCount :: Persist Int getPaymentsCount = unValue . head <$> (select $ from $ \payment -> do where_ (isNothing (payment ^. PaymentDeletedAt)) return countRows) :: Persist Int