From 70720548c9af024dbb6080638ac8e5470c2213eb Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 25 Jun 2016 15:10:03 +0200
Subject: Use the search to view either punctual or monthly payments

---
 src/server/Controller/Payment.hs           |  12 +--
 src/server/Design/Dialog.hs                |  13 +++
 src/server/Design/Form.hs                  |  24 +++---
 src/server/Design/Global.hs                |   2 +
 src/server/Design/Helper.hs                |  18 +----
 src/server/Design/LoggedIn.hs              |  12 +--
 src/server/Design/LoggedIn/Home.hs         |   8 +-
 src/server/Design/LoggedIn/Home/Add.hs     |  87 --------------------
 src/server/Design/LoggedIn/Home/Header.hs  |  56 +++++++++++++
 src/server/Design/LoggedIn/Home/Monthly.hs |  23 ------
 src/server/Design/LoggedIn/Home/Search.hs  |  31 --------
 src/server/Design/LoggedIn/Home/Table.hs   | 123 +++++++++++++++--------------
 src/server/Main.hs                         |   2 +-
 src/server/Model/Message/Key.hs            |  28 ++++---
 src/server/Model/Message/Translations.hs   |  93 +++++++++++++---------
 src/server/Model/Payment.hs                |  28 +------
 src/server/Validation.hs                   |  18 ++---
 17 files changed, 245 insertions(+), 333 deletions(-)
 create mode 100644 src/server/Design/Dialog.hs
 delete mode 100644 src/server/Design/LoggedIn/Home/Add.hs
 create mode 100644 src/server/Design/LoggedIn/Home/Header.hs
 delete mode 100644 src/server/Design/LoggedIn/Home/Monthly.hs
 delete mode 100644 src/server/Design/LoggedIn/Home/Search.hs

(limited to 'src/server')

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 7e8d0a3..294e4c4 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -15,7 +15,6 @@ import Database.Persist
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
-import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Aeson.Types as Json
 
@@ -34,16 +33,11 @@ getPayments =
     (liftIO $ runDb P.getPayments) >>= json
   )
 
-createPayment :: Text -> Text -> Frequency -> ActionM ()
+createPayment :: Text -> Int -> Frequency -> ActionM ()
 createPayment name cost frequency =
   Secure.loggedAction (\user -> do
-    creationResult <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
-    case creationResult of
-      Left errors -> do
-        status badRequest400
-        jsonObject . map (\(a, b) -> (a, Json.String . T.pack . show $ b)) $ errors
-      Right paymentId ->
-        jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)]
+    paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
+    jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)]
   )
 
 deleteOwnPayment :: Text -> ActionM ()
diff --git a/src/server/Design/Dialog.hs b/src/server/Design/Dialog.hs
new file mode 100644
index 0000000..f0b8009
--- /dev/null
+++ b/src/server/Design/Dialog.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.Dialog
+  ( design
+  ) where
+
+import Clay
+
+design :: Css
+design = do
+
+  ".paymentDialog" ? do
+    ".radioGroup" ? ".title" ? display none
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
index 4bd1ad6..c2537f1 100644
--- a/src/server/Design/Form.hs
+++ b/src/server/Design/Form.hs
@@ -66,14 +66,18 @@ design = do
       color Color.silver
       marginBottom (em 0.8)
 
-    ".radioElems" ? do
+    ".radioInputs" ? do
       display flex
-      "justify-content" -: "space-around"
-
-      label ? do
-        marginBottom (px 5)
-        display block
-        cursor pointer
-        input ? do
-          margin (px 0) (px 8) (px (-1)) (px 0)
-          cursor pointer
+      "justify-content" -: "center"
+
+      ".radioInput:not(:last-child)::after" ? do
+        content (stringContent "/")
+        marginLeft (px 10)
+        marginRight (px 10)
+
+      input ? display none
+      label ? cursor pointer
+
+      "input:checked + label" ? do
+        color Color.chestnutRose
+        fontWeight bold
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 7d4a1bb..149769c 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -12,6 +12,7 @@ import qualified Design.Header as Header
 import qualified Design.SignIn as SignIn
 import qualified Design.LoggedIn as LoggedIn
 import qualified Design.Form as Form
+import qualified Design.Dialog as Dialog
 
 import Design.Animation.Keyframes
 
@@ -28,6 +29,7 @@ global = do
   header ? Header.design
   ".signIn" ? SignIn.design
   ".loggedIn" ? LoggedIn.design
