diff options
author | Joris | 2016-06-26 12:31:24 +0200 |
---|---|---|
committer | Joris | 2016-06-26 12:31:24 +0200 |
commit | 9ec84e3a20c767f6525639f58cd22715e302b88d (patch) | |
tree | a080552859180707472c1a289080857c0a54fc06 /src/server/Model | |
parent | 5cb36652ccf07c9e0995ebc421a837ad7d258469 (diff) |
Add an editable date field for punctual payment creation
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Database.hs | 3 | ||||
-rw-r--r-- | src/server/Model/Income.hs | 8 | ||||
-rw-r--r-- | src/server/Model/Init.hs | 4 | ||||
-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.hs | 22 | ||||
-rw-r--r-- | src/server/Model/Json/Income.hs | 2 | ||||
-rw-r--r-- | src/server/Model/Json/Payment.hs | 4 | ||||
-rw-r--r-- | src/server/Model/Message/Key.hs | 5 | ||||
-rw-r--r-- | src/server/Model/Message/Translations.hs | 11 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 31 |
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 -> |