aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
authorJoris2016-06-26 12:31:24 +0200
committerJoris2016-06-26 12:31:24 +0200
commit9ec84e3a20c767f6525639f58cd22715e302b88d (patch)
treea080552859180707472c1a289080857c0a54fc06 /src/server/Model
parent5cb36652ccf07c9e0995ebc421a837ad7d258469 (diff)
Add an editable date field for punctual payment creation
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs3
-rw-r--r--src/server/Model/Income.hs8
-rw-r--r--src/server/Model/Init.hs4
-rw-r--r--src/server/Model/Json/CreateIncome.hs (renamed from src/server/Model/Json/AddIncome.hs)10
-rw-r--r--src/server/Model/Json/CreatePayment.hs22
-rw-r--r--src/server/Model/Json/Income.hs2
-rw-r--r--src/server/Model/Json/Payment.hs4
-rw-r--r--src/server/Model/Message/Key.hs5
-rw-r--r--src/server/Model/Message/Translations.hs11
-rw-r--r--src/server/Model/Payment.hs31
10 files changed, 65 insertions, 35 deletions
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 5df925a..7e67f9a 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -35,9 +35,10 @@ User
deriving Show
Payment
userId UserId
- creation UTCTime
+ date Day
name Text
cost Int
+ createdAt UTCTime
deletedAt UTCTime Maybe
frequency Frequency
deriving Show
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 119a44f..62ab0ed 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,7 +1,7 @@
module Model.Income
( getJsonIncome
, getIncomes
- , addIncome
+ , createIncome
, deleteOwnIncome
) where
@@ -23,10 +23,10 @@ getJsonIncome incomeEntity =
getIncomes :: Persist [Entity Income]
getIncomes = selectList [IncomeDeletedAt ==. Nothing] []
-addIncome :: UserId -> Day -> Int -> Persist IncomeId
-addIncome userId day amount = do
+createIncome :: UserId -> Day -> Int -> Persist IncomeId
+createIncome userId date amount = do
now <- liftIO getCurrentTime
- insert (Income userId day amount now Nothing)
+ insert (Income userId date amount now Nothing)
deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool
deleteOwnIncome user incomeId = do
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
index 167eead..09ac627 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -11,7 +11,7 @@ import Database.Persist
import Model.Database
import Model.Json.Init (Init, Init(Init))
-import Model.Payment (getPayments)
+import qualified Model.Payment as Payment
import Model.User (getUsers, getJsonUser)
import Model.Income (getIncomes, getJsonIncome)
@@ -21,7 +21,7 @@ getInit :: Entity User -> Persist Init
getInit user =
liftIO . runDb $ do
users <- getUsers
- payments <- getPayments
+ payments <- Payment.list
incomes <- getIncomes
return $ Init
{ Init.users = map getJsonUser users
diff --git a/src/server/Model/Json/AddIncome.hs b/src/server/Model/Json/CreateIncome.hs
index 6570ba9..cf9b1c3 100644
--- a/src/server/Model/Json/AddIncome.hs
+++ b/src/server/Model/Json/CreateIncome.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
-module Model.Json.AddIncome
- ( AddIncome(..)
+module Model.Json.CreateIncome
+ ( CreateIncome(..)
) where
import GHC.Generics
@@ -9,9 +9,9 @@ import GHC.Generics
import Data.Aeson
import Data.Time.Calendar (Day)
-data AddIncome = AddIncome
- { day :: Day
+data CreateIncome = CreateIncome
+ { date :: Day
, amount :: Int
} deriving (Show, Generic)
-instance FromJSON AddIncome
+instance FromJSON CreateIncome
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
new file mode 100644
index 0000000..f117daf
--- /dev/null
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.CreatePayment
+ ( CreatePayment(..)
+ ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+import Data.Text (Text)
+
+import Model.Frequency (Frequency)
+
+data CreatePayment = CreatePayment
+ { date :: Day
+ , name :: Text
+ , cost :: Int
+ , frequency :: Frequency
+ } deriving (Show, Generic)
+
+instance FromJSON CreatePayment
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index e80ab63..bb1ac97 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -14,7 +14,7 @@ import Model.Database (IncomeId, UserId)
data Income = Income
{ id :: IncomeId
, userId :: UserId
- , day :: Day
+ , date :: Day
, amount :: Int
} deriving (Show, Generic)
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 7f4de15..04c6de8 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -6,16 +6,16 @@ module Model.Json.Payment
import GHC.Generics
-import Data.Time
import Data.Text (Text)
import Data.Aeson
+import Data.Time.Calendar (Day)
import Model.Database (PaymentId, UserId)
import Model.Frequency
data Payment = Payment
{ id :: PaymentId
- , creation :: UTCTime
+ , date :: Day
, name :: Text
, cost :: Int
, userId :: UserId
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 8b957f1..093024b 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -75,6 +75,7 @@ data Key =
| PaymentName
| PaymentCost
+ | PaymentDate
| PaymentPunctual
| PaymentMonthly
@@ -90,7 +91,7 @@ data Key =
| Income
| MonthlyNetIncomes
| IncomeNotDeleted
- | IncomeCreation
+ | IncomeDate
| IncomeAmount
| ConfirmDelete
@@ -117,4 +118,4 @@ data Key =
deriving (Enum, Bounded, Show)
instance Json.ToJSON Key where
- toJSON = Json.String . T.pack . show
+ toJSON = Json.String . T.pack . show
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index df3f402..6522d75 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -312,6 +312,11 @@ m l PaymentCost =
English -> "Cost"
French -> "Coût"
+m l PaymentDate =
+ case l of
+ English -> "Date"
+ French -> "Date"
+
m l PaymentPunctual =
case l of
English -> "Punctual"
@@ -344,10 +349,10 @@ m l IncomeNotDeleted =
English -> "The income could not have been deleted."
French -> "Le revenu n'a pas pu être supprimé."
-m l IncomeCreation =
+m l IncomeDate =
case l of
- English -> "Creation"
- French -> "Création"
+ English -> "Date"
+ French -> "Date"
m l IncomeAmount =
case l of
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 28f1a09..51ca152 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,14 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module Model.Payment
- ( getPayments
- , getMonthlyPayments
- , createPayment
- , deleteOwnPayment
+ ( list
+ , listMonthly
+ , create
+ , deleteOwn
) where
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
+import Data.Time.Calendar (Day)
import Control.Monad.IO.Class (liftIO)
@@ -18,14 +19,14 @@ import Model.Database
import Model.Frequency
import qualified Model.Json.Payment as P
-getPayments :: Persist [P.Payment]
-getPayments =
+list :: Persist [P.Payment]
+list =
map getJsonPayment <$> selectList
[ PaymentDeletedAt ==. Nothing ]
- [ Desc PaymentCreation ]
+ []
-getMonthlyPayments :: Persist [Entity Payment]
-getMonthlyPayments =
+listMonthly :: Persist [Entity Payment]
+listMonthly =
selectList
[ PaymentDeletedAt ==. Nothing
, PaymentFrequency ==. Monthly
@@ -37,20 +38,20 @@ getJsonPayment paymentEntity =
let payment = entityVal paymentEntity
in P.Payment
{ P.id = entityKey paymentEntity
- , P.creation = paymentCreation payment
+ , P.date = paymentDate payment
, P.name = paymentName payment
, P.cost = paymentCost payment
, P.userId = paymentUserId payment
, P.frequency = paymentFrequency payment
}
-createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId
-createPayment userId name cost frequency = do
+create :: UserId -> Day -> Text -> Int -> Frequency -> Persist PaymentId
+create userId date name cost frequency = do
now <- liftIO getCurrentTime
- insert (Payment userId now name cost Nothing frequency)
+ insert (Payment userId date name cost now Nothing frequency)
-deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
-deleteOwnPayment user paymentId = do
+deleteOwn :: Entity User -> PaymentId -> Persist Bool
+deleteOwn user paymentId = do
mbPayment <- get paymentId
case mbPayment of
Just payment ->