aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/client/Model/Payment.elm6
-rw-r--r--src/client/ServerCommunication.elm4
-rw-r--r--src/client/Update/Payment.elm7
-rw-r--r--src/client/View/Payments/Table.elm2
-rw-r--r--src/server/Controller/Payment.hs7
-rw-r--r--src/server/Design/Global.hs1
-rw-r--r--src/server/Model/Database.hs4
-rw-r--r--src/server/Model/Json/Payment.hs3
-rw-r--r--src/server/Model/Payment.hs14
9 files changed, 36 insertions, 12 deletions
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