diff options
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Json/Payment.hs | 6 | ||||
-rw-r--r-- | src/server/Model/Json/TotalPayment.hs | 4 | ||||
-rw-r--r-- | src/server/Model/Json/User.hs | 21 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 15 | ||||
-rw-r--r-- | src/server/Model/User.hs | 11 |
5 files changed, 42 insertions, 15 deletions
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs index f22c8cf..8923c13 100644 --- a/src/server/Model/Json/Payment.hs +++ b/src/server/Model/Json/Payment.hs @@ -10,12 +10,14 @@ import Data.Time import Data.Text (Text) import Data.Aeson +import Model.Database (PaymentId, UserId) + data Payment = Payment - { id :: Text + { id :: PaymentId , creation :: UTCTime , name :: Text , cost :: Int - , userName :: Text + , userId :: UserId } deriving (Show, Generic) instance FromJSON Payment diff --git a/src/server/Model/Json/TotalPayment.hs b/src/server/Model/Json/TotalPayment.hs index e386c79..5ae68c9 100644 --- a/src/server/Model/Json/TotalPayment.hs +++ b/src/server/Model/Json/TotalPayment.hs @@ -9,8 +9,10 @@ import GHC.Generics import Data.Text (Text) import Data.Aeson +import Model.Database (UserId) + data TotalPayment = TotalPayment - { userName :: Text + { userId :: UserId , totalPayment :: Int } deriving (Show, Generic) diff --git a/src/server/Model/Json/User.hs b/src/server/Model/Json/User.hs new file mode 100644 index 0000000..ebc347b --- /dev/null +++ b/src/server/Model/Json/User.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.User + ( User(..) + ) where + +import GHC.Generics + +import Data.Aeson +import Data.Text (Text) + +import Model.Database (UserId) + +data User = User + { id :: UserId + , name :: Text + , email :: Text + } deriving (Show, Generic) + +instance FromJSON User +instance ToJSON User diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index ce8c5a1..d7632f0 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,14 +1,12 @@ module Model.Payment ( getPayments , createPayment - , paymentKeyToText , deleteOwnPayment , getTotalPayments , getPaymentsCount ) where import Data.Text (Text) -import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Data.Maybe (catMaybes) @@ -40,16 +38,13 @@ getJsonPayment (paymentEntity, userEntity) = let payment = entityVal paymentEntity user = entityVal userEntity in P.Payment - { P.id = paymentKeyToText . entityKey $ paymentEntity + { P.id = entityKey paymentEntity , P.creation = paymentCreation payment , P.name = paymentName payment , P.cost = paymentCost payment - , P.userName = userName user + , P.userId = entityKey userEntity } -paymentKeyToText :: Key Payment -> Text -paymentKeyToText = T.pack . show . unSqlBackendKey . unPaymentKey - createPayment :: UserId -> Text -> Int -> Persist PaymentId createPayment userId name cost = do now <- liftIO getCurrentTime @@ -77,11 +72,11 @@ getTotalPayments = do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) groupBy (payment ^. PaymentUserId) - return (user ^. UserName, sum_ (payment ^. PaymentCost)) + return (user ^. UserId, sum_ (payment ^. PaymentCost)) return $ catMaybes . map (getTotalPayment . unValueTuple) $ values -getTotalPayment :: (Text, Maybe Int) -> Maybe TP.TotalPayment -getTotalPayment (userName, Just cost) = Just (TP.TotalPayment userName cost) +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) diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs index 339aff6..2b52d03 100644 --- a/src/server/Model/User.hs +++ b/src/server/Model/User.hs @@ -1,6 +1,7 @@ module Model.User ( getUsers , getUser + , getJsonUser , createUser , deleteUser ) where @@ -13,13 +14,19 @@ import Control.Monad.IO.Class (liftIO) import Database.Persist import Model.Database +import qualified Model.Json.User as Json -getUsers :: Persist [User] -getUsers = map entityVal <$> selectList [] [Desc UserCreation] +getUsers :: Persist [Entity User] +getUsers = selectList [] [Desc UserCreation] getUser :: Text -> Persist (Maybe (Entity User)) getUser email = selectFirst [UserEmail ==. email] [] +getJsonUser :: Entity User -> Json.User +getJsonUser userEntity = + let user = entityVal userEntity + in Json.User (entityKey userEntity) (userName user) (userEmail user) + createUser :: Text -> Text -> Persist UserId createUser email name = do now <- liftIO getCurrentTime |