From eb5ecba59887a5d1e74bf6287fabdf8a2979f44c Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 5 Sep 2015 19:03:12 +0200
Subject: Payment frequence choice between either punctual or monthly, UI only

---
 src/client/Model/View/Payment/Add.elm    |  5 +++
 src/client/Update/Payment/Add.elm        |  7 ++++-
 src/client/View/Payments/Add.elm         | 15 +++++++++
 src/server/Design/Global.hs              | 52 ++++++++++++++++++++++----------
 src/server/Model/Message/Key.hs          |  2 ++
 src/server/Model/Message/Translations.hs | 10 ++++++
 6 files changed, 74 insertions(+), 17 deletions(-)

diff --git a/src/client/Model/View/Payment/Add.elm b/src/client/Model/View/Payment/Add.elm
index 5ab7a40..da5d0f2 100644
--- a/src/client/Model/View/Payment/Add.elm
+++ b/src/client/Model/View/Payment/Add.elm
@@ -1,5 +1,6 @@
 module Model.View.Payment.Add
   ( AddPayment
+  , Frequency(..)
   , initAddPayment
   , validateName
   , validateCost
@@ -16,6 +17,7 @@ type alias AddPayment =
   , nameError : Maybe String
   , cost : String
   , costError : Maybe String
+  , frequency : Frequency
   }
 
 initAddPayment : AddPayment
@@ -24,6 +26,7 @@ initAddPayment =
   , nameError = Nothing
   , cost = ""
   , costError = Nothing
+  , frequency = Punctual
   }
 
 validateName : String -> Translations -> Result String String
@@ -36,3 +39,5 @@ validateCost cost translations =
   cost
     |> validateNonEmpty (getMessage "CostRequired" translations)
     |> flip Result.andThen (validateNumber (getMessage "CostMustBeNumber" translations) (\number -> number >= 0))
+
+type Frequency = Punctual | Monthly
diff --git a/src/client/Update/Payment/Add.elm b/src/client/Update/Payment/Add.elm
index 3ccce73..27f2af0 100644
--- a/src/client/Update/Payment/Add.elm
+++ b/src/client/Update/Payment/Add.elm
@@ -3,12 +3,13 @@ module Update.Payment.Add
   , updateAddPayment
   ) where
 
-import Model.View.Payment.Add exposing (AddPayment)
+import Model.View.Payment.Add exposing (..)
 
 type AddPaymentAction =
   UpdateName String
   | UpdateCost String
   | AddError (Maybe String) (Maybe String)
+  | ToggleFrequency
 
 updateAddPayment : AddPaymentAction -> AddPayment -> AddPayment
 updateAddPayment action addPayment =
@@ -22,3 +23,7 @@ updateAddPayment action addPayment =
       | nameError <- nameError
       , costError <- costError
       }
+    ToggleFrequency ->
+      { addPayment
+      | frequency <- if addPayment.frequency == Punctual then Monthly else Punctual
+      }
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index 77d40ea..085b16d 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -37,6 +37,7 @@ addPayment model loggedView =
     ]
     [ addPaymentName loggedView.add
     , addPaymentCost model loggedView.add
+    , paymentFrequency model loggedView.add
     , button
         [ type' "submit" ]
         [ text (getMessage "Add" model.translations)]
@@ -83,3 +84,17 @@ addPaymentCost model addPayment =
         Nothing ->
           text ""
     ]
+
+paymentFrequency : Model -> AddPayment -> Html
+paymentFrequency model addPayment =
+  div
+    [ class "frequency"
+    , onClick actions.address (UpdatePayment << UpdateAdd <| ToggleFrequency)
+    ]
+    [ div
+        [ class ("punctual" ++ if addPayment.frequency == Punctual then " selected" else "") ]
+        [ text (getMessage "Punctual" model.translations) ]
+    , div
+        [ class ("monthly" ++ if addPayment.frequency == Monthly then " selected" else "") ]
+        [ text (getMessage "Monthly" model.translations) ]
+    ]
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index e3dd824..79ea6ac 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -20,6 +20,9 @@ globalDesign = renderWith compact [] global
 iconFontSize :: Integer
 iconFontSize = 32
 
+radius :: Size Abs
+radius = px 3
+
 global :: Css
 global = do
 
@@ -53,7 +56,8 @@ global = do
   ".payments" ? do
 
     ".exceedingPayers" ? do
-      margin (px 0) (px 20) (px 45) (px 20)
+      width (pct 95)
+      margin (px 0) auto (px 45) auto
       padding (px 15) (px 15) (px 15) (px 15)
       backgroundColor C.green
       color C.white
@@ -65,7 +69,7 @@ global = do
 
     form # ".add" ? do
       let inputHeight = 40
-      width (pct 80)
+      width (pct 95)
       marginLeft auto
       marginRight auto
       marginBottom (px 45)
@@ -86,31 +90,44 @@ global = do
           fontSize (px 22)
           verticalAlign middle
           cursor cursorText
-          borderRadius (px 0) (px 3) (px 3) (px 0)
+          borderRadius (px 0) radius radius (px 0)
         input ? do
           defaultInput inputHeight
-          borderRadius (px 3) (px 0) (px 0) (px 3)
+          borderRadius radius (px 0) (px 0) radius
         "input:focus + label" ? backgroundColor C.grey
 
       ".name" ? do
         float floatLeft
-        width (pct 50)
+        width (pct 40)
         input ? width (pct 75)
         label ? width (pct 20)
         paddingRight (pct 5)
 
       ".cost" ? do
         float floatLeft
-        width (pct 35)
+        width (pct 25)
         input ? width (pct 65)
         label ? width (pct 30)
         paddingRight (pct 5)
 
+      ".frequency" ? do
+        float floatLeft
+        width (pct 15)
+        marginRight (pct 5)
+
+        (".punctual" <> ".monthly") ? do
+          defaultButton C.lightGrey C.darkGrey (inputHeight `Prelude.div` 2)
+          ".selected" & do
+            backgroundColor C.blue
+            color C.white
+
+        ".punctual" ? borderRadius radius radius 0 0
+        ".monthly" ? borderRadius 0 0 radius radius
+
       button ? do
-        defaultButton
+        defaultButton C.red C.white inputHeight
         float floatLeft
         width (pct 15)
-        height (px inputHeight)
 
       ".name.error" <> ".cost.error" ? do
         input ? borderColor C.redError
@@ -207,10 +224,9 @@ global = do
         marginBottom (px 10)
 
       button ? do
-        defaultButton
+        defaultButton C.red C.white inputHeight
         display block
         width (pct 100)
-        height (px inputHeight)
 
     ".result" ? do
       marginTop (px 40)
@@ -225,19 +241,23 @@ clearFix =
     display D.table
     clear both
 
-defaultButton :: Css
-defaultButton = do
-  backgroundColor C.red
-  color C.white
+defaultButton :: Color -> Color -> Integer -> Css
+defaultButton backgroundCol textCol pxHeight = do
+  backgroundColor backgroundCol
+  color textCol
   borderWidth (px 0)
-  borderRadius (px 3) (px 3) (px 3) (px 3)
+  borderRadius radius radius radius radius
   verticalAlign middle
+  cursor pointer
+  height (px pxHeight)
+  lineHeight (px pxHeight)
+  textAlign (alignSide sideCenter)
 
 defaultInput :: Integer -> Css
 defaultInput inputHeight = do
   height (px inputHeight)
   padding (px 10) (px 10) (px 10) (px 10)
-  borderRadius (px 3) (px 3) (px 3) (px 3)
+  borderRadius radius radius radius radius
   border solid (px 1) C.darkGrey
   focus & borderColor C.grey
   verticalAlign middle
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index ce03d34..8a37a2a 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -52,5 +52,7 @@ data Key =
   | Add
   | PaymentNotDeleted
   | MoneySymbol
+  | Punctual
+  | Monthly
 
   deriving (Enum, Bounded, Show)
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 6c569fd..ec8cf19 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -199,3 +199,13 @@ m l MoneySymbol =
   case l of
     English -> "$"
     French  -> "€"
+
+m l Punctual =
+  case l of
+    English -> "Punctual"
+    French  -> "Ponctuel"
+
+m l Monthly =
+  case l of
+    English -> "Monthly"
+    French  -> "Mensuel"
-- 
cgit v1.2.3