From 8816cf758119a6a2073e561c8df297a833630986 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 8 Aug 2016 20:58:17 +0200 Subject: Show incomes in a table and update like payments are updated --- src/server/Controller/Income.hs | 32 +++++----- src/server/Design/Constants.hs | 2 +- src/server/Design/Helper.hs | 2 +- src/server/Design/LoggedIn.hs | 6 +- src/server/Design/LoggedIn/Home/Table.hs | 102 +++++-------------------------- src/server/Design/LoggedIn/Income.hs | 26 ++++---- src/server/Design/LoggedIn/Table.hs | 85 ++++++++++++++++++++++++++ src/server/Main.hs | 8 ++- src/server/Model/Database.hs | 1 + src/server/Model/Income.hs | 34 ++++++++--- src/server/Model/Json/EditIncome.hs | 20 ++++++ src/server/Model/Message/Key.hs | 1 + src/server/Model/Message/Translations.hs | 5 ++ 13 files changed, 196 insertions(+), 128 deletions(-) create mode 100644 src/server/Design/LoggedIn/Table.hs create mode 100644 src/server/Model/Json/EditIncome.hs (limited to 'src/server') 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." -- cgit v1.2.3