+  ".dialog" ? Dialog.design
   Form.design
 
   allKeyframes
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index deb0aab..c8b3070 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -3,10 +3,9 @@
 module Design.Helper
   ( clearFix
   , defaultButton
-  , iconButton
   , defaultInput
+  , iconButton
   , centeredWithMargin
-  , expandBlock
   , verticalCentering
   ) where
 
@@ -69,21 +68,6 @@ centeredWithMargin = do
   marginLeft auto
   marginRight auto
 
-expandBlock :: Color -> Color -> Size Abs -> Css
-expandBlock headerBackground headerColor headerHeight = do
-  marginBottom blockMarginBottom
-  marginLeft (pct blockPercentMargin)
-  marginRight (pct blockPercentMargin)
-  ".header" ? do
-    defaultButton headerBackground headerColor headerHeight focusLighten
-    width (pct 100)
-    fontSize (px 18)
-    borderRadius radius radius radius radius
-    textAlign (alignSide sideLeft)
-    position relative
-    paddingLeft blockPadding
-    paddingRight (px 55)
-
 verticalCentering :: Css
 verticalCentering = do
   position absolute
diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs
index 63ff413..5a3297a 100644
--- a/src/server/Design/LoggedIn.hs
+++ b/src/server/Design/LoggedIn.hs
@@ -8,15 +8,15 @@ import Data.Monoid ((<>))
 
 import Clay
 
-import qualified Design.LoggedIn.Home as HomeDesign
-import qualified Design.LoggedIn.Income as IncomeDesign
-import qualified Design.LoggedIn.Stat as StatDesign
+import qualified Design.LoggedIn.Home as Home
+import qualified Design.LoggedIn.Income as Income
+import qualified Design.LoggedIn.Stat as Stat
 
 design :: Css
 design = do
-  ".home" ? HomeDesign.design
-  ".income" ? IncomeDesign.design
-  ".stat" ? StatDesign.design
+  ".home" ? Home.design
+  ".income" ? Income.design
+  ".stat" ? Stat.design
 
   (".income" <> ".stat") ? do
     "margin" -: "0 2vw"
diff --git a/src/server/Design/LoggedIn/Home.hs b/src/server/Design/LoggedIn/Home.hs
index 47bfc84..7845434 100644
--- a/src/server/Design/LoggedIn/Home.hs
+++ b/src/server/Design/LoggedIn/Home.hs
@@ -6,16 +6,12 @@ module Design.LoggedIn.Home
 
 import Clay
 
-import qualified Design.LoggedIn.Home.Add as Add
-import qualified Design.LoggedIn.Home.Monthly as Monthly
-import qualified Design.LoggedIn.Home.Search as Search
+import qualified Design.LoggedIn.Home.Header as Header
 import qualified Design.LoggedIn.Home.Table as Table
 import qualified Design.LoggedIn.Home.Pages as Pages
 
 design :: Css
 design = do
-  form # ".addPayment" ? Add.design
-  ".monthly" ? Monthly.design
-  ".search" ? Search.design
+  ".header" ? Header.design
   ".table" ? Table.design
   ".pages" ? Pages.design
