From 9ec84e3a20c767f6525639f58cd22715e302b88d Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 26 Jun 2016 12:31:24 +0200
Subject: Add an editable date field for punctual payment creation

---
 src/server/Model/Database.hs             |  3 ++-
 src/server/Model/Income.hs               |  8 ++++----
 src/server/Model/Init.hs                 |  4 ++--
 src/server/Model/Json/AddIncome.hs       | 17 -----------------
 src/server/Model/Json/CreateIncome.hs    | 17 +++++++++++++++++
 src/server/Model/Json/CreatePayment.hs   | 22 ++++++++++++++++++++++
 src/server/Model/Json/Income.hs          |  2 +-
 src/server/Model/Json/Payment.hs         |  4 ++--
 src/server/Model/Message/Key.hs          |  5 +++--
 src/server/Model/Message/Translations.hs | 11 ++++++++---
 src/server/Model/Payment.hs              | 31 ++++++++++++++++---------------
 11 files changed, 77 insertions(+), 47 deletions(-)
 delete mode 100644 src/server/Model/Json/AddIncome.hs
 create mode 100644 src/server/Model/Json/CreateIncome.hs
 create mode 100644 src/server/Model/Json/CreatePayment.hs

(limited to 'src/server/Model')

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/AddIncome.hs
deleted file mode 100644
index 6570ba9..0000000
--- a/src/server/Model/Json/AddIncome.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.AddIncome
-  ( AddIncome(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-
-data AddIncome = AddIncome
-  { day :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON AddIncome
diff --git a/src/server/Model/Json/CreateIncome.hs b/src/server/Model/Json/CreateIncome.hs
new file mode 100644
index 0000000..cf9b1c3
--- /dev/null
+++ b/src/server/Model/Json/CreateIncome.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.CreateIncome
+  ( CreateIncome(..)
+  ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+
+data CreateIncome = CreateIncome
+  { date :: Day
+  , amount :: Int
+  } deriving (Show, Generic)
+
+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 ->
-- 
cgit v1.2.3