From 359f837511597354bc6462cfc4200f54d647d728 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Thu, 13 Aug 2015 22:55:41 +0200 Subject: Giving the payment id to the client --- src/client/Model/Payment.elm | 6 ++++-- src/client/ServerCommunication.elm | 4 +++- src/client/Update/Payment.elm | 7 ++++--- src/client/View/Payments/Table.elm | 2 +- src/server/Controller/Payment.hs | 7 +++++-- src/server/Design/Global.hs | 1 + src/server/Model/Database.hs | 4 ++++ src/server/Model/Json/Payment.hs | 3 ++- src/server/Model/Payment.hs | 14 ++++++++++++-- 9 files changed, 36 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm index 4a08027..ff8f157 100644 --- a/src/client/Model/Payment.elm +++ b/src/client/Model/Payment.elm @@ -10,7 +10,8 @@ import Json.Decode as Json exposing ((:=)) type alias Payments = List Payment type alias Payment = - { creation : Date + { id : String + , creation : Date , name : String , cost : Int , userName : String @@ -21,7 +22,8 @@ paymentsDecoder = Json.list paymentDecoder paymentDecoder : Json.Decoder Payment paymentDecoder = - Json.object4 Payment + Json.object5 Payment + ("id" := Json.string) ("creation" := dateDecoder) ("name" := Json.string) ("cost" := Json.int) diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm index ccf63f2..b4b547d 100644 --- a/src/client/ServerCommunication.elm +++ b/src/client/ServerCommunication.elm @@ -71,7 +71,9 @@ communicationToAction communication response = SignIn login -> U.UpdateSignIn (ValidLogin login) AddPayment name cost -> - U.UpdatePayment (UP.AddPayment name cost) + decodeResponse + response + (\id -> U.UpdatePayment (UP.AddPayment id name cost)) SignOut -> U.GoSignInView else diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm index 2d558fd..7826098 100644 --- a/src/client/Update/Payment.elm +++ b/src/client/Update/Payment.elm @@ -15,7 +15,7 @@ import Update.Payment.Add exposing (..) type PaymentAction = UpdateAdd AddPaymentAction | UpdatePayments Payments - | AddPayment String Int + | AddPayment String String Int updatePayment : Model -> PaymentAction -> PaymentView -> PaymentView updatePayment model action paymentView = @@ -24,9 +24,10 @@ updatePayment model action paymentView = { paymentView | add <- updateAddPayment addPaymentAction paymentView.add } UpdatePayments payments -> { paymentView | payments <- payments } - AddPayment name cost -> + AddPayment id name cost -> let payment = - { creation = Date.fromTime model.currentTime + { id = id + , creation = Date.fromTime model.currentTime , name = name , cost = cost , userName = paymentView.userName diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm index 34dc058..b92735a 100644 --- a/src/client/View/Payments/Table.elm +++ b/src/client/View/Payments/Table.elm @@ -38,7 +38,7 @@ paymentLine : Payment -> Html paymentLine payment = tr [] - [ td [] [ text payment.userName ] + [ td [] [ text payment.id ] , td [] [ text payment.name ] , td [] [ text ((toString payment.cost) ++ " €") ] , td [] [ text (renderDate payment.creation) ] diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 1287825..219206a 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -11,10 +11,13 @@ import Control.Monad.IO.Class (liftIO) import Data.Text (Text) +import Database.Persist.Sqlite (unSqlBackendKey) + import qualified Secure import Model.Database import Model.Payment +import Model.Json.Message getPaymentsAction :: ActionM () getPaymentsAction = @@ -26,6 +29,6 @@ getPaymentsAction = createPaymentAction :: Text -> Int -> ActionM () createPaymentAction name cost = Secure.loggedAction (\user -> do - _ <- liftIO . runDb $ createPayment (entityKey user) name cost - return () + paymentKey <- liftIO . runDb $ createPayment (entityKey user) name cost + json . Message . paymentKeyToText $ paymentKey ) diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index 76db6dd..54533c2 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -72,6 +72,7 @@ global = do lineHeight (px inputHeight) fontSize (px 22) verticalAlign middle + cursor cursorText input ? defaultInput inputHeight "input:focus + label" ? backgroundColor C.grey diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index e5fd075..7f1777a 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -16,6 +16,7 @@ import Control.Monad.Trans.Resource (runResourceT, ResourceT) import Data.Text import Data.Time.Clock (UTCTime) +import Data.Int (Int64) import Database.Persist.Sqlite import Database.Persist.TH @@ -49,3 +50,6 @@ runDb = runNoLoggingT . runResourceT . withSqliteConn "database" . runSqlConn runMigrations :: IO () runMigrations = runDb $ runMigration migrateAll + +textToKey :: (ToBackendKey SqlBackend a) => String -> Key a +textToKey text = toSqlKey (read text :: Int64) diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs index de6beb9..f22c8cf 100644 --- a/src/server/Model/Json/Payment.hs +++ b/src/server/Model/Json/Payment.hs @@ -11,7 +11,8 @@ import Data.Text (Text) import Data.Aeson data Payment = Payment - { creation :: UTCTime + { id :: Text + , creation :: UTCTime , name :: Text , cost :: Int , userName :: Text diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index ad1c261..2e191b9 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,9 +1,11 @@ module Model.Payment ( getPayments , createPayment + , paymentKeyToText ) where import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Control.Monad.IO.Class (liftIO) @@ -27,8 +29,16 @@ 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) - + 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 -- cgit v1.2.3