diff --git a/src/server/Design/LoggedIn/Home/Add.hs b/src/server/Design/LoggedIn/Home/Add.hs
deleted file mode 100644
index ce64077..0000000
--- a/src/server/Design/LoggedIn/Home/Add.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Design.LoggedIn.Home.Add
-  ( design
-  ) where
-
-import Data.Monoid ((<>))
-
-import Clay
-
-import Design.Color as Color
-import Design.Helper
-import Design.Constants
-
-design :: Css
-design = do
-  centeredWithMargin
-  display flex
-  "justify-content" -: "center"
-
-  ".name" <> ".cost" ? do
-    position relative
-    display flex
-    marginRight (pct blockPercentMargin)
-    label ? do
-      fontWeight bold
-      display inlineBlock
-      width (px 50)
-      textAlign (alignSide sideCenter)
-      backgroundColor Color.dustyGray
-      color Color.white
-      height (px inputHeight)
-      lineHeight (px inputHeight)
-      fontSize (px 22)
-      verticalAlign middle
-      cursor cursorText
-      borderRadius (px 0) radius radius (px 0)
-    input ? do
-      defaultInput inputHeight
-      borderRadius radius (px 0) (px 0) radius
-      "width" -: "calc(100% - 40px)"
-    input # focus |+ label ?
-      backgroundColor Color.silver
-    hover & do
-      input ? borderColor Color.silver
-      label ? backgroundColor Color.silver
-
-  ".name" ? minWidth (px 150)
-
-  button # ".frequency" ? do
-    fontSize (pct 90)
-    marginRight (pct blockPercentMargin)
-
-    (".punctual" <> ".monthly") ? do
-      defaultButton Color.wildSand Color.dustyGray (px $ inputHeight `Prelude.div` 2) focusLighten
-      paddingLeft (px 15)
-      paddingRight (px 15)
-      ".selected" & do
-        backgroundColor Color.gothic
-        color Color.white
-
-    hover & (".punctual" <> ".monthly") ?
-      ".selected" & backgroundColor (focusLighten Color.gothic)
-
-    focus & (".punctual" <> ".monthly") ?
-      ".selected" & backgroundColor (focusLighten Color.gothic)
-
-    ".punctual" ? borderRadius radius radius 0 0
-    ".monthly" ? borderRadius 0 0 radius radius
-
-  button # ".add" ? do
-    defaultButton Color.chestnutRose Color.white (px inputHeight) focusLighten
-    paddingLeft (px 15)
-    paddingRight (px 15)
-    i ? marginLeft (px 10)
-    ".waitingServer" & ("cursor" -: "not-allowed")
-
-  ".name.error" <> ".cost.error" ? do
-    input ? borderColor Color.chestnutRose
-    label ? backgroundColor Color.chestnutRose
-    "input:focus + label" ? backgroundColor Color.chestnutRose
-
-  ".errorMessage" ? do
-    position absolute
-    color Color.chestnutRose
-    top (px (inputHeight + 10))
-    left (px 0)
diff --git a/src/server/Design/LoggedIn/Home/Header.hs b/src/server/Design/LoggedIn/Home/Header.hs
new file mode 100644
index 0000000..9008a95
--- /dev/null
+++ b/src/server/Design/LoggedIn/Home/Header.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.LoggedIn.Home.Header
+  ( design
+  ) where
+
+import Clay
+
+import Design.Constants
+
+import qualified Design.Helper as Helper
+import qualified Design.Color as Color
+import qualified Design.Constants as Constants
+
+design :: Css
+design = do
+  marginBottom blockMarginBottom
+  marginLeft (pct blockPercentMargin)
+  marginRight (pct blockPercentMargin)
+
+  ".exceedingPayers" ? do
+    backgroundColor Color.mossGreen
+    padding (px 10) (px 10) (px 10) (px 10)
+    borderRadius (px 5) (px 5) (px 5) (px 5)
+    color Color.white
+    marginBottom (em 1)
+
+    ".exceedingPayer:not(:last-child)::after" ? content (stringContent ", ")
+
+    ".userName" ? marginRight (px 5)
+
+  ".searchLine" ? do
+    marginBottom (em 1)
+    form ? do
+      display inlineBlock
+
+      ".textInput" ? do
+        display inlineBlock
+        marginRight (px 30)
+        marginBottom (px 0)
+
+      ".radioGroup" ? do
+        display inlineBlock
+        marginBottom (px 0)
+        ".title" ? display none
+
+    ".addPayment" ? do
+      Helper.defaultButton Color.chestnutRose Color.white (px 47) Constants.focusLighten
+      float floatRight
+
+  ".infos" ? do
+    lineHeight (px Constants.inputHeight)
+
+    ".partition" ? do
+      color Color.dustyGray
+      marginLeft (px 15)
diff --git a/src/server/Design/LoggedIn/Home/Monthly.hs b/src/server/Design/LoggedIn/Home/Monthly.hs
deleted file mode 100644
index 5e976ef..0000000
--- a/src/server/Design/LoggedIn/Home/Monthly.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Design.LoggedIn.Home.Monthly
-  ( design
-  ) where
-
-import Clay
-
-import Design.Color as Color
-import Design.Helper
-import Design.Constants
-
-design :: Css
-design = do
-
-  expandBlock Color.gothic Color.white (px inputHeight)
-
-  ".expand" ? do
-    position absolute
-    right blockPadding
-    bottom (px 0)
-
-  ".detail" |> ".header" ? borderRadius radius radius 0 0
diff --git a/src/server/Design/LoggedIn/Home/Search.hs b/src/server/Design/LoggedIn/Home/Search.hs
deleted file mode 100644
index 726b4cf..0000000
--- a/src/server/Design/LoggedIn/Home/Search.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Design.LoggedIn.Home.Search
-  ( design
-  ) where
-
-import Clay
-
-import Design.Constants
-
-import qualified Design.Helper as Helper
-import qualified Design.Color as Color
-import qualified Design.Constants as Constants
-
-design :: Css
-design = do
-  marginBottom blockMarginBottom
-  marginLeft (pct blockPercentMargin)
-  marginRight (pct blockPercentMargin)
-
-  ".textInput" ? do
-    display inlineBlock
-    marginRight (px 30)
-    marginBottom (px 0)
-
-  ".stat" ? do
-    lineHeight (pct 100)
-
-  ".addPayment" ? do
-    Helper.defaultButton Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-    float floatRight
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index 538bc6d..a229132 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -16,70 +16,75 @@ import Design.Helper
 
 design :: Css
 design = do
