module Model.Payment ( getPayments , createPayment , paymentKeyToText , deleteOwnPayment ) where import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) 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 getPayments :: Persist [P.Payment] getPayments = do xs <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) 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 = paymentKeyToText . entityKey $ paymentEntity , P.creation = paymentCreation payment , P.name = paymentName payment , P.cost = paymentCost payment , P.userName = userName user } paymentKeyToText :: Key Payment -> Text paymentKeyToText = T.pack . show . unSqlBackendKey . unPaymentKey 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