aboutsummaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
Diffstat (limited to 'src/server')
-rw-r--r--src/server/Controller/Income.hs32
-rw-r--r--src/server/Design/Constants.hs2
-rw-r--r--src/server/Design/Helper.hs2
-rw-r--r--src/server/Design/LoggedIn.hs6
-rw-r--r--src/server/Design/LoggedIn/Home/Table.hs102
-rw-r--r--src/server/Design/LoggedIn/Income.hs26
-rw-r--r--src/server/Design/LoggedIn/Table.hs85
-rw-r--r--src/server/Main.hs8
-rw-r--r--src/server/Model/Database.hs1
-rw-r--r--src/server/Model/Income.hs34
-rw-r--r--src/server/Model/Json/EditIncome.hs20
-rw-r--r--src/server/Model/Message/Key.hs1
-rw-r--r--src/server/Model/Message/Translations.hs5
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."
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 15:47:27 +0000