-  display D.table
-  width (pct 100)
-  textAlign (alignSide (sideCenter))
+  ".noPayment" ? do
+    margin (em 2) (em 2) (em 2) (em 2)
+    textAlign (alignSide sideCenter)
 
-  ".header" <> ".row" ? display tableRow
-  let headerHeight = (px 70)
+  ".lines" ? do
+    display D.table
+    width (pct 100)
+    textAlign (alignSide (sideCenter))
 
-  ".header" ? do
-    fontWeight bold
-    backgroundColor Color.gothic
-    color Color.white
-    fontSize iconFontSize
-    height headerHeight
+    ".header" <> ".row" ? display tableRow
+    let headerHeight = (px 70)
 
-  ".row" ? do
-    fontSize (px 18)
-    height (px rowHeightPx)
-    ".cell:first-child::before" ? do
-      display block
-      content (stringContent "")
-      position absolute
-      top (px 0)
-      left (px 0)
-      width (px 0)
+    ".header" ? do
+      fontWeight bold
+      backgroundColor Color.gothic
+      color Color.white
+      fontSize (px 18)
+      height headerHeight
+
+    ".row" ? do
+      fontSize (px 18)
       height (px rowHeightPx)
-      backgroundColor Color.mossGreen
-      transition "width" (sec 0.3) ease (sec 0)
-      opacity (0.8)
+      ".cell:first-child::before" ? do
+        display block
+        content (stringContent "")
+        position absolute
+        top (px 0)
+        left (px 0)
+        width (px 0)
+        height (px rowHeightPx)
+        backgroundColor Color.mossGreen
+        transition "width" (sec 0.3) ease (sec 0)
+        opacity (0.8)
 
-    hover & do
-      ".cell:first-child::before" ? width (px 5)
+      hover & do
+        ".cell:first-child::before" ? width (px 5)
 
-    nthChild "odd" & do
-      backgroundColor Color.wildSand
-    ".edition" & do
-      backgroundColor Color.negroni
-      ".delete" |> button ? visibility visible
+      nthChild "odd" & do
+        backgroundColor Color.wildSand
+      ".edition" & do
+        backgroundColor Color.negroni
+        ".delete" |> button ? visibility visible
 
-  ".cell" ? do
-    display tableCell
-    position relative
-    verticalAlign middle
-    ".category" & width (pct 40)
-    ".cost" & do
-      width (pct 17)
-      ".refund" & color Color.mossGreen
-    ".user" & width (pct 20)
-    ".date" & do
-      width (pct 20)
-      Media.mobileTablet $ do
-        ".shortDate" ? display inline
-        ".longDate" ? display none
-      Media.desktop $ do
-        ".shortDate" ? display none
-        ".longDate" ? display inline
-    ".delete" & do
+    ".cell" ? do
+      display tableCell
       position relative
