From 24633871359ec9fbd63fdfebf79a6351b2792f77 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 6 Sep 2015 00:05:50 +0200 Subject: Can add monthly payments, not visible at the moment though, just the count is printed --- src/server/Controller/Payment.hs | 17 ++++++++++++----- src/server/Design/Global.hs | 7 +++++++ src/server/Main.hs | 7 ++++++- src/server/Model/Database.hs | 3 +++ src/server/Model/Frequency.hs | 19 +++++++++++++++++++ src/server/Model/Json/TotalPayment.hs | 1 - src/server/Model/Message/Key.hs | 2 ++ src/server/Model/Message/Translations.hs | 10 ++++++++++ src/server/Model/Payment.hs | 30 +++++++++++++++++++++++------- 9 files changed, 82 insertions(+), 14 deletions(-) create mode 100644 src/server/Model/Frequency.hs (limited to 'src/server') diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 0a40771..7944ecd 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -1,5 +1,6 @@ module Controller.Payment ( getPaymentsAction + , getMonthlyPaymentsAction , createPaymentAction , deletePaymentAction , getTotalPaymentsAction @@ -20,6 +21,7 @@ import qualified Secure import Model.Database import Model.Payment +import Model.Frequency import Model.Json.Message import Model.Json.Number import Model.Message @@ -28,14 +30,19 @@ import Model.Message.Key (Key(PaymentNotDeleted)) getPaymentsAction :: Int -> Int -> ActionM () getPaymentsAction page perPage = Secure.loggedAction (\_ -> do - payments <- liftIO $ runDb (getPayments page perPage) - json payments + (liftIO $ runDb (getPunctualPayments page perPage)) >>= json ) -createPaymentAction :: Text -> Int -> ActionM () -createPaymentAction name cost = +getMonthlyPaymentsAction :: ActionM () +getMonthlyPaymentsAction = Secure.loggedAction (\user -> do - _ <- liftIO . runDb $ createPayment (entityKey user) name cost + (liftIO $ runDb (getMonthlyPayments (entityKey user))) >>= json + ) + +createPaymentAction :: Text -> Int -> Frequency -> ActionM () +createPaymentAction name cost frequency = + Secure.loggedAction (\user -> do + _ <- liftIO . runDb $ createPayment (entityKey user) name cost frequency status ok200 ) diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index e0cc244..0af071e 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -140,6 +140,13 @@ global = do top (px (inputHeight + 10)) left (px 0) + ".monthlyPayments" ? do + width (pct 95) + margin (px 0) auto (px 45) auto + padding (px 10) (px 10) (px 10) (px 10) + backgroundColor C.lightGrey + borderRadius radius radius radius radius + ".table" ? do display D.table width (pct 100) diff --git a/src/server/Main.hs b/src/server/Main.hs index 27908b4..c3d285e 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -13,6 +13,7 @@ import Controller.Payment import Controller.User import Model.Database (runMigrations) +import Model.Frequency import Config @@ -54,10 +55,14 @@ main = do perPage <- param "perPage" :: ActionM Int getPaymentsAction page perPage + get "/monthlyPayments" $ do + getMonthlyPaymentsAction + post "/payment/add" $ do name <- param "name" :: ActionM Text cost <- param "cost" :: ActionM Int - createPaymentAction name cost + frequency <- param "frequency" :: ActionM Frequency + createPaymentAction name cost frequency post "/payment/delete" $ do paymentId <- param "id" :: ActionM Text diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index a6ce4f4..d4a7d50 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -21,6 +21,8 @@ import Data.Int (Int64) import Database.Persist.Sqlite import Database.Persist.TH +import Model.Frequency + share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| User creation UTCTime @@ -35,6 +37,7 @@ Payment name Text cost Int deletedAt UTCTime Maybe + frequency Frequency deriving Show SignIn token Text diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs new file mode 100644 index 0000000..2b747b7 --- /dev/null +++ b/src/server/Model/Frequency.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Model.Frequency + ( Frequency(..) + ) where + +import Web.Scotty + +import Database.Persist.TH + +data Frequency = + Punctual + | Monthly + deriving (Eq, Show, Read) + +derivePersistField "Frequency" + +instance Parsable Frequency where parseParam = readEither diff --git a/src/server/Model/Json/TotalPayment.hs b/src/server/Model/Json/TotalPayment.hs index 5ae68c9..2b1cd06 100644 --- a/src/server/Model/Json/TotalPayment.hs +++ b/src/server/Model/Json/TotalPayment.hs @@ -6,7 +6,6 @@ module Model.Json.TotalPayment import GHC.Generics -import Data.Text (Text) import Data.Aeson import Model.Database (UserId) diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 8a37a2a..163a21f 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -54,5 +54,7 @@ data Key = | MoneySymbol | Punctual | Monthly + | SingularMonthlyCount + | PluralMonthlyCount deriving (Enum, Bounded, Show) diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index ec8cf19..501f00f 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -209,3 +209,13 @@ m l Monthly = case l of English -> "Monthly" French -> "Mensuel" + +m l SingularMonthlyCount = + case l of + English -> "You have {1} monthly payment." + French -> "Vous avez {1} paiement mensuel." + +m l PluralMonthlyCount = + case l of + English -> "You have {1} monthly payments." + French -> "Vous avez {1} paiements mensuels." diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index d7632f0..381578a 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,5 +1,6 @@ module Model.Payment - ( getPayments + ( getPunctualPayments + , getMonthlyPayments , createPayment , deleteOwnPayment , getTotalPayments @@ -18,25 +19,38 @@ import Database.Esqueleto import qualified Database.Esqueleto as E import Model.Database +import Model.Frequency import qualified Model.Json.Payment as P import qualified Model.Json.TotalPayment as TP -getPayments :: Int -> Int -> Persist [P.Payment] -getPayments page perPage = do +getPunctualPayments :: Int -> Int -> Persist [P.Payment] +getPunctualPayments page perPage = do xs <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) + where_ (payment ^. PaymentFrequency E.==. val Punctual) orderBy [desc (payment ^. PaymentCreation)] limit . fromIntegral $ perPage offset . fromIntegral $ (page - 1) * perPage return (payment, user) return (map getJsonPayment xs) +getMonthlyPayments :: UserId -> Persist [P.Payment] +getMonthlyPayments userId = do + xs <- select $ + from $ \(payment `InnerJoin` user) -> do + on (payment ^. PaymentUserId E.==. user ^. UserId) + where_ (isNothing (payment ^. PaymentDeletedAt)) + where_ (payment ^. PaymentFrequency E.==. val Monthly) + where_ (payment ^. PaymentUserId E.==. val userId) + orderBy [desc (payment ^. PaymentCreation)] + return (payment, user) + return (map getJsonPayment xs) + getJsonPayment :: (Entity Payment, Entity User) -> P.Payment getJsonPayment (paymentEntity, userEntity) = let payment = entityVal paymentEntity - user = entityVal userEntity in P.Payment { P.id = entityKey paymentEntity , P.creation = paymentCreation payment @@ -45,10 +59,10 @@ getJsonPayment (paymentEntity, userEntity) = , P.userId = entityKey userEntity } -createPayment :: UserId -> Text -> Int -> Persist PaymentId -createPayment userId name cost = do +createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId +createPayment userId name cost frequency = do now <- liftIO getCurrentTime - insert $ Payment userId now name cost Nothing + insert $ Payment userId now name cost Nothing frequency deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool deleteOwnPayment user paymentId = do @@ -71,6 +85,7 @@ getTotalPayments = do from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) + where_ (payment ^. PaymentFrequency E.==. val Punctual) groupBy (payment ^. PaymentUserId) return (user ^. UserId, sum_ (payment ^. PaymentCost)) return $ catMaybes . map (getTotalPayment . unValueTuple) $ values @@ -88,4 +103,5 @@ getPaymentsCount = (select $ from $ \payment -> do where_ (isNothing (payment ^. PaymentDeletedAt)) + where_ (payment ^. PaymentFrequency E.==. val Punctual) return countRows) :: Persist Int -- cgit v1.2.3