blob: ad1c26160aa47a468e2faae4b3c5945ebe799afa (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
module Model.Payment
( getPayments
, createPayment
) where
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Control.Monad.IO.Class (liftIO)
import Database.Persist
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)
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 (paymentCreation payment) (paymentName payment) (paymentCost payment) (userName user)
createPayment :: UserId -> Text -> Int -> Persist PaymentId
createPayment userId name cost = do
now <- liftIO getCurrentTime
insert $ Payment userId now name cost
|