-      width (pct 3)
-      textAlign (alignSide sideCenter)
-      button ? do
-        defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten
-        borderRadius (px 0) (px 0) (px 0) (px 0)
-        position absolute
-        top (px 0)
-        right (px 0)
-        width (pct 100)
-        visibility hidden
+      verticalAlign middle
+      ".category" & width (pct 40)
+      ".cost" & do
+        width (pct 17)
+        ".refund" & color Color.mossGreen
+      ".user" & width (pct 20)
+      ".date" & do
+        width (pct 20)
+        Media.mobileTablet $ do
+          ".shortDate" ? display inline
+          ".longDate" ? display none
+        Media.desktop $ do
+          ".shortDate" ? display none
+          ".longDate" ? display inline
+      ".delete" & do
+        position relative
+        width (pct 3)
+        textAlign (alignSide sideCenter)
+        button ? do
+          defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten
+          borderRadius (px 0) (px 0) (px 0) (px 0)
+          position absolute
+          top (px 0)
+          right (px 0)
+          width (pct 100)
+          visibility hidden
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 9946961..d04a3ac 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -74,7 +74,7 @@ main = do
 
         post "/payment/add" $ do
           name <- param "name" :: ActionM Text
-          cost <- param "cost" :: ActionM Text
+          cost <- param "cost" :: ActionM Int
           frequency <- param "frequency" :: ActionM Frequency
           createPayment name cost frequency
 
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index c87a2c1..8b957f1 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -47,15 +47,19 @@ data Key =
   | ShortDate
   | LongDate
 
-  -- Validation
+  -- Search
 
-  | CategoryRequired
-  | CostRequired
+  | SearchName
+  | SearchPunctual
+  | SearchMonthly
 
   -- Payments
 
+  | PaymentsAreBalanced
   | Name
   | Cost
+  | Payer
+  | Date
   | Frequency
   | InvalidFrequency
   | AddPayment
@@ -63,22 +67,22 @@ data Key =
   | Punctual
   | Monthly
 
-  | SingularMonthlyCount
-  | PluralMonthlyCount
   | PaymentsTitle
   | Payment
   | Payments
-  | SearchText
   | Worth
+  | NoPayment
+
+  | PaymentName
+  | PaymentCost
+  | PaymentPunctual
+  | PaymentMonthly
 
   -- Statistics
 
   | Statistics
-  | Balance
-  | Overall
-  | ByMonths
+  | ByMonthsAndMean
   | By
-  | Mean
 
   -- Income
 
@@ -86,8 +90,8 @@ data Key =
   | Income
   | MonthlyNetIncomes
   | IncomeNotDeleted
-  | Creation
-  | Amount
+  | IncomeCreation
+  | IncomeAmount
   | ConfirmDelete
 
   -- Form
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index f4087a4..df3f402 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -186,20 +186,30 @@ m l LongDate =
     English -> "{2} {1}, {3}"
     French  -> "{1} {2} {3}"
 
--- Validation
+-- Search
 
-m l CategoryRequired =
+m l SearchName =
   case l of
-    English -> "Type a category."
-    French  -> "Entre une catégorie."
+    English -> "Search"
+    French  -> "Recherche"
+
+m l SearchPunctual =
+  case l of
+    English -> "Punctual"
+    French  -> "Ponctuel"
 
-m l CostRequired =
+m l SearchMonthly =
   case l of
-    English -> "Type a positive cost."
-    French  -> "Entre un coût positif."
+    English -> "Monthly"
+    French  -> "Mensuel"
 
 -- Payments
 
+m l PaymentsAreBalanced =
+  case l of
+    English -> "Payments are balanced."
+    French  -> "Les paiements sont équilibrés."
+
 m l Name =
   case l of
     English -> "Name"
@@ -210,6 +220,16 @@ m l Cost =
     English -> "Cost"
     French  -> "Coût"
 
+m l Payer =
+  case l of
+    English -> "Payer"
+    French  -> "Payeur"
+
+m l Date =
+  case l of
+    English -> "Date"
+    French  -> "Date"
+
 m l Frequency =
   case l of
     English -> "Frequency"
@@ -240,16 +260,6 @@ m l Monthly =
     English -> "Monthly"
     French  -> "Mensuelle"
 
-m l SingularMonthlyCount =
-  case l of
-    English -> "{1} monthly payment of {2}"
-    French  -> "{1} paiement mensuel de {2}"
-
-m l PluralMonthlyCount =
-  case l of
-    English -> "{1} monthly payments worth {2}"
-    French  -> "{1} paiements mensuels comptabilisant {2}"
-
 m l PaymentsTitle =
   case l of
     English -> "Payments"
@@ -265,16 +275,16 @@ m l Payments =
     English -> "payments"
     French  -> "paiements"
 
-m l SearchText =
-  case l of
-    English -> "Search"
-    French  -> "Recherche"
-
 m l Worth =
   case l of
     English -> "{1} worth {2}"
     French  -> "{1} comptabilisant {2}"
 
