Show incomes in a table and update like payments are updated

13 files changed, 196 insertions, 128 deletions

diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index fa575c5..ff3e75d 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Controller.Income
-  ( getIncomes
-  , createIncome
-  , deleteOwnIncome
+  ( create
+  , editOwn
+  , deleteOwn
   ) where
 
 import Web.Scotty
@@ -25,23 +25,27 @@ import Model.Database
 import qualified Model.Income as Income
 import qualified Model.Message.Key as Key
 import qualified Model.Json.CreateIncome as Json
+import qualified Model.Json.EditIncome as Json
 
-getIncomes :: ActionM ()
-getIncomes =
-  Secure.loggedAction (\_ ->
-    (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json
+create :: Json.CreateIncome -> ActionM ()
+create (Json.CreateIncome date amount) =
+  Secure.loggedAction (\user ->
+    (liftIO . runDb $ Income.create (entityKey user) date amount) >>= jsonId
   )
 
-createIncome :: Json.CreateIncome -> ActionM ()
-createIncome (Json.CreateIncome date amount) =
-  Secure.loggedAction (\user ->
-    (liftIO . runDb $ Income.createIncome (entityKey user) date amount) >>= jsonId
+editOwn :: Json.EditIncome -> ActionM ()
+editOwn (Json.EditIncome incomeId date amount) =
+  Secure.loggedAction (\user -> do
+    updated <- liftIO . runDb $ Income.editOwn (entityKey user) incomeId date amount
+    if updated
+      then status ok200
+      else status badRequest400
   )
 
-deleteOwnIncome :: Text -> ActionM ()
-deleteOwnIncome incomeId =
+deleteOwn :: Text -> ActionM ()
+deleteOwn incomeId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . runDb $ Income.deleteOwnIncome user (textToKey incomeId)
+    deleted <- liftIO . runDb $ Income.deleteOwn user (textToKey incomeId)
     if deleted
       then
         status ok200
diff --git a/src/server/Design/Constants.hs b/src/server/Design/Constants.hs
index 7d196cb..a532ac8 100644
--- a/src/server/Design/Constants.hs
+++ b/src/server/Design/Constants.hs
@@ -17,7 +17,7 @@ blockPercentWidth = 90
 blockPercentMargin :: Double
 blockPercentMargin = (100 - blockPercentWidth) / 2
 
-inputHeight :: Integer
+inputHeight :: Double
 inputHeight = 40
 
 focusLighten :: Color -> Color
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 36cedb0..f25cf05 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -53,7 +53,7 @@ iconButton backgroundCol textCol h focusOp = do
     marginLeft (px 15)
     marginRight (px 20)
 
-input :: Integer -> Css
+input :: Double -> Css
 input h = do
   height (px h)
   padding (px 10) (px 10) (px 10) (px 10)
diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs
index 5a3297a..2899fa4 100644
--- a/src/server/Design/LoggedIn.hs
+++ b/src/server/Design/LoggedIn.hs
@@ -4,19 +4,19 @@ module Design.LoggedIn
   ( design
   ) where
 
-import Data.Monoid ((<>))
-
 import Clay
 
 import qualified Design.LoggedIn.Home as Home
 import qualified Design.LoggedIn.Income as Income
 import qualified Design.LoggedIn.Stat as Stat
+import qualified Design.LoggedIn.Table as Table
 
 design :: Css
 design = do
   ".home" ? Home.design
   ".income" ? Income.design
   ".stat" ? Stat.design
+  Table.design
 
-  (".income" <> ".stat") ? do
+  ".textual" ? do
     "margin" -: "0 2vw"
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index 3358f5d..73ced3a 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -4,101 +4,31 @@ module Design.LoggedIn.Home.Table
   ( design
   ) where
 
-import Data.Monoid ((<>))
-
 import Clay
-import qualified Clay.Display as D
 
-import Design.Color as Color
 import qualified Design.Media as Media
 
 design :: Css
 design = do
-  ".noPayment" ? do
-    margin (em 2) (em 2) (em 2) (em 2)
-    textAlign (alignSide sideCenter)
+  ".cell" ? do
+    ".category" & do
+      Media.tabletDesktop $ width (pct 36)
 
-  ".lines" ? do
-    Media.tabletDesktop $ display D.table
-    width (pct 100)
-    textAlign (alignSide (sideCenter))
+    ".cost" & do
+      Media.tabletDesktop $ width (pct 15)
 
-    ".header" <> ".row" ? do
-      Media.tabletDesktop $ display tableRow
+    ".user" & do
+      Media.tabletDesktop $ width (pct 20)
 
-    ".header" ? do
+    ".date" & do
+      Media.tabletDesktop $ width (pct 20)
       Media.desktop $ do
-        fontSize (px 18)
-        height (px 70)
-
-      Media.tabletDesktop $ do
-        backgroundColor Color.gothic
-        color Color.white
-
+        ".shortDate" ? display none
+        ".longDate" ? display inline
       Media.tablet $ do
-        fontSize (px 16)
-        height (px 60)
-
+        ".shortDate" ? display inline
+        ".longDate" ? display none
       Media.mobile $ do
-        display none
-
-    ".row" ? do
-      nthChild "even" & backgroundColor Color.wildSand
-
-      Media.desktop $ do
-        fontSize (px 18)
-        height (px 60)
-
-      Media.tablet $ do
-        height (px 50)
-
-      Media.mobile $ do
-        lineHeight (px 25)
-        paddingTop (px 10)
-        paddingBottom (px 10)
-
-    ".cell" ? do
-      Media.tabletDesktop $ display tableCell
-      position relative
-      verticalAlign middle
-
-      ".category" & do
-        Media.tabletDesktop $ width (pct 36)
-        Media.mobile $ do
-          fontSize (px 20)
-          lineHeight (px 30)
-          color Color.gothic
-
-      ".cost" & do
-        Media.tabletDesktop $ width (pct 15)
-        ".refund" & color Color.mossGreen
-
-      ".user" & do
-        Media.tabletDesktop $ width (pct 20)
-
-      ".date" & do
-        Media.tabletDesktop $ width (pct 20)
-        Media.desktop $ do
-          ".shortDate" ? display none
-          ".longDate" ? display inline
-        Media.tablet $ do
-          ".shortDate" ? display inline
-          ".longDate" ? display none
-        Media.mobile $ do
-          ".shortDate" ? display none
-          ".longDate" ? display inline
-          marginBottom (em 0.5)
-
-      ".cell.button" & do
-        position relative
-        textAlign (alignSide sideCenter)
-        button ? do
-          padding (px 10) (px 10) (px 10) (px 10)
-          hover & "svg path" ? do
-            "fill" -: "rgb(237, 122, 116)"
-
-        Media.tabletDesktop $ width (pct 3)
-
-        Media.mobile $ do
-          display inlineBlock
-          button ? display flex
+        ".shortDate" ? display none
+        ".longDate" ? display inline
+        marginBottom (em 0.5)
diff --git a/src/server/Design/LoggedIn/Income.hs b/src/server/Design/LoggedIn/Income.hs
index 5773e04..c44c67b 100644
--- a/src/server/Design/LoggedIn/Income.hs
+++ b/src/server/Design/LoggedIn/Income.hs
@@ -9,21 +9,21 @@ import Clay
 import qualified Design.Helper as Helper
 import qualified Design.Constants as Constants
 import qualified Design.Color as Color
+import qualified Design.Media as Media
 
 design :: Css
-design = do
+design =
+  ".monthlyNetIncomes" ? do
 
-  h1 ? paddingBottom (px 0)
+    h1 ? do
+      Media.tabletDesktop $ float floatLeft
 
-  form ? do
-    display flex
-    "alignItems" -: "center"
-    "margin-bottom" -: "4vh"
-    ".textInput" ? marginRight (px 30)
-
-    button # ".add" ? do
+    ".addIncome" ? do
       Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
-      marginTop (px 3)
-
-  ul # ".incomes" ? button ?
-    marginLeft (px 12)
+      Media.tabletDesktop $ do
+        float floatRight
+        position relative
+        top (px (-8))
+      Media.mobile $ do
+        width (pct 100)
+        marginBottom (px 20)
diff --git a/src/server/Design/LoggedIn/Table.hs b/src/server/Design/LoggedIn/Table.hs
new file mode 100644
index 0000000..1af5e2b
--- /dev/null
+++ b/src/server/Design/LoggedIn/Table.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.LoggedIn.Table
+  ( design
+  ) where
+
+import Data.Monoid ((<>))
+
+import Clay
+import qualified Clay.Display as D
+
+import Design.Color as Color
+import qualified Design.Media as Media
+
+design :: Css
+design = do
+  ".emptyTableMsg" ? do
+    margin (em 2) (em 2) (em 2) (em 2)
+    textAlign (alignSide sideCenter)
+
+  ".lines" ? do
+    Media.tabletDesktop $ display D.table
+    width (pct 100)
+    textAlign (alignSide (sideCenter))
+
+    ".header" <> ".row" ? do
+      Media.tabletDesktop $ display tableRow
+
+    ".header" ? do
+      Media.desktop $ do
+        fontSize (px 18)
+        height (px 70)
+
+      Media.tabletDesktop $ do
+        backgroundColor Color.gothic
+        color Color.white
+
+      Media.tablet $ do
+        fontSize (px 16)
+        height (px 60)
+
+      Media.mobile $ do
+        display none
+
+    ".row" ? do
+      nthChild "even" & backgroundColor Color.wildSand
+
+      Media.desktop $ do
+        fontSize (px 18)
+        height (px 60)
+
+      Media.tablet $ do
+        height (px 50)
+
+      Media.mobile $ do
+        lineHeight (px 25)
+        paddingTop (px 10)
+        paddingBottom (px 10)
+
+    ".cell" ? do
+      Media.tabletDesktop $ display tableCell
+      position relative
+      verticalAlign middle
+
+      firstChild & do
+        Media.mobile $ do
+          fontSize (px 20)
+          lineHeight (px 30)
+          color Color.gothic
+
+      ".refund" & color Color.mossGreen
+
+      ".cell.button" & do
+        position relative
+        textAlign (alignSide sideCenter)
+        button ? do
+          padding (px 10) (px 10) (px 10) (px 10)
+          hover & "svg path" ? do
+            "fill" -: "rgb(237, 122, 116)"
+
+        Media.tabletDesktop $ width (pct 3)
+
+        Media.mobile $ do
+          display inlineBlock
+          button ? display flex
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 19d78b3..4636674 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -15,7 +15,7 @@ import qualified Data.Text.IO as T
 import Controller.Index
 import Controller.SignIn
 import Controller.Payment as Payment
-import Controller.Income
+import Controller.Income as Income
 
 import Model.Database (runMigrations)
 
@@ -62,8 +62,10 @@ main = do
 
         -- Incomes
 
-        post "/income" $ jsonData >>= createIncome
+        post "/income" $ jsonData >>= Income.create
+
+        put "/income" $ jsonData >>= Income.editOwn
 
         delete "/income" $ do
           incomeId <- param "id" :: ActionM Text
-          deleteOwnIncome incomeId
+          Income.deleteOwn incomeId
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 4526fc5..6a2fefe 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -61,6 +61,7 @@ Income
   date Day
   amount Int
   createdAt UTCTime
+  editedAt UTCTime Maybe
   deletedAt UTCTime Maybe
   deriving Show
 |]
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 62ab0ed..f389661 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,8 +1,9 @@
 module Model.Income
   ( getJsonIncome
   , getIncomes
-  , createIncome
-  , deleteOwnIncome
+  , create
+  , editOwn
+  , deleteOwn
   ) where
 
 import Data.Time.Clock (getCurrentTime)
@@ -23,13 +24,32 @@ getJsonIncome incomeEntity =
 getIncomes :: Persist [Entity Income]
 getIncomes = selectList [IncomeDeletedAt ==. Nothing] []
 
-createIncome :: UserId -> Day -> Int -> Persist IncomeId
-createIncome userId date amount = do
+create :: UserId -> Day -> Int -> Persist IncomeId
+create userId date amount = do
   now <- liftIO getCurrentTime
-  insert (Income userId date amount now Nothing)
+  insert (Income userId date amount now Nothing Nothing)
 
-deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool
-deleteOwnIncome user incomeId = do
+editOwn :: UserId -> IncomeId -> Day -> Int -> Persist Bool
+editOwn userId incomeId date amount = do
+  mbIncome <- get incomeId
+  case mbIncome of
+    Just income ->
+      if incomeUserId income == userId
+        then do
+          now <- liftIO getCurrentTime
+          update incomeId
+            [ IncomeEditedAt =. Just now
+            , IncomeDate =. date
+            , IncomeAmount =. amount
+            ]
+          return True
+        else
+          return False
+    Nothing ->
+      return False
+
+deleteOwn :: Entity User -> IncomeId -> Persist Bool
+deleteOwn user incomeId = do
   mbIncome <- get incomeId
   case mbIncome of
     Just income ->
diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs
new file mode 100644
index 0000000..be3c7dc
--- /dev/null
+++ b/src/server/Model/Json/EditIncome.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.EditIncome
+  ( EditIncome(..)
+  ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+
+import Model.Database (IncomeId)
+
+data EditIncome = EditIncome
+  { id :: IncomeId
+  , date :: Day
+  , amount :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON EditIncome
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 2723dd5..4ffc890 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -97,6 +97,7 @@ data Key =
   | CumulativeIncomesSince
   | Income
   | MonthlyNetIncomes
+  | AddIncome
   | IncomeNotDeleted
   | IncomeDate
   | IncomeAmount
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 5dcf428..32b58fc 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -374,6 +374,11 @@ m l MonthlyNetIncomes =
     English -> "Monthly incomes"
     French  -> "Revenus mensuels nets"
 
+m l AddIncome =
+  case l of
+    English -> "Add an income"
+    French  -> "Ajouter un revenu"
+
 m l IncomeNotDeleted =
   case l of
     English -> "The income could not have been deleted."