+m l NoPayment =
+  case l of
+    English -> "No payment found from your search criteria."
+    French  -> "Aucun paiement ne correspond à vos critères de recherches."
+
 -- Statistics
 
 m l Statistics =
@@ -282,30 +292,35 @@ m l Statistics =
     English -> "Statistics"
     French  -> "Statistiques"
 
-m l Balance =
+m l ByMonthsAndMean =
+  case l of
+    English -> "By months ({1} on average)"
+    French  -> "Par mois (en moyenne {1})"
+
+m l By =
   case l of
-    English -> "Balance"
-    French  -> "Équilibre"
+    English -> "{1}: {2}"
+    French  -> "{1} : {2}"
 
-m l Overall =
+m l PaymentName =
   case l of
-    English -> "Overall"
-    French  -> "Global"
+    English -> "Name"
+    French  -> "Nom"
 
-m l ByMonths =
+m l PaymentCost =
   case l of
-    English -> "By months"
-    French  -> "Par mois"
+    English -> "Cost"
+    French  -> "Coût"
 
-m l By =
+m l PaymentPunctual =
   case l of
-    English -> "by"
-    French  -> "par"
+    English -> "Punctual"
+    French  -> "Ponctuel"
 
-m l Mean =
+m l PaymentMonthly =
   case l of
-    English -> "Mean: {1}"
-    French  -> "En moyenne : {1}"
+    English -> "Monthly"
+    French  -> "Mensuel"
 
 -- Income
 
@@ -329,12 +344,12 @@ m l IncomeNotDeleted =
     English -> "The income could not have been deleted."
     French  -> "Le revenu n'a pas pu être supprimé."
 
-m l Creation =
+m l IncomeCreation =
   case l of
     English -> "Creation"
     French  -> "Création"
 
-m l Amount =
+m l IncomeAmount =
   case l of
     English -> "Amount"
     French  -> "Montant"
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 47397ff..28f1a09 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -9,18 +9,14 @@ module Model.Payment
 
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import Data.Either (lefts)
 
 import Control.Monad.IO.Class (liftIO)
 
 import Database.Persist
 
-import qualified Validation
-
 import Model.Database
 import Model.Frequency
 import qualified Model.Json.Payment as P
-import qualified Model.Message.Key as K
 
 getPayments :: Persist [P.Payment]
 getPayments =
@@ -48,26 +44,10 @@ getJsonPayment paymentEntity =
         , P.frequency = paymentFrequency payment
         }
 
-createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId)
-createPayment userId name cost frequency =
-  case validatePayment name cost of
-    Left err ->
-      return . Left $ err
-    Right (validatedName, validatedCost) -> do
-      now <- liftIO getCurrentTime
-      Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency)
-
-validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int)
-validatePayment name cost =
-  let eitherName = Validation.nonEmpty K.CategoryRequired name
-      eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0)
-  in  case (eitherName, eitherCost) of
-        (Right validatedName, Right validatedCost) ->
-          Right (validatedName, validatedCost)
-        _ ->
-          let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName]
-              costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost]
-          in  Left (nameErrors ++ costErrors)
+createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId
+createPayment userId name cost frequency = do
+  now <- liftIO getCurrentTime
+  insert (Payment userId now name cost Nothing frequency)
 
 deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
 deleteOwnPayment user paymentId = do
diff --git a/src/server/Validation.hs b/src/server/Validation.hs
index 455ae5b..1f332c9 100644
--- a/src/server/Validation.hs
+++ b/src/server/Validation.hs
@@ -6,18 +6,18 @@ module Validation
 import Data.Text (Text)
 import qualified Data.Text as T
 
-nonEmpty :: a -> Text -> Either a Text
-nonEmpty x str =
+nonEmpty :: Text -> Maybe Text
+nonEmpty str =
   if T.null str
-   then Left x
-   else Right str
+   then Nothing
+   else Just str
 
-number :: x -> (Int -> Bool) -> Text -> Either x Int
-number x numberForm str =
+number :: (Int -> Bool) -> Text -> Maybe Int
+number numberForm str =
   case reads (T.unpack str) :: [(Int, String)] of
     (num, _) : _ ->
       if numberForm num
-        then Right num
-        else Left x
+        then Just num
+        else Nothing
     _ ->
-      Left x
+      Nothing
-- 
cgit v1.2.3