From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- common/src/Common/Message.hs | 12 + common/src/Common/Message/Key.hs | 152 +++++++ common/src/Common/Message/Lang.hs | 7 + common/src/Common/Message/Translation.hs | 697 +++++++++++++++++++++++++++++ common/src/Common/Model.hs | 18 + common/src/Common/Model/Category.hs | 26 ++ common/src/Common/Model/CreateCategory.hs | 16 + common/src/Common/Model/CreateIncome.hs | 16 + common/src/Common/Model/CreatePayment.hs | 23 + common/src/Common/Model/Currency.hs | 14 + common/src/Common/Model/EditCategory.hs | 19 + common/src/Common/Model/EditIncome.hs | 19 + common/src/Common/Model/EditPayment.hs | 25 ++ common/src/Common/Model/Frequency.hs | 16 + common/src/Common/Model/Income.hs | 29 ++ common/src/Common/Model/Init.hs | 28 ++ common/src/Common/Model/InitResult.hs | 19 + common/src/Common/Model/Payment.hs | 33 ++ common/src/Common/Model/PaymentCategory.hs | 27 ++ common/src/Common/Model/SignIn.hs | 16 + common/src/Common/Model/User.hs | 29 ++ common/src/Common/Util/Text.hs | 41 ++ common/src/Common/View/Format.hs | 69 +++ 23 files changed, 1351 insertions(+) create mode 100644 common/src/Common/Message.hs create mode 100644 common/src/Common/Message/Key.hs create mode 100644 common/src/Common/Message/Lang.hs create mode 100644 common/src/Common/Message/Translation.hs create mode 100644 common/src/Common/Model.hs create mode 100644 common/src/Common/Model/Category.hs create mode 100644 common/src/Common/Model/CreateCategory.hs create mode 100644 common/src/Common/Model/CreateIncome.hs create mode 100644 common/src/Common/Model/CreatePayment.hs create mode 100644 common/src/Common/Model/Currency.hs create mode 100644 common/src/Common/Model/EditCategory.hs create mode 100644 common/src/Common/Model/EditIncome.hs create mode 100644 common/src/Common/Model/EditPayment.hs create mode 100644 common/src/Common/Model/Frequency.hs create mode 100644 common/src/Common/Model/Income.hs create mode 100644 common/src/Common/Model/Init.hs create mode 100644 common/src/Common/Model/InitResult.hs create mode 100644 common/src/Common/Model/Payment.hs create mode 100644 common/src/Common/Model/PaymentCategory.hs create mode 100644 common/src/Common/Model/SignIn.hs create mode 100644 common/src/Common/Model/User.hs create mode 100644 common/src/Common/Util/Text.hs create mode 100644 common/src/Common/View/Format.hs (limited to 'common/src') diff --git a/common/src/Common/Message.hs b/common/src/Common/Message.hs new file mode 100644 index 0000000..9ae735d --- /dev/null +++ b/common/src/Common/Message.hs @@ -0,0 +1,12 @@ +module Common.Message + ( get + ) where + +import Data.Text (Text) + +import Common.Message.Key (Key) +import Common.Message.Lang (Lang(..)) +import qualified Common.Message.Translation as Translation + +get :: Key -> Text +get = Translation.get French diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs new file mode 100644 index 0000000..4127808 --- /dev/null +++ b/common/src/Common/Message/Key.hs @@ -0,0 +1,152 @@ +module Common.Message.Key + ( Key(..) + ) where + +import Data.Text + +data Key = + + App_Title + + | Category_Add + | Category_Clone + | Category_Color + | Category_DeleteConfirm + | Category_Edit + | Category_Empty + | Category_Name + | Category_NotDeleted + | Category_Title + | Category_Used + + | Date_Long Int Text Int + | Date_Short Int Int Int + | Date_ShortMonthAndYear Int Int + + | Dialog_Confirm + | Dialog_Undo + + | Error_CategoryCreate + | Error_CategoryDelete + | Error_CategoryEdit + | Error_IncomeCreate + | Error_IncomeDelete + | Error_IncomeEdit + | Error_PaymentCreate + | Error_PaymentDelete + | Error_PaymentEdit + | Error_SignOut + + | Form_AlreadyExists + | Form_CostMustNotBeNull + | Form_Empty + | Form_GreaterIntThan Int + | Form_InvalidCategory + | Form_InvalidColor + | Form_InvalidDate + | Form_InvalidInt + | Form_InvalidString + | Form_SmallerIntThan Int + + | HttpError_BadPayload + | HttpError_BadUrl + | HttpError_NetworkError + | HttpError_Timeout + + | Income_AddLong + | Income_AddShort + | Income_Amount + | Income_Clone + | Income_CumulativeSince Text + | Income_Date + | Income_DeleteConfirm + | Income_Edit + | Income_Empty + | Income_MonthlyNet + | Income_NotDeleted + | Income_Title + + | Month_January + | Month_February + | Month_March + | Month_April + | Month_May + | Month_June + | Month_July + | Month_August + | Month_September + | Month_October + | Month_November + | Month_December + + | PageNotFound_Title + + | Payment_Add + | Payment_Balanced + | Payment_Category + | Payment_CloneLong + | Payment_CloneShort + | Payment_Cost + | Payment_Date + | Payment_Delete + | Payment_DeleteConfirm + | Payment_EditLong + | Payment_EditShort + | Payment_Empty + | Payment_Frequency + | Payment_InvalidFrequency + | Payment_Many + | Payment_MonthlyFemale + | Payment_MonthlyMale + | Payment_Name + | Payment_NotDeleted + | Payment_One + | Payment_PunctualFemale + | Payment_PunctualMale + | Payment_Title + | Payment_User + | Payment_Worth Text Text + + | Search_Monthly + | Search_Name + | Search_Punctual + + | Secure_Forbidden + | Secure_Unauthorized + + | SignIn_Button + | SignIn_DisconnectSuccess + | SignIn_EmailInvalid + | SignIn_EmailPlaceholder + | SignIn_EmailSendFail + | SignIn_EmailSent + | SignIn_LinkExpired + | SignIn_LinkInvalid + | SignIn_LinkUsed + | SignIn_MailTitle + | SignIn_MailBody Text Text + | SignIn_ParseError + + | Statistic_Title + | Statistic_ByMonthsAndMean Text + | Statistic_By Text Text + | Statistic_Total + + | WeeklyReport_Empty + | WeeklyReport_IncomesCreated Int + | WeeklyReport_IncomesDeleted Int + | WeeklyReport_IncomesEdited Int + | WeeklyReport_IncomeCreated Int + | WeeklyReport_IncomeDeleted Int + | WeeklyReport_IncomeEdited Int + | WeeklyReport_PayedFor Text Text Text Text + | WeeklyReport_PayedForNot Text Text Text Text + | WeeklyReport_PayedFrom Text Text Text + | WeeklyReport_PayedFromNot Text Text Text + | WeeklyReport_PaymentsCreated Int + | WeeklyReport_PaymentsDeleted Int + | WeeklyReport_PaymentsEdited Int + | WeeklyReport_PaymentCreated Int + | WeeklyReport_PaymentDeleted Int + | WeeklyReport_PaymentEdited Int + | WeeklyReport_Title diff --git a/common/src/Common/Message/Lang.hs b/common/src/Common/Message/Lang.hs new file mode 100644 index 0000000..0a32ede --- /dev/null +++ b/common/src/Common/Message/Lang.hs @@ -0,0 +1,7 @@ +module Common.Message.Lang + ( Lang(..) + ) where + +data Lang = + English + | French diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs new file mode 100644 index 0000000..900a9e9 --- /dev/null +++ b/common/src/Common/Message/Translation.hs @@ -0,0 +1,697 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Common.Message.Translation + ( get + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Common.Message.Key +import Common.Message.Lang (Lang(..)) + +get :: Lang -> Key -> Text +get = m + +m :: Lang -> Key -> Text + +m l App_Title = + case l of + English -> "Shared Cost" + French -> "Partage des frais" + +m l Category_Add = + case l of + English -> "Add an category" + French -> "Ajouter une catégorie" + +m l Category_Clone = + case l of + English -> "Clone an category" + French -> "Cloner une catégorie" + +m l Category_Color = + case l of + English -> "Color" + French -> "Couleur" + +m l Category_DeleteConfirm = + case l of + English -> "Are you sure to delete this category ?" + French -> "Voulez-vous vraiment supprimer cette catégorie ?" + +m l Category_Edit = + case l of + English -> "Edit an category" + French -> "Modifier une catégorie" + +m l Category_Empty = + case l of + English -> "No category." + French -> "Aucune catégorie." + +m l Category_Name = + case l of + English -> "Name" + French -> "Nom" + +m l Category_NotDeleted = + case l of + English -> "The category could not have been deleted." + French -> "La catégorie n’a pas pu être supprimé." + +m l Category_Title = + case l of + English -> "Categories" + French -> "Catégories" + +m l Category_Used = + case l of + English -> "This category is currently being used" + French -> "Cette catégorie est actuellement utilisée" + +m l (Date_Short day month year) = + case l of + English -> + T.intercalate "-" [ padded year 4, padded month 2, padded day 2 ] + French -> + T.intercalate "/" [ padded day 2, padded month 2, padded year 4 ] + where padded num pad = + let str = show num + in T.pack $ replicate (pad - length str) '0' ++ str + +m l (Date_ShortMonthAndYear month year) = + case l of + English -> + T.intercalate "-" . map (T.pack . show) $ [ year, month ] + French -> + T.intercalate "/" . map (T.pack . show) $ [ month, year ] + +m l (Date_Long day month year) = + case l of + English -> + T.concat [ month, " " , T.pack . show $ day, ", ", T.pack . show $ year ] + French -> + T.intercalate " " [ T.pack . show $ day, month, T.pack . show $ year ] + +m l Dialog_Confirm = + case l of + English -> "Confirm" + French -> "Confirmer" + +m l Dialog_Undo = + case l of + English -> "Undo" + French -> "Annuler" + +m l Error_CategoryCreate = + case l of + English -> "Error at category creation" + French -> "Erreur lors de la création de la catégorie" + +m l Error_CategoryDelete = + case l of + English -> "Error at category deletion" + French -> "Erreur lors de la suppression de la catégorie" + +m l Error_CategoryEdit = + case l of + English -> "Error at category edition" + French -> "Erreur lors de la modification de la catégorie" + +m l Error_IncomeCreate = + case l of + English -> "Error at income creation" + French -> "Erreur lors de la création du revenu" + +m l Error_IncomeDelete = + case l of + English -> "Error at income deletion" + French -> "Erreur lors de la suppression du revenu" + +m l Error_IncomeEdit = + case l of + English -> "Error at income edition" + French -> "Erreur lors de la modification du revenu" + +m l Error_PaymentCreate = + case l of + English -> "Error at payment creation" + French -> "Erreur lors de la création du paiement" + +m l Error_PaymentDelete = + case l of + English -> "Error at payment deletion" + French -> "Erreur lors de la suppression du paiement" + +m l Error_PaymentEdit = + case l of + English -> "Error at payment edition" + French -> "Erreur lors de la modification du paiement" + +m l Error_SignOut = + case l of + English -> "Error at sign out" + French -> "Erreur lors de la déconnexion" + +m l Form_AlreadyExists = + case l of + English -> "Dupplicate field" + French -> "Doublon" + +m l Form_CostMustNotBeNull = + case l of + English -> "Cost must not be zero" + French -> "Le coût ne doît pas être nul" + +m l Form_Empty = + case l of + English -> "Required field" + French -> "Champ requis" + +m l (Form_GreaterIntThan number) = + case l of + English -> T.concat [ "Integer smaller than ", T.pack . show $ number, " or equal required" ] + French -> T.concat [ "Entier inférieur ou égal à ", T.pack . show $ number, " requis" ] + +m l Form_InvalidCategory = + case l of + English -> "Invalid category" + French -> "Catégorie invalide" + +m l Form_InvalidColor = + case l of + English -> "Invalid color" + French -> "Couleur invalide" + +m l Form_InvalidDate = + case l of + English -> "day/month/year required" + French -> "jour/mois/année requis" + +m l Form_InvalidInt = + case l of + English -> "Integer required" + French -> "Entier requis" + +m l Form_InvalidString = + case l of + English -> "String required" + French -> "Chaîne de caractères requise" + +m l (Form_SmallerIntThan number) = + case l of + English -> T.concat [ "Integer bigger than ", T.pack . show $ number, " or equal required" ] + French -> T.concat [ "Entier supérieur ou égal à ", T.pack . show $ number, " requis" ] + +m l HttpError_BadPayload = + case l of + English -> "Bad payload server error" + French -> "Contenu inattendu en provenance du serveur" + +m l HttpError_BadUrl = + case l of + English -> "URL not valid" + French -> "l’URL n’est pas valide" + +m l HttpError_NetworkError = + case l of + English -> "Network can not be reached" + French -> "Le serveur n’est pas accessible" + +m l HttpError_Timeout = + case l of + English -> "Timeout server error" + French -> "Le serveur met trop de temps à répondre" + +m l Income_AddLong = + case l of + English -> "Add an income" + French -> "Ajouter un revenu" + +m l Income_AddShort = + case l of + English -> "Add" + French -> "Ajouter" + +m l Income_Amount = + case l of + English -> "Amount" + French -> "Montant" + +m l Income_Clone = + case l of + English -> "Clone an income" + French -> "Cloner un revenu" + +m l (Income_CumulativeSince since) = + case l of + English -> T.concat [ "Cumulative incomes since ", since ] + French -> T.concat [ "Revenus nets cumulés depuis le ", since ] + +m l Income_Date = + case l of + English -> "Date" + French -> "Date" + +m l Income_DeleteConfirm = + case l of + English -> "Are you sure to delete this income ?" + French -> "Voulez-vous vraiment supprimer ce revenu ?" + +m l Income_Edit = + case l of + English -> "Edit an income" + French -> "Modifier un revenu" + +m l Income_Empty = + case l of + English -> "No income." + French -> "Aucun revenu." + +m l Income_MonthlyNet = + case l of + English -> "Net monthly incomes" + French -> "Revenus mensuels nets" + +m l Income_NotDeleted = + case l of + English -> "The income could not have been deleted." + French -> "Le revenu n’a pas pu être supprimé." + +m l Income_Title = + case l of + English -> "Income" + French -> "Revenu" + +m l Month_January = + case l of + English -> "january" + French -> "janvier" + +m l Month_February = + case l of + English -> "february" + French -> "février" + +m l Month_March = + case l of + English -> "march" + French -> "mars" + +m l Month_April = + case l of + English -> "april" + French -> "avril" + +m l Month_May = + case l of + English -> "may" + French -> "mai" + +m l Month_June = + case l of + English -> "june" + French -> "juin" + +m l Month_July = + case l of + English -> "july" + French -> "juillet" + +m l Month_August = + case l of + English -> "august" + French -> "août" + +m l Month_September = + case l of + English -> "september" + French -> "septembre" + +m l Month_October = + case l of + English -> "october" + French -> "octobre" + +m l Month_November = + case l of + English -> "november" + French -> "novembre" + +m l Month_December = + case l of + English -> "december" + French -> "décembre" + +m l PageNotFound_Title = + case l of + English -> "Page not found" + French -> "Page introuvable" + +m l Payment_Add = + case l of + English -> "Add a payment" + French -> "Ajouter un paiement" + +m l Payment_Balanced = + case l of + English -> "Payments are balanced." + French -> "Les paiements sont équilibrés." + +m l Payment_Category = + case l of + English -> "Category" + French -> "Catégorie" + +m l Payment_CloneLong = + case l of + English -> "Clone a payment" + French -> "Cloner un paiement" + +m l Payment_CloneShort = + case l of + English -> "Clone" + French -> "Cloner" + +m l Payment_Cost = + case l of + English -> "Cost" + French -> "Coût" + +m l Payment_Date = + case l of + English -> "Date" + French -> "Date" + +m l Payment_Delete = + case l of + English -> "Delete" + French -> "Supprimer" + +m l Payment_DeleteConfirm = + case l of + English -> "Are you sure to delete this payment ?" + French -> "Voulez-vous vraiment supprimer ce paiement ?" + +m l Payment_EditLong = + case l of + English -> "Edit a payment" + French -> "Modifier un paiement" + +m l Payment_EditShort = + case l of + English -> "Edit" + French -> "Modifier" + +m l Payment_Empty = + case l of + English -> "No payment found from your search criteria." + French -> "Aucun paiement ne correspond à vos critères de recherches." + +m l Payment_Frequency = + case l of + English -> "Frequency" + French -> "Fréquence" + +m l Payment_InvalidFrequency = + case l of + English -> "Invalid frequency" + French -> "Fréquence invalide" + +m l Payment_Many = + case l of + English -> "payments" + French -> "paiements" + +m l Payment_MonthlyFemale = + case l of + English -> "Monthly" + French -> "Mensuelle" + +m l Payment_MonthlyMale = + case l of + English -> "Monthly" + French -> "Mensuel" + +m l Payment_Name = + case l of + English -> "Name" + French -> "Nom" + +m l Payment_NotDeleted = + case l of + English -> "The payment could not have been deleted." + French -> "Le paiement n’a pas pu être supprimé." + +m l Payment_One = + case l of + English -> "payment" + French -> "paiement" + +m l Payment_PunctualFemale = + case l of + English -> "Punctual" + French -> "Ponctuelle" + +m l Payment_PunctualMale = + case l of + English -> "Punctual" + French -> "Ponctuel" + +m l Payment_Title = + case l of + English -> "Payments" + French -> "Paiements" + +m l Payment_User = + case l of + English -> "Payer" + French -> "Payeur" + +m l (Payment_Worth subject amount) = + case l of + English -> T.concat [ subject, " worth ", amount ] + French -> T.concat [ subject, " comptabilisant ", amount ] + +m l Search_Monthly = + case l of + English -> "Monthly" + French -> "Mensuel" + +m l Search_Name = + case l of + English -> "Search" + French -> "Recherche" + +m l Search_Punctual = + case l of + English -> "Punctual" + French -> "Ponctuel" + +m l Secure_Unauthorized = + case l of + English -> "You are not authorized to sign in." + French -> "Tu n’es pas autorisé à te connecter." + +m l Secure_Forbidden = + case l of + English -> "You need to be logged in to perform this action" + French -> "Tu dois te connecter pour effectuer cette action" + +m l SignIn_Button = + case l of + English -> "Sign in" + French -> "Connexion" + +m l SignIn_DisconnectSuccess = + case l of + English -> "You have successfully disconnected" + French -> "Vous êtes à présent déconnecté." + +m l SignIn_EmailInvalid = + case l of + English -> "Your email is not valid." + French -> "Votre courriel n’est pas valide." + +m l SignIn_EmailPlaceholder = + case l of + English -> "Email" + French -> "Courriel" + +m l SignIn_EmailSendFail = + case l of + English -> "You are authorized to sign in, but we failed to send you the sign up email." + French -> "Tu es autorisé à te connecter, mais nous n’avons pas pu t’envoyer le courriel de connexion." + +m l SignIn_EmailSent = + case l of + English -> "We sent you an email with a connexion link." + French -> "Nous t’avons envoyé un courriel avec un lien pour te connecter." + +m l SignIn_LinkExpired = + case l of + English -> "The link expired, please sign in again." + French -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau." + +m l SignIn_LinkInvalid = + case l of + English -> "The link is invalid, please sign in again." + French -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau." + +m l SignIn_LinkUsed = + case l of + English -> "You already used this link, please sign in again." + French -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau." + +m l SignIn_MailTitle = + case l of + English -> T.concat [ "Sign in to ", m l App_Title ] + French -> T.concat [ "Connexion à ", m l App_Title ] + +m l (SignIn_MailBody name url) = + T.intercalate + "\n" + ( case l of + English -> + [ T.concat [ "Hi ", name, "," ] + , "" + , T.concat + [ "Click to the following link in order to sign in to Shared Cost:" + , m l App_Title + , ":" + ] + , url + , "" + , "See you soon!" + ] + French -> + [ T.concat [ "Salut ", name, "," ] + , "" + , T.concat + [ "Clique sur le lien suivant pour te connecter à " + , m l App_Title + , ":" + ] + , url + , "" + , "À très vite !" + ] + ) + +m l SignIn_ParseError = + case l of + English -> "Error while reading initial data." + French -> "Erreur lors de la lecture des données initiales." + +m l (Statistic_By key value) = + case l of + English -> T.concat [ key, ": ", value ] + French -> T.concat [ key, " : ", value ] + +m l (Statistic_ByMonthsAndMean amount) = + case l of + English -> + T.concat [ "Payments by category by month months (", amount, "on average)" ] + French -> + T.concat [ "Paiements par catégorie par mois (en moyenne ", amount, ")" ] + +m l Statistic_Title = + case l of + English -> "Statistics" + French -> "Statistiques" + +m l Statistic_Total = + case l of + English -> "Total" + French -> "Total" + +m l WeeklyReport_Empty = + case l of + English -> "No activity the previous week." + French -> "Pas d’activité la semaine passée." + +m l (WeeklyReport_IncomesCreated count) = + case l of + English -> T.concat [ T.pack . show $ count, " incomes created:" ] + French -> T.concat [ T.pack . show $ count, " revenus créés :" ] + +m l (WeeklyReport_IncomesDeleted count) = + case l of + English -> T.concat [ T.pack . show $ count, " incomes deleted:" ] + French -> T.concat [ T.pack . show $ count, " revenus supprimés :" ] + +m l (WeeklyReport_IncomesEdited count) = + case l of + English -> T.concat [ T.pack . show $ count, " incomes edited:" ] + French -> T.concat [ T.pack . show $ count, " revenus modifiés :" ] + +m l (WeeklyReport_IncomeCreated count) = + case l of + English -> T.concat [ T.pack . show $ count, " income created:" ] + French -> T.concat [ T.pack . show $ count, " revenu créé :" ] + +m l (WeeklyReport_IncomeDeleted count) = + case l of + English -> T.concat [ T.pack . show $ count, " income deleted:" ] + French -> T.concat [ T.pack . show $ count, " revenu supprimé :" ] + +m l (WeeklyReport_IncomeEdited count) = + case l of + English -> T.concat [ T.pack . show $ count, " income edited:" ] + French -> T.concat [ T.pack . show $ count, " revenu modifié :" ] + +m l (WeeklyReport_PayedFor name amount for at) = + case l of + English -> T.concat [ T.pack . show $ name, " payed ", amount, " for “", for, "” at ", at ] + French -> T.concat [ T.pack . show $ name, " a payé ", amount, " concernant « ", for, " » le ", at ] + +m l (WeeklyReport_PayedForNot name amount for at) = + case l of + English -> T.concat [ T.pack . show $ name, " didn’t pay ", amount, " for “", for, "” at ", at ] + French -> T.concat [ T.pack . show $ name, " n’a pas payé ", amount, " concernant « ", for, " » le ", at ] + +m l (WeeklyReport_PayedFrom name amount for) = + case l of + English -> T.concat [ T.pack . show $ name, " is payed ", amount, " of net monthly income from ", for ] + French -> T.concat [ T.pack . show $ name, " est payé ", amount, " net par mois à partir du ", for ] + +m l (WeeklyReport_PayedFromNot name amount for) = + case l of + English -> T.concat [ T.pack . show $ name, " isn’t payed ", amount, " of net monthly income from ", for ] + French -> T.concat [ T.pack . show $ name, " n’est pas payé ", amount, " net par mois à partir du ", for ] + +m l (WeeklyReport_PaymentsCreated count) = + case l of + English -> T.concat [ T.pack . show $ count, " payments created:" ] + French -> T.concat [ T.pack . show $ count, " paiements créés :" ] + +m l (WeeklyReport_PaymentsDeleted count) = + case l of + English -> T.concat [ T.pack . show $ count, " payments deleted:" ] + French -> T.concat [ T.pack . show $ count, " paiements supprimés :" ] + +m l (WeeklyReport_PaymentsEdited count) = + case l of + English -> T.concat [ T.pack . show $ count, " payments edited:" ] + French -> T.concat [ T.pack . show $ count, " paiements modifiés :" ] + +m l (WeeklyReport_PaymentCreated count) = + case l of + English -> T.concat [ T.pack . show $ count, " payment created:" ] + French -> T.concat [ T.pack . show $ count, " paiement créé :" ] + +m l (WeeklyReport_PaymentDeleted count) = + case l of + English -> T.concat [ T.pack . show $ count, " payment deleted:" ] + French -> T.concat [ T.pack . show $ count, " paiement supprimé :" ] + +m l (WeeklyReport_PaymentEdited count) = + case l of + English -> T.concat [ T.pack . show $ count, " payment edited:" ] + French -> T.concat [ T.pack . show $ count, " paiement modifié :" ] + +m l WeeklyReport_Title = + case l of + English -> "Weekly report" + French -> "Rapport hebdomadaire" diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs new file mode 100644 index 0000000..80c344b --- /dev/null +++ b/common/src/Common/Model.hs @@ -0,0 +1,18 @@ +module Common.Model (module X) where + +import Common.Model.Category as X +import Common.Model.CreateCategory as X +import Common.Model.CreateIncome as X +import Common.Model.CreatePayment as X +import Common.Model.Currency as X +import Common.Model.EditCategory as X +import Common.Model.EditIncome as X +import Common.Model.EditPayment as X +import Common.Model.Frequency as X +import Common.Model.Income as X +import Common.Model.Init as X +import Common.Model.InitResult as X +import Common.Model.Payment as X +import Common.Model.PaymentCategory as X +import Common.Model.SignIn as X +import Common.Model.User as X diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs new file mode 100644 index 0000000..53a6bdb --- /dev/null +++ b/common/src/Common/Model/Category.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Category + ( CategoryId + , Category(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +type CategoryId = Int64 + +data Category = Category + { _category_id :: CategoryId + , _category_name :: Text + , _category_color :: Text + , _category_createdAt :: UTCTime + , _category_editedAt :: Maybe UTCTime + , _category_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Category +instance ToJSON Category diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs new file mode 100644 index 0000000..bfe24c5 --- /dev/null +++ b/common/src/Common/Model/CreateCategory.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreateCategory + ( CreateCategory(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateCategory = CreateCategory + { _createCategory_name :: Text + , _createCategory_color :: Text + } deriving (Show, Generic) + +instance FromJSON CreateCategory diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs new file mode 100644 index 0000000..4ee3a50 --- /dev/null +++ b/common/src/Common/Model/CreateIncome.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreateIncome + ( CreateIncome(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +data CreateIncome = CreateIncome + { _createIncome_date :: Day + , _createIncome_amount :: Int + } deriving (Show, Generic) + +instance FromJSON CreateIncome diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs new file mode 100644 index 0000000..b5b6256 --- /dev/null +++ b/common/src/Common/Model/CreatePayment.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreatePayment + ( CreatePayment(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) + +data CreatePayment = CreatePayment + { _createPayment_name :: Text + , _createPayment_cost :: Int + , _createPayment_date :: Day + , _createPayment_category :: CategoryId + , _createPayment_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON CreatePayment diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs new file mode 100644 index 0000000..7c12545 --- /dev/null +++ b/common/src/Common/Model/Currency.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Currency + ( Currency(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Currency = Currency Text deriving (Show, Generic) + +instance FromJSON Currency +instance ToJSON Currency diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs new file mode 100644 index 0000000..2a3a697 --- /dev/null +++ b/common/src/Common/Model/EditCategory.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditCategory + ( EditCategory(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) + +data EditCategory = EditCategory + { _editCategory_id :: CategoryId + , _editCategory_name :: Text + , _editCategory_color :: Text + } deriving (Show, Generic) + +instance FromJSON EditCategory diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs new file mode 100644 index 0000000..a55c39e --- /dev/null +++ b/common/src/Common/Model/EditIncome.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditIncome + ( EditIncome(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Income (IncomeId) + +data EditIncome = EditIncome + { _editIncome_id :: IncomeId + , _editIncome_date :: Day + , _editIncome_amount :: Int + } deriving (Show, Generic) + +instance FromJSON EditIncome diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs new file mode 100644 index 0000000..172c0c1 --- /dev/null +++ b/common/src/Common/Model/EditPayment.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditPayment + ( EditPayment(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) + +data EditPayment = EditPayment + { _editPayment_id :: PaymentId + , _editPayment_name :: Text + , _editPayment_cost :: Int + , _editPayment_date :: Day + , _editPayment_category :: CategoryId + , _editPayment_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON EditPayment diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs new file mode 100644 index 0000000..7c46605 --- /dev/null +++ b/common/src/Common/Model/Frequency.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Frequency + ( Frequency(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +data Frequency = + Punctual + | Monthly + deriving (Eq, Read, Show, Generic) + +instance FromJSON Frequency +instance ToJSON Frequency diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs new file mode 100644 index 0000000..280812f --- /dev/null +++ b/common/src/Common/Model/Income.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Income + ( IncomeId + , Income(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +type IncomeId = Int64 + +data Income = Income + { _income_id :: IncomeId + , _income_userId :: UserId + , _income_date :: Day + , _income_amount :: Int + , _income_createdAt :: UTCTime + , _income_editedAt :: Maybe UTCTime + , _income_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Income +instance ToJSON Income diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs new file mode 100644 index 0000000..68fcfb8 --- /dev/null +++ b/common/src/Common/Model/Init.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Init + ( Init(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Category (Category) +import Common.Model.Currency (Currency) +import Common.Model.Income (Income) +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.User (UserId, User) + +data Init = Init + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_payments :: [Payment] + , _init_incomes :: [Income] + , _init_categories :: [Category] + , _init_paymentCategories :: [PaymentCategory] + , _init_currency :: Currency + } deriving (Show, Generic) + +instance FromJSON Init +instance ToJSON Init diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs new file mode 100644 index 0000000..43c16f9 --- /dev/null +++ b/common/src/Common/Model/InitResult.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.InitResult + ( InitResult(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Init (Init) + +data InitResult = + InitSuccess Init + | InitEmpty (Either Text (Maybe Text)) + deriving (Show, Generic) + +instance FromJSON InitResult +instance ToJSON InitResult diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs new file mode 100644 index 0000000..804b501 --- /dev/null +++ b/common/src/Common/Model/Payment.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Payment + ( PaymentId + , Payment(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Frequency +import Common.Model.User (UserId) + +type PaymentId = Int64 + +data Payment = Payment + { _payment_id :: PaymentId + , _payment_user :: UserId + , _payment_name :: Text + , _payment_cost :: Int + , _payment_date :: Day + , _payment_frequency :: Frequency + , _payment_createdAt :: UTCTime + , _payment_editedAt :: Maybe UTCTime + , _payment_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Payment +instance ToJSON Payment diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs new file mode 100644 index 0000000..a0e94f9 --- /dev/null +++ b/common/src/Common/Model/PaymentCategory.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.PaymentCategory + ( PaymentCategoryId + , PaymentCategory(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) + +type PaymentCategoryId = Int64 + +data PaymentCategory = PaymentCategory + { _paymentCategory_id :: PaymentCategoryId + , _paymentCategory_name :: Text + , _paymentCategory_category :: CategoryId + , _paymentCategory_createdAt :: UTCTime + , _paymentCategory_editedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON PaymentCategory +instance ToJSON PaymentCategory diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs new file mode 100644 index 0000000..f4da97f --- /dev/null +++ b/common/src/Common/Model/SignIn.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.SignIn + ( SignIn(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SignIn = SignIn + { _signIn_email :: Text + } deriving (Show, Generic) + +instance FromJSON SignIn +instance ToJSON SignIn diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs new file mode 100644 index 0000000..694c70e --- /dev/null +++ b/common/src/Common/Model/User.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.User + ( UserId + , User(..) + , findUser + ) where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.List as L +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +type UserId = Int64 + +data User = User + { _user_id :: UserId + , _user_creation :: UTCTime + , _user_email :: Text + , _user_name :: Text + } deriving (Show, Generic) + +instance FromJSON User +instance ToJSON User + +findUser :: UserId -> [User] -> Maybe User +findUser userId users = L.find ((== userId) . _user_id) users diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs new file mode 100644 index 0000000..4af7a4c --- /dev/null +++ b/common/src/Common/Util/Text.hs @@ -0,0 +1,41 @@ +module Common.Util.Text + ( unaccent + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +unaccent :: Text -> Text +unaccent = T.map unaccentChar + +unaccentChar :: Char -> Char +unaccentChar c = case c of + 'à' -> 'a' + 'á' -> 'a' + 'â' -> 'a' + 'ã' -> 'a' + 'ä' -> 'a' + 'ç' -> 'c' + 'è' -> 'e' + 'é' -> 'e' + 'ê' -> 'e' + 'ë' -> 'e' + 'ì' -> 'i' + 'í' -> 'i' + 'î' -> 'i' + 'ï' -> 'i' + 'ñ' -> 'n' + 'ò' -> 'o' + 'ó' -> 'o' + 'ô' -> 'o' + 'õ' -> 'o' + 'ö' -> 'o' + 'š' -> 's' + 'ù' -> 'u' + 'ú' -> 'u' + 'û' -> 'u' + 'ü' -> 'u' + 'ý' -> 'y' + 'ÿ' -> 'y' + 'ž' -> 'z' + _ -> c diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs new file mode 100644 index 0000000..7165965 --- /dev/null +++ b/common/src/Common/View/Format.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Common.View.Format + ( shortDay + , longDay + , price + , number + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.List (intersperse) +import Data.Maybe (fromMaybe) +import Data.Time.Calendar (Day, toGregorian) + +import qualified Common.Message as Message +import qualified Common.Message.Key as Key +import Common.Model (Currency(..)) + +shortDay :: Day -> Text +shortDay date = + Message.get $ Key.Date_Short + day + month + (fromIntegral year) + where (year, month, day) = toGregorian date + +longDay :: Day -> Text +longDay date = + Message.get $ Key.Date_Long + day + (fromMaybe "−" . fmap Message.get . monthToKey $ month) + (fromIntegral year) + where (year, month, day) = toGregorian date + + monthToKey 1 = Just Key.Month_January + monthToKey 2 = Just Key.Month_February + monthToKey 3 = Just Key.Month_March + monthToKey 4 = Just Key.Month_April + monthToKey 5 = Just Key.Month_May + monthToKey 6 = Just Key.Month_June + monthToKey 7 = Just Key.Month_July + monthToKey 8 = Just Key.Month_August + monthToKey 9 = Just Key.Month_September + monthToKey 10 = Just Key.Month_October + monthToKey 11 = Just Key.Month_November + monthToKey 12 = Just Key.Month_December + monthToKey _ = Nothing + +price :: Currency -> Int -> Text +price (Currency currency) amount = T.concat [ number amount, " ", currency ] + +number :: Int -> Text +number n = + T.pack + . (++) (if n < 0 then "-" else "") + . reverse + . concat + . intersperse " " + . group 3 + . reverse + . show + . abs $ n + +group :: Int -> [a] -> [[a]] +group n xs = + if length xs <= n + then [xs] + else (take n xs) : (group n (drop n xs)) -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- common/src/Common/Message.hs | 6 +++--- common/src/Common/Message/Key.hs | 2 +- common/src/Common/Message/Translation.hs | 16 +++++++-------- common/src/Common/Model.hs | 32 +++++++++++++++--------------- common/src/Common/Model/Category.hs | 18 ++++++++--------- common/src/Common/Model/CreateCategory.hs | 8 ++++---- common/src/Common/Model/CreateIncome.hs | 8 ++++---- common/src/Common/Model/CreatePayment.hs | 20 +++++++++---------- common/src/Common/Model/Currency.hs | 6 +++--- common/src/Common/Model/EditCategory.hs | 12 +++++------ common/src/Common/Model/EditIncome.hs | 12 +++++------ common/src/Common/Model/EditPayment.hs | 24 +++++++++++----------- common/src/Common/Model/Frequency.hs | 4 ++-- common/src/Common/Model/Income.hs | 22 ++++++++++---------- common/src/Common/Model/Init.hs | 28 +++++++++++++------------- common/src/Common/Model/InitResult.hs | 8 ++++---- common/src/Common/Model/Payment.hs | 28 +++++++++++++------------- common/src/Common/Model/PaymentCategory.hs | 20 +++++++++---------- common/src/Common/Model/SignIn.hs | 6 +++--- common/src/Common/Model/User.hs | 18 ++++++++--------- common/src/Common/Util/Text.hs | 4 ++-- common/src/Common/View/Format.hs | 16 +++++++-------- 22 files changed, 159 insertions(+), 159 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message.hs b/common/src/Common/Message.hs index 9ae735d..745e457 100644 --- a/common/src/Common/Message.hs +++ b/common/src/Common/Message.hs @@ -2,10 +2,10 @@ module Common.Message ( get ) where -import Data.Text (Text) +import Data.Text (Text) -import Common.Message.Key (Key) -import Common.Message.Lang (Lang(..)) +import Common.Message.Key (Key) +import Common.Message.Lang (Lang (..)) import qualified Common.Message.Translation as Translation get :: Key -> Text diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 4127808..991c407 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -2,7 +2,7 @@ module Common.Message.Key ( Key(..) ) where -import Data.Text +import Data.Text data Key = diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 900a9e9..16a56dd 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -4,11 +4,11 @@ module Common.Message.Translation ( get ) where -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T -import Common.Message.Key -import Common.Message.Lang (Lang(..)) +import Common.Message.Key +import Common.Message.Lang (Lang (..)) get :: Lang -> Key -> Text get = m @@ -162,7 +162,7 @@ m l Form_AlreadyExists = m l Form_CostMustNotBeNull = case l of English -> "Cost must not be zero" - French -> "Le coût ne doît pas être nul" + French -> "Le coût ne doît pas être nul" m l Form_Empty = case l of @@ -462,7 +462,7 @@ m l Payment_PunctualMale = m l Payment_Title = case l of English -> "Payments" - French -> "Paiements" + French -> "Paiements" m l Payment_User = case l of @@ -472,7 +472,7 @@ m l Payment_User = m l (Payment_Worth subject amount) = case l of English -> T.concat [ subject, " worth ", amount ] - French -> T.concat [ subject, " comptabilisant ", amount ] + French -> T.concat [ subject, " comptabilisant ", amount ] m l Search_Monthly = case l of @@ -517,7 +517,7 @@ m l SignIn_EmailInvalid = m l SignIn_EmailPlaceholder = case l of English -> "Email" - French -> "Courriel" + French -> "Courriel" m l SignIn_EmailSendFail = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 80c344b..20e86c1 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -1,18 +1,18 @@ module Common.Model (module X) where -import Common.Model.Category as X -import Common.Model.CreateCategory as X -import Common.Model.CreateIncome as X -import Common.Model.CreatePayment as X -import Common.Model.Currency as X -import Common.Model.EditCategory as X -import Common.Model.EditIncome as X -import Common.Model.EditPayment as X -import Common.Model.Frequency as X -import Common.Model.Income as X -import Common.Model.Init as X -import Common.Model.InitResult as X -import Common.Model.Payment as X -import Common.Model.PaymentCategory as X -import Common.Model.SignIn as X -import Common.Model.User as X +import Common.Model.Category as X +import Common.Model.CreateCategory as X +import Common.Model.CreateIncome as X +import Common.Model.CreatePayment as X +import Common.Model.Currency as X +import Common.Model.EditCategory as X +import Common.Model.EditIncome as X +import Common.Model.EditPayment as X +import Common.Model.Frequency as X +import Common.Model.Income as X +import Common.Model.Init as X +import Common.Model.InitResult as X +import Common.Model.Payment as X +import Common.Model.PaymentCategory as X +import Common.Model.SignIn as X +import Common.Model.User as X diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index 53a6bdb..bbd3c33 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -5,20 +5,20 @@ module Common.Model.Category , Category(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) type CategoryId = Int64 data Category = Category - { _category_id :: CategoryId - , _category_name :: Text - , _category_color :: Text + { _category_id :: CategoryId + , _category_name :: Text + , _category_color :: Text , _category_createdAt :: UTCTime - , _category_editedAt :: Maybe UTCTime + , _category_editedAt :: Maybe UTCTime , _category_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs index bfe24c5..11d84e9 100644 --- a/common/src/Common/Model/CreateCategory.hs +++ b/common/src/Common/Model/CreateCategory.hs @@ -4,12 +4,12 @@ module Common.Model.CreateCategory ( CreateCategory(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) data CreateCategory = CreateCategory - { _createCategory_name :: Text + { _createCategory_name :: Text , _createCategory_color :: Text } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs index 4ee3a50..583ebbb 100644 --- a/common/src/Common/Model/CreateIncome.hs +++ b/common/src/Common/Model/CreateIncome.hs @@ -4,12 +4,12 @@ module Common.Model.CreateIncome ( CreateIncome(..) ) where -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) data CreateIncome = CreateIncome - { _createIncome_date :: Day + { _createIncome_date :: Day , _createIncome_amount :: Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index b5b6256..7a283e5 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -4,19 +4,19 @@ module Common.Model.CreatePayment ( CreatePayment(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) data CreatePayment = CreatePayment - { _createPayment_name :: Text - , _createPayment_cost :: Int - , _createPayment_date :: Day - , _createPayment_category :: CategoryId + { _createPayment_name :: Text + , _createPayment_cost :: Int + , _createPayment_date :: Day + , _createPayment_category :: CategoryId , _createPayment_frequency :: Frequency } deriving (Show, Generic) diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs index 7c12545..6d74ea7 100644 --- a/common/src/Common/Model/Currency.hs +++ b/common/src/Common/Model/Currency.hs @@ -4,9 +4,9 @@ module Common.Model.Currency ( Currency(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) newtype Currency = Currency Text deriving (Show, Generic) diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs index 2a3a697..5b08b86 100644 --- a/common/src/Common/Model/EditCategory.hs +++ b/common/src/Common/Model/EditCategory.hs @@ -4,15 +4,15 @@ module Common.Model.EditCategory ( EditCategory(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) +import Common.Model.Category (CategoryId) data EditCategory = EditCategory - { _editCategory_id :: CategoryId - , _editCategory_name :: Text + { _editCategory_id :: CategoryId + , _editCategory_name :: Text , _editCategory_color :: Text } deriving (Show, Generic) diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs index a55c39e..867b406 100644 --- a/common/src/Common/Model/EditIncome.hs +++ b/common/src/Common/Model/EditIncome.hs @@ -4,15 +4,15 @@ module Common.Model.EditIncome ( EditIncome(..) ) where -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Income (IncomeId) +import Common.Model.Income (IncomeId) data EditIncome = EditIncome - { _editIncome_id :: IncomeId - , _editIncome_date :: Day + { _editIncome_id :: IncomeId + , _editIncome_date :: Day , _editIncome_amount :: Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index 172c0c1..32228f0 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -4,21 +4,21 @@ module Common.Model.EditPayment ( EditPayment(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) -import Common.Model.Payment (PaymentId) +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) data EditPayment = EditPayment - { _editPayment_id :: PaymentId - , _editPayment_name :: Text - , _editPayment_cost :: Int - , _editPayment_date :: Day - , _editPayment_category :: CategoryId + { _editPayment_id :: PaymentId + , _editPayment_name :: Text + , _editPayment_cost :: Int + , _editPayment_date :: Day + , _editPayment_category :: CategoryId , _editPayment_frequency :: Frequency } deriving (Show, Generic) diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index 7c46605..085163d 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -4,8 +4,8 @@ module Common.Model.Frequency ( Frequency(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) data Frequency = Punctual diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 280812f..10b4cf2 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -5,23 +5,23 @@ module Common.Model.Income , Income(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Time (UTCTime) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.User (UserId) +import Common.Model.User (UserId) type IncomeId = Int64 data Income = Income - { _income_id :: IncomeId - , _income_userId :: UserId - , _income_date :: Day - , _income_amount :: Int + { _income_id :: IncomeId + , _income_userId :: UserId + , _income_date :: Day + , _income_amount :: Int , _income_createdAt :: UTCTime - , _income_editedAt :: Maybe UTCTime + , _income_editedAt :: Maybe UTCTime , _income_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index 68fcfb8..ae23bb5 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -4,24 +4,24 @@ module Common.Model.Init ( Init(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) -import Common.Model.Category (Category) -import Common.Model.Currency (Currency) -import Common.Model.Income (Income) -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) -import Common.Model.User (UserId, User) +import Common.Model.Category (Category) +import Common.Model.Currency (Currency) +import Common.Model.Income (Income) +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.User (User, UserId) data Init = Init - { _init_users :: [User] - , _init_currentUser :: UserId - , _init_payments :: [Payment] - , _init_incomes :: [Income] - , _init_categories :: [Category] + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_payments :: [Payment] + , _init_incomes :: [Income] + , _init_categories :: [Category] , _init_paymentCategories :: [PaymentCategory] - , _init_currency :: Currency + , _init_currency :: Currency } deriving (Show, Generic) instance FromJSON Init diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 43c16f9..12be65a 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -4,11 +4,11 @@ module Common.Model.InitResult ( InitResult(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) -import Common.Model.Init (Init) +import Common.Model.Init (Init) data InitResult = InitSuccess Init diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index 804b501..4741058 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -5,27 +5,27 @@ module Common.Model.Payment , Payment(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Frequency -import Common.Model.User (UserId) +import Common.Model.Frequency +import Common.Model.User (UserId) type PaymentId = Int64 data Payment = Payment - { _payment_id :: PaymentId - , _payment_user :: UserId - , _payment_name :: Text - , _payment_cost :: Int - , _payment_date :: Day + { _payment_id :: PaymentId + , _payment_user :: UserId + , _payment_name :: Text + , _payment_cost :: Int + , _payment_date :: Day , _payment_frequency :: Frequency , _payment_createdAt :: UTCTime - , _payment_editedAt :: Maybe UTCTime + , _payment_editedAt :: Maybe UTCTime , _payment_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs index a0e94f9..24cf9e1 100644 --- a/common/src/Common/Model/PaymentCategory.hs +++ b/common/src/Common/Model/PaymentCategory.hs @@ -5,22 +5,22 @@ module Common.Model.PaymentCategory , PaymentCategory(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) +import Common.Model.Category (CategoryId) type PaymentCategoryId = Int64 data PaymentCategory = PaymentCategory - { _paymentCategory_id :: PaymentCategoryId - , _paymentCategory_name :: Text - , _paymentCategory_category :: CategoryId + { _paymentCategory_id :: PaymentCategoryId + , _paymentCategory_name :: Text + , _paymentCategory_category :: CategoryId , _paymentCategory_createdAt :: UTCTime - , _paymentCategory_editedAt :: Maybe UTCTime + , _paymentCategory_editedAt :: Maybe UTCTime } deriving (Show, Generic) instance FromJSON PaymentCategory diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs index f4da97f..baccd88 100644 --- a/common/src/Common/Model/SignIn.hs +++ b/common/src/Common/Model/SignIn.hs @@ -4,9 +4,9 @@ module Common.Model.SignIn ( SignIn(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) data SignIn = SignIn { _signIn_email :: Text diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs index 694c70e..e491c31 100644 --- a/common/src/Common/Model/User.hs +++ b/common/src/Common/Model/User.hs @@ -6,20 +6,20 @@ module Common.Model.User , findUser ) where -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.List as L -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import qualified Data.List as L +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) type UserId = Int64 data User = User - { _user_id :: UserId + { _user_id :: UserId , _user_creation :: UTCTime - , _user_email :: Text - , _user_name :: Text + , _user_email :: Text + , _user_name :: Text } deriving (Show, Generic) instance FromJSON User diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs index 4af7a4c..7e5c8c2 100644 --- a/common/src/Common/Util/Text.hs +++ b/common/src/Common/Util/Text.hs @@ -2,7 +2,7 @@ module Common.Util.Text ( unaccent ) where -import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text as T unaccent :: Text -> Text @@ -38,4 +38,4 @@ unaccentChar c = case c of 'ý' -> 'y' 'ÿ' -> 'y' 'ž' -> 'z' - _ -> c + _ -> c diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs index 7165965..783ad67 100644 --- a/common/src/Common/View/Format.hs +++ b/common/src/Common/View/Format.hs @@ -7,15 +7,15 @@ module Common.View.Format , number ) where -import Data.Text (Text) -import qualified Data.Text as T -import Data.List (intersperse) -import Data.Maybe (fromMaybe) -import Data.Time.Calendar (Day, toGregorian) +import Data.List (intersperse) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day, toGregorian) -import qualified Common.Message as Message +import qualified Common.Message as Message import qualified Common.Message.Key as Key -import Common.Model (Currency(..)) +import Common.Model (Currency (..)) shortDay :: Day -> Text shortDay date = @@ -45,7 +45,7 @@ longDay date = monthToKey 10 = Just Key.Month_October monthToKey 11 = Just Key.Month_November monthToKey 12 = Just Key.Month_December - monthToKey _ = Nothing + monthToKey _ = Nothing price :: Currency -> Int -> Text price (Currency currency) amount = T.concat [ number amount, " ", currency ] -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- common/src/Common/Message.hs | 12 ---------- common/src/Common/Message/Key.hs | 2 +- common/src/Common/Message/Translation.hs | 12 +++++----- common/src/Common/Model/Category.hs | 2 -- common/src/Common/Model/CreateCategory.hs | 2 -- common/src/Common/Model/CreateIncome.hs | 2 -- common/src/Common/Model/CreatePayment.hs | 2 -- common/src/Common/Model/Currency.hs | 2 -- common/src/Common/Model/EditCategory.hs | 2 -- common/src/Common/Model/EditIncome.hs | 2 -- common/src/Common/Model/EditPayment.hs | 2 -- common/src/Common/Model/Frequency.hs | 2 -- common/src/Common/Model/Income.hs | 2 -- common/src/Common/Model/Init.hs | 2 -- common/src/Common/Model/InitResult.hs | 2 -- common/src/Common/Model/Payment.hs | 2 -- common/src/Common/Model/PaymentCategory.hs | 2 -- common/src/Common/Model/SignIn.hs | 2 -- common/src/Common/Model/User.hs | 2 -- common/src/Common/Msg.hs | 13 +++++++++++ common/src/Common/View/Format.hs | 35 ++++++++++++++---------------- 21 files changed, 35 insertions(+), 71 deletions(-) delete mode 100644 common/src/Common/Message.hs create mode 100644 common/src/Common/Msg.hs (limited to 'common/src') diff --git a/common/src/Common/Message.hs b/common/src/Common/Message.hs deleted file mode 100644 index 745e457..0000000 --- a/common/src/Common/Message.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Common.Message - ( get - ) where - -import Data.Text (Text) - -import Common.Message.Key (Key) -import Common.Message.Lang (Lang (..)) -import qualified Common.Message.Translation as Translation - -get :: Key -> Text -get = Translation.get French diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 991c407..ad8a7f1 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -83,6 +83,7 @@ data Key = | Payment_Add | Payment_Balanced + | Payment_By Text Text | Payment_Category | Payment_CloneLong | Payment_CloneShort @@ -129,7 +130,6 @@ data Key = | Statistic_Title | Statistic_ByMonthsAndMean Text - | Statistic_By Text Text | Statistic_Total | WeeklyReport_Empty diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 16a56dd..0a6084d 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Common.Message.Translation ( get ) where @@ -359,6 +357,11 @@ m l Payment_Balanced = English -> "Payments are balanced." French -> "Les paiements sont équilibrés." +m l (Payment_By key value) = + case l of + English -> T.concat [ key, ": ", value ] + French -> T.concat [ key, " : ", value ] + m l Payment_Category = case l of English -> "Category" @@ -584,11 +587,6 @@ m l SignIn_ParseError = English -> "Error while reading initial data." French -> "Erreur lors de la lecture des données initiales." -m l (Statistic_By key value) = - case l of - English -> T.concat [ key, ": ", value ] - French -> T.concat [ key, " : ", value ] - m l (Statistic_ByMonthsAndMean amount) = case l of English -> diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index bbd3c33..db1da53 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Category ( CategoryId , Category(..) diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs index 11d84e9..51bd2a0 100644 --- a/common/src/Common/Model/CreateCategory.hs +++ b/common/src/Common/Model/CreateCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreateCategory ( CreateCategory(..) ) where diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs index 583ebbb..644a51c 100644 --- a/common/src/Common/Model/CreateIncome.hs +++ b/common/src/Common/Model/CreateIncome.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreateIncome ( CreateIncome(..) ) where diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index 7a283e5..8e2ab73 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreatePayment ( CreatePayment(..) ) where diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs index 6d74ea7..175aeba 100644 --- a/common/src/Common/Model/Currency.hs +++ b/common/src/Common/Model/Currency.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Currency ( Currency(..) ) where diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs index 5b08b86..8b9d9eb 100644 --- a/common/src/Common/Model/EditCategory.hs +++ b/common/src/Common/Model/EditCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditCategory ( EditCategory(..) ) where diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs index 867b406..0e65f12 100644 --- a/common/src/Common/Model/EditIncome.hs +++ b/common/src/Common/Model/EditIncome.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditIncome ( EditIncome(..) ) where diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index 32228f0..d2c223f 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditPayment ( EditPayment(..) ) where diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index 085163d..ee502e8 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Frequency ( Frequency(..) ) where diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 10b4cf2..0423704 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Income ( IncomeId , Income(..) diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index ae23bb5..68b3f5d 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Init ( Init(..) ) where diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 12be65a..542e6c7 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.InitResult ( InitResult(..) ) where diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index 4741058..37a090d 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Payment ( PaymentId , Payment(..) diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs index 24cf9e1..2a559ce 100644 --- a/common/src/Common/Model/PaymentCategory.hs +++ b/common/src/Common/Model/PaymentCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.PaymentCategory ( PaymentCategoryId , PaymentCategory(..) diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs index baccd88..bfd7fbc 100644 --- a/common/src/Common/Model/SignIn.hs +++ b/common/src/Common/Model/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.SignIn ( SignIn(..) ) where diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs index e491c31..a30d104 100644 --- a/common/src/Common/Model/User.hs +++ b/common/src/Common/Model/User.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.User ( UserId , User(..) diff --git a/common/src/Common/Msg.hs b/common/src/Common/Msg.hs new file mode 100644 index 0000000..9e4cfe2 --- /dev/null +++ b/common/src/Common/Msg.hs @@ -0,0 +1,13 @@ +module Common.Msg + ( get + , Key(..) + ) where + +import Data.Text (Text) + +import Common.Message.Key (Key (..)) +import Common.Message.Lang (Lang (..)) +import qualified Common.Message.Translation as Translation + +get :: Key -> Text +get = Translation.get French diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs index 783ad67..0597d17 100644 --- a/common/src/Common/View/Format.hs +++ b/common/src/Common/View/Format.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Common.View.Format ( shortDay , longDay @@ -13,13 +11,12 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, toGregorian) -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (Currency (..)) +import qualified Common.Msg as Msg shortDay :: Day -> Text shortDay date = - Message.get $ Key.Date_Short + Msg.get $ Msg.Date_Short day month (fromIntegral year) @@ -27,24 +24,24 @@ shortDay date = longDay :: Day -> Text longDay date = - Message.get $ Key.Date_Long + Msg.get $ Msg.Date_Long day - (fromMaybe "−" . fmap Message.get . monthToKey $ month) + (fromMaybe "−" . fmap Msg.get . monthToKey $ month) (fromIntegral year) where (year, month, day) = toGregorian date - monthToKey 1 = Just Key.Month_January - monthToKey 2 = Just Key.Month_February - monthToKey 3 = Just Key.Month_March - monthToKey 4 = Just Key.Month_April - monthToKey 5 = Just Key.Month_May - monthToKey 6 = Just Key.Month_June - monthToKey 7 = Just Key.Month_July - monthToKey 8 = Just Key.Month_August - monthToKey 9 = Just Key.Month_September - monthToKey 10 = Just Key.Month_October - monthToKey 11 = Just Key.Month_November - monthToKey 12 = Just Key.Month_December + monthToKey 1 = Just Msg.Month_January + monthToKey 2 = Just Msg.Month_February + monthToKey 3 = Just Msg.Month_March + monthToKey 4 = Just Msg.Month_April + monthToKey 5 = Just Msg.Month_May + monthToKey 6 = Just Msg.Month_June + monthToKey 7 = Just Msg.Month_July + monthToKey 8 = Just Msg.Month_August + monthToKey 9 = Just Msg.Month_September + monthToKey 10 = Just Msg.Month_October + monthToKey 11 = Just Msg.Month_November + monthToKey 12 = Just Msg.Month_December monthToKey _ = Nothing price :: Currency -> Int -> Text -- cgit v1.2.3 From bab2c30addf8aaed85675e2b7f7b15c97c426f74 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 15:00:07 +0100 Subject: Add exceeding payer block --- common/src/Common/Model.hs | 1 + common/src/Common/Model/Payer.hs | 198 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 199 insertions(+) create mode 100644 common/src/Common/Model/Payer.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 20e86c1..cb38b2f 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -12,6 +12,7 @@ import Common.Model.Frequency as X import Common.Model.Income as X import Common.Model.Init as X import Common.Model.InitResult as X +import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X import Common.Model.SignIn as X diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs new file mode 100644 index 0000000..d09dbf6 --- /dev/null +++ b/common/src/Common/Model/Payer.hs @@ -0,0 +1,198 @@ +module Common.Model.Payer + ( getExceedingPayers + , ExceedingPayer(..) + ) where + +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import Data.Time (NominalDiffTime, UTCTime (..)) +import qualified Data.Time as Time + +import Common.Model.Income (Income (..)) +import Common.Model.Payment (Payment (..)) +import Common.Model.User (User (..), UserId) + +data Payer = Payer + { _payer_userId :: UserId + , _payer_preIncomePayments :: Int + , _payer_postIncomePayments :: Int + , _payer_incomes :: [Income] + } + +data PostPaymentPayer = PostPaymentPayer + { _postPaymentPayer_userId :: UserId + , _postPaymentPayer_preIncomePayments :: Int + , _postPaymentPayer_cumulativeIncome :: Int + , _postPaymentPayer_ratio :: Float + } + +data ExceedingPayer = ExceedingPayer + { _exceedingPayer_userId :: UserId + , _exceedingPayer_amount :: Int + } deriving (Show) + +getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] +getExceedingPayers currentTime users incomes payments = + let userIds = map _user_id users + payers = getPayers currentTime userIds incomes payments + exceedingPayersOnPreIncome = + exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers + mbSince = useIncomesFrom userIds incomes payments + in case mbSince of + Just since -> + let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers + mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers + in case mbMaxRatio of + Just maxRatio -> + exceedingPayersFromAmounts + . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p)) + $ postPaymentPayers + Nothing -> + exceedingPayersOnPreIncome + _ -> + exceedingPayersOnPreIncome + +useIncomesFrom :: [UserId] -> [Income] -> [Payment] -> Maybe UTCTime +useIncomesFrom userIds incomes payments = + let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments + mbIncomeTime = incomeDefinedForAll userIds incomes + in case (firstPaymentTime, mbIncomeTime) of + (Just t1, Just t2) -> Just (max t1 t2) + _ -> Nothing + +paymentTime :: Payment -> UTCTime +paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date + +getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer] +getPayers currentTime userIds incomes payments = + let incomesDefined = incomeDefinedForAll userIds incomes + in flip map userIds (\userId -> Payer + { _payer_userId = userId + , _payer_preIncomePayments = + totalPayments + (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined)) + userId + payments + , _payer_postIncomePayments = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> paymentTime p >= t + ) + userId + payments + , _payer_incomes = filter ((==) userId . _income_userId) incomes + } + ) + +exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer] +exceedingPayersFromAmounts userAmounts = + case mbMinAmount of + Nothing -> + [] + Just minAmount -> + filter (\payer -> _exceedingPayer_amount payer > 0) + . map (\userAmount -> + ExceedingPayer + { _exceedingPayer_userId = fst userAmount + , _exceedingPayer_amount = snd userAmount - minAmount + } + ) + $ userAmounts + where mbMinAmount = safeMinimum . map snd $ userAmounts + +getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer +getPostPaymentPayer currentTime since payer = + PostPaymentPayer + { _postPaymentPayer_userId = _payer_userId payer + , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer + , _postPaymentPayer_cumulativeIncome = cumulativeIncome + , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome) + } + where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer) + +getFinalDiff :: Float -> PostPaymentPayer -> Int +getFinalDiff maxRatio payer = + let postIncomeDiff = + truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) + in postIncomeDiff + _postPaymentPayer_preIncomePayments payer + +incomeDefinedForAll :: [UserId] -> [Income] -> Maybe UTCTime +incomeDefinedForAll userIds incomes = + let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds + firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes + in if all Maybe.isJust firstIncomes + then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes + else Nothing + +cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int +cumulativeIncomesSince currentTime since incomes = + getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) + +getOrderedIncomesSince :: UTCTime -> [Income] -> [Income] +getOrderedIncomesSince time incomes = + let mbStarterIncome = getIncomeAt time incomes + orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes + in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince + +getIncomeAt :: UTCTime -> [Income] -> Maybe Income +getIncomeAt time incomes = + case incomes of + [x] -> + if incomeTime x < time + then Just $ x { _income_date = utctDay time } + else Nothing + x1 : x2 : xs -> + if incomeTime x1 < time && incomeTime x2 >= time + then Just $ x1 { _income_date = utctDay time } + else getIncomeAt time (x2 : xs) + [] -> + Nothing + +getCumulativeIncome :: UTCTime -> [Income] -> Int +getCumulativeIncome currentTime incomes = + sum + . map durationIncome + . getIncomesWithDuration currentTime + . List.sortOn incomeTime + $ incomes + +getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)] +getIncomesWithDuration currentTime incomes = + case incomes of + [] -> + [] + [income] -> + [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)] + (income1 : income2 : xs) -> + (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) + +incomeTime :: Income -> UTCTime +incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date + +durationIncome :: (NominalDiffTime, Int) -> Int +durationIncome (duration, income) = + truncate $ duration * fromIntegral income / (nominalDay * 365 / 12) + +nominalDay :: NominalDiffTime +nominalDay = 86400 + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x : _) = Just x + +safeMinimum :: (Ord a) => [a] -> Maybe a +safeMinimum [] = Nothing +safeMinimum xs = Just . minimum $ xs + +safeMaximum :: (Ord a) => [a] -> Maybe a +safeMaximum [] = Nothing +safeMaximum xs = Just . maximum $ xs + +totalPayments :: (Payment -> Bool) -> UserId -> [Payment] -> Int +totalPayments paymentFilter userId payments = + sum + . map _payment_cost + . filter (\payment -> paymentFilter payment && _payment_user payment == userId) + $ payments -- cgit v1.2.3 From 49426740e8e0c59040f4f3721a658f225572582b Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 28 Nov 2017 09:11:19 +0100 Subject: Add search for payments --- common/src/Common/Message/Key.hs | 2 +- common/src/Common/Message/Translation.hs | 2 +- common/src/Common/Util/Text.hs | 8 +++++++- 3 files changed, 9 insertions(+), 3 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index ad8a7f1..a6828d5 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -118,7 +118,7 @@ data Key = | SignIn_Button | SignIn_DisconnectSuccess | SignIn_EmailInvalid - | SignIn_EmailPlaceholder + | SignIn_EmailLabel | SignIn_EmailSendFail | SignIn_EmailSent | SignIn_LinkExpired diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 0a6084d..13ced15 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -517,7 +517,7 @@ m l SignIn_EmailInvalid = English -> "Your email is not valid." French -> "Votre courriel n’est pas valide." -m l SignIn_EmailPlaceholder = +m l SignIn_EmailLabel = case l of English -> "Email" French -> "Courriel" diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs index 7e5c8c2..b49fc55 100644 --- a/common/src/Common/Util/Text.hs +++ b/common/src/Common/Util/Text.hs @@ -1,10 +1,16 @@ module Common.Util.Text - ( unaccent + ( search + , unaccent ) where import Data.Text (Text) import qualified Data.Text as T +search :: Text -> Text -> Bool +search s t = + (format s) `T.isInfixOf` (format t) + where format = T.toLower . unaccent + unaccent :: Text -> Text unaccent = T.map unaccentChar -- cgit v1.2.3 From 17d6a05756479388c91bc2e50f721fcea8a82d38 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 3 Jan 2018 17:36:23 +0100 Subject: Remove quotes around names in weekly report --- common/src/Common/Message/Translation.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 13ced15..5ea12ad 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -641,23 +641,23 @@ m l (WeeklyReport_IncomeEdited count) = m l (WeeklyReport_PayedFor name amount for at) = case l of - English -> T.concat [ T.pack . show $ name, " payed ", amount, " for “", for, "” at ", at ] - French -> T.concat [ T.pack . show $ name, " a payé ", amount, " concernant « ", for, " » le ", at ] + English -> T.concat [ name, " payed ", amount, " for “", for, "” at ", at ] + French -> T.concat [ name, " a payé ", amount, " concernant « ", for, " » le ", at ] m l (WeeklyReport_PayedForNot name amount for at) = case l of - English -> T.concat [ T.pack . show $ name, " didn’t pay ", amount, " for “", for, "” at ", at ] - French -> T.concat [ T.pack . show $ name, " n’a pas payé ", amount, " concernant « ", for, " » le ", at ] + English -> T.concat [ name, " didn’t pay ", amount, " for “", for, "” at ", at ] + French -> T.concat [ name, " n’a pas payé ", amount, " concernant « ", for, " » le ", at ] m l (WeeklyReport_PayedFrom name amount for) = case l of - English -> T.concat [ T.pack . show $ name, " is payed ", amount, " of net monthly income from ", for ] - French -> T.concat [ T.pack . show $ name, " est payé ", amount, " net par mois à partir du ", for ] + English -> T.concat [ name, " is payed ", amount, " of net monthly income from ", for ] + French -> T.concat [ name, " est payé ", amount, " net par mois à partir du ", for ] m l (WeeklyReport_PayedFromNot name amount for) = case l of - English -> T.concat [ T.pack . show $ name, " isn’t payed ", amount, " of net monthly income from ", for ] - French -> T.concat [ T.pack . show $ name, " n’est pas payé ", amount, " net par mois à partir du ", for ] + English -> T.concat [ name, " isn’t payed ", amount, " of net monthly income from ", for ] + French -> T.concat [ name, " n’est pas payé ", amount, " net par mois à partir du ", for ] m l (WeeklyReport_PaymentsCreated count) = case l of -- cgit v1.2.3 From ab17b6339d16970c3845ec4f153bfeed89eae728 Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 5 Jan 2018 14:45:47 +0100 Subject: Add modal component --- common/src/Common/Model/Frequency.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'common/src') diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index ee502e8..48e75ea 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -8,7 +8,7 @@ import GHC.Generics (Generic) data Frequency = Punctual | Monthly - deriving (Eq, Read, Show, Generic) + deriving (Eq, Read, Show, Generic, Ord) instance FromJSON Frequency instance ToJSON Frequency -- cgit v1.2.3 From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- common/src/Common/Model/CreatePayment.hs | 3 ++- common/src/Common/Model/InitResult.hs | 3 ++- common/src/Common/Util/Time.hs | 26 ++++++++++++++++++++++++++ 3 files changed, 30 insertions(+), 2 deletions(-) create mode 100644 common/src/Common/Util/Time.hs (limited to 'common/src') diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index 8e2ab73..cd0b01d 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -2,7 +2,7 @@ module Common.Model.CreatePayment ( CreatePayment(..) ) where -import Data.Aeson (FromJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Data.Time.Calendar (Day) import GHC.Generics (Generic) @@ -19,3 +19,4 @@ data CreatePayment = CreatePayment } deriving (Show, Generic) instance FromJSON CreatePayment +instance ToJSON CreatePayment diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 542e6c7..f4c08a9 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -10,7 +10,8 @@ import Common.Model.Init (Init) data InitResult = InitSuccess Init - | InitEmpty (Either Text (Maybe Text)) + | InitError Text + | InitEmpty deriving (Show, Generic) instance FromJSON InitResult diff --git a/common/src/Common/Util/Time.hs b/common/src/Common/Util/Time.hs new file mode 100644 index 0000000..9ab7ab5 --- /dev/null +++ b/common/src/Common/Util/Time.hs @@ -0,0 +1,26 @@ +module Common.Util.Time + ( timeToDay + , parseDay + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (UTCTime) +import qualified Data.Time as Time +import Data.Time.Calendar (Day) +import Data.Time.LocalTime +import qualified Text.Read as T + +timeToDay :: UTCTime -> IO Day +timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time + +parseDay :: Text -> Maybe Day +parseDay str = do + (d, m, y) <- + case T.splitOn str "/" of + [d, m, y] -> Just (d, m, y) + _ -> Nothing + d' <- T.readMaybe . T.unpack $ d + m' <- T.readMaybe . T.unpack $ m + y' <- T.readMaybe . T.unpack $ y + return $ Time.fromGregorian y' m' d' -- cgit v1.2.3 From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Oct 2018 17:57:58 +0100 Subject: Delete payment --- common/src/Common/Message/Key.hs | 4 ++-- common/src/Common/Message/Translation.hs | 12 ++++++------ common/src/Common/Model/CreatePayment.hs | 14 +++++++++++++- 3 files changed, 21 insertions(+), 9 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index a6828d5..6e5f246 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -38,8 +38,8 @@ data Key = | Error_SignOut | Form_AlreadyExists - | Form_CostMustNotBeNull - | Form_Empty + | Form_NonEmpty + | Form_NonNullNumber | Form_GreaterIntThan Int | Form_InvalidCategory | Form_InvalidColor diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 5ea12ad..70eb978 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -157,16 +157,16 @@ m l Form_AlreadyExists = English -> "Dupplicate field" French -> "Doublon" -m l Form_CostMustNotBeNull = - case l of - English -> "Cost must not be zero" - French -> "Le coût ne doît pas être nul" - -m l Form_Empty = +m l Form_NonEmpty = case l of English -> "Required field" French -> "Champ requis" +m l Form_NonNullNumber = + case l of + English -> "Number must not be null" + French -> "Le nombre ne doit pas être nul" + m l (Form_GreaterIntThan number) = case l of English -> T.concat [ "Integer smaller than ", T.pack . show $ number, " or equal required" ] diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index cd0b01d..c61423c 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -1,5 +1,6 @@ module Common.Model.CreatePayment - ( CreatePayment(..) + ( CreatePaymentError(..) + , CreatePayment(..) ) where import Data.Aeson (FromJSON, ToJSON) @@ -10,6 +11,17 @@ import GHC.Generics (Generic) import Common.Model.Category (CategoryId) import Common.Model.Frequency (Frequency) +data CreatePaymentError = CreatePaymentError + { _createPaymentError_name :: Maybe Text + , _createPaymentError_cost :: Maybe Text + , _createPaymentError_date :: Maybe Text + , _createPaymentError_category :: Maybe Text + , _createPaymentError_frequency :: Maybe Text + } deriving (Show, Generic) + +instance FromJSON CreatePaymentError +instance ToJSON CreatePaymentError + data CreatePayment = CreatePayment { _createPayment_name :: Text , _createPayment_cost :: Int -- cgit v1.2.3 From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 30 Oct 2018 18:04:58 +0100 Subject: Update table when adding or removing a payment --- common/src/Common/Util/Time.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Util/Time.hs b/common/src/Common/Util/Time.hs index 9ab7ab5..6240720 100644 --- a/common/src/Common/Util/Time.hs +++ b/common/src/Common/Util/Time.hs @@ -16,9 +16,9 @@ timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time parseDay :: Text -> Maybe Day parseDay str = do - (d, m, y) <- - case T.splitOn str "/" of - [d, m, y] -> Just (d, m, y) + (y, m, d) <- + case T.splitOn "-" str of + [y, m, d] -> Just (y, m, d) _ -> Nothing d' <- T.readMaybe . T.unpack $ d m' <- T.readMaybe . T.unpack $ m -- cgit v1.2.3 From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 1 Nov 2018 13:14:25 +0100 Subject: Implementing client side validation --- common/src/Common/Message/Key.hs | 1 + common/src/Common/Message/Translation.hs | 9 ++++-- common/src/Common/Model.hs | 3 +- common/src/Common/Model/Email.hs | 12 ++++++++ common/src/Common/Model/SignIn.hs | 14 ---------- common/src/Common/Model/SignInForm.hs | 14 ++++++++++ common/src/Common/Util/Validation.hs | 13 +++++++++ common/src/Common/Validation/Atomic.hs | 47 ++++++++++++++++++++++++++++++++ common/src/Common/Validation/Payment.hs | 21 ++++++++++++++ common/src/Common/Validation/SignIn.hs | 19 +++++++++++++ 10 files changed, 136 insertions(+), 17 deletions(-) create mode 100644 common/src/Common/Model/Email.hs delete mode 100644 common/src/Common/Model/SignIn.hs create mode 100644 common/src/Common/Model/SignInForm.hs create mode 100644 common/src/Common/Util/Validation.hs create mode 100644 common/src/Common/Validation/Atomic.hs create mode 100644 common/src/Common/Validation/Payment.hs create mode 100644 common/src/Common/Validation/SignIn.hs (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 6e5f246..4acba93 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -39,6 +39,7 @@ data Key = | Form_AlreadyExists | Form_NonEmpty + | Form_MinChars Int | Form_NonNullNumber | Form_GreaterIntThan Int | Form_InvalidCategory diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 70eb978..e95fa74 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -162,6 +162,11 @@ m l Form_NonEmpty = English -> "Required field" French -> "Champ requis" +m l (Form_MinChars number) = + case l of + English -> T.concat [ "This field must contains at least ", T.pack . show $ number, " characters" ] + French -> T.concat [ "Ce champ doit contenir au moins ", T.pack . show $ number, " caractères" ] + m l Form_NonNullNumber = case l of English -> "Number must not be null" @@ -184,8 +189,8 @@ m l Form_InvalidColor = m l Form_InvalidDate = case l of - English -> "day/month/year required" - French -> "jour/mois/année requis" + English -> "DD/MM/YYYY required" + French -> "JJ/MM/AAAA requis" m l Form_InvalidInt = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index cb38b2f..b0e0491 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -8,6 +8,7 @@ import Common.Model.Currency as X import Common.Model.EditCategory as X import Common.Model.EditIncome as X import Common.Model.EditPayment as X +import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X import Common.Model.Init as X @@ -15,5 +16,5 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X -import Common.Model.SignIn as X +import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/Email.hs b/common/src/Common/Model/Email.hs new file mode 100644 index 0000000..e938f83 --- /dev/null +++ b/common/src/Common/Model/Email.hs @@ -0,0 +1,12 @@ +module Common.Model.Email + ( Email(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Email = Email Text deriving (Show, Generic) + +instance FromJSON Email +instance ToJSON Email diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs deleted file mode 100644 index bfd7fbc..0000000 --- a/common/src/Common/Model/SignIn.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.SignIn - ( SignIn(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -data SignIn = SignIn - { _signIn_email :: Text - } deriving (Show, Generic) - -instance FromJSON SignIn -instance ToJSON SignIn diff --git a/common/src/Common/Model/SignInForm.hs b/common/src/Common/Model/SignInForm.hs new file mode 100644 index 0000000..2b8c955 --- /dev/null +++ b/common/src/Common/Model/SignInForm.hs @@ -0,0 +1,14 @@ +module Common.Model.SignInForm + ( SignInForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SignInForm = SignInForm + { _signIn_email :: Text + } deriving (Show, Generic) + +instance FromJSON SignInForm +instance ToJSON SignInForm diff --git a/common/src/Common/Util/Validation.hs b/common/src/Common/Util/Validation.hs new file mode 100644 index 0000000..f195d95 --- /dev/null +++ b/common/src/Common/Util/Validation.hs @@ -0,0 +1,13 @@ +module Common.Util.Validation + ( isSuccess + , isFailure + ) where + +import Data.Validation (Validation (Failure, Success)) + +isSuccess :: forall a b. Validation a b -> Bool +isSuccess (Failure _) = False +isSuccess (Success _) = True + +isFailure :: forall a b. Validation a b -> Bool +isFailure = not . isSuccess diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs new file mode 100644 index 0000000..3516668 --- /dev/null +++ b/common/src/Common/Validation/Atomic.hs @@ -0,0 +1,47 @@ +module Common.Validation.Atomic + ( nonEmpty + , minLength + , number + , nonNullNumber + , day + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V +import qualified Text.Read as T + +import qualified Common.Msg as Msg +import qualified Common.Util.Time as Time + +minLength :: Int -> Text -> Validation Text Text +minLength l = + V.validate + (Msg.get (Msg.Form_MinChars l)) + (\t -> if T.length t >= l then Just t else Nothing) + +nonEmpty :: Text -> Validation Text Text +nonEmpty = + V.validate + (Msg.get Msg.Form_NonEmpty) + (\t -> if (not . T.null $ t) then Just t else Nothing) + +number :: Text -> Validation Text Int +number input = + case (T.readMaybe . T.unpack $ input) of + Just n -> V.Success n + _ -> V.Failure (Msg.get Msg.Form_InvalidInt) + +nonNullNumber :: Int -> Validation Text Int +nonNullNumber = + V.validate + (Msg.get Msg.Form_NonNullNumber) + (\n -> if n /= 0 then Just n else Nothing) + +day :: Text -> Validation Text Day +day str = + case Time.parseDay str of + Just d -> V.Success d + Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs new file mode 100644 index 0000000..b6c1d30 --- /dev/null +++ b/common/src/Common/Validation/Payment.hs @@ -0,0 +1,21 @@ +module Common.Validation.Payment + ( name + , cost + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as Validation + +import qualified Common.Validation.Atomic as Atomic + +name :: Text -> Validation Text Text +name = Atomic.nonEmpty + +cost :: Text -> Validation Text Int +cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs new file mode 100644 index 0000000..18ceb44 --- /dev/null +++ b/common/src/Common/Validation/SignIn.hs @@ -0,0 +1,19 @@ +module Common.Validation.SignIn + ( signIn + , email + ) where + +import Data.Text (Text) +import Data.Validation (Validation) + +import Common.Model.Email (Email (..)) +import Common.Model.SignInForm (SignInForm (..)) +import qualified Common.Validation.Atomic as Atomic +import qualified Data.Validation as Validation + +signIn :: SignInForm -> Maybe Email +signIn (SignInForm str) = + Validation.validation (const Nothing) Just . email $ str + +email :: Text -> Validation Text Email +email = fmap Email . Atomic.minLength 5 -- cgit v1.2.3 From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 5 Aug 2019 21:53:30 +0200 Subject: Use updated payment categories from payment add in payment’s table --- common/src/Common/Model.hs | 1 + common/src/Common/Model/CreatedPayment.hs | 17 +++++++++++++++++ 2 files changed, 18 insertions(+) create mode 100644 common/src/Common/Model/CreatedPayment.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index b0e0491..64db890 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -2,6 +2,7 @@ module Common.Model (module X) where import Common.Model.Category as X import Common.Model.CreateCategory as X +import Common.Model.CreatedPayment as X import Common.Model.CreateIncome as X import Common.Model.CreatePayment as X import Common.Model.Currency as X diff --git a/common/src/Common/Model/CreatedPayment.hs b/common/src/Common/Model/CreatedPayment.hs new file mode 100644 index 0000000..c1bba29 --- /dev/null +++ b/common/src/Common/Model/CreatedPayment.hs @@ -0,0 +1,17 @@ +module Common.Model.CreatedPayment + ( CreatedPayment(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) + +data CreatedPayment = CreatedPayment + { _createdPayment_payment :: Payment + , _createdPayment_paymentCategory :: PaymentCategory + } deriving (Show, Generic) + +instance FromJSON CreatedPayment +instance ToJSON CreatedPayment -- cgit v1.2.3 From fc8be14dd0089eb12b78af7aaaecd8ed57896677 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 7 Aug 2019 21:27:59 +0200 Subject: Update category according to payment in add overlay --- common/src/Common/Util/Text.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs index b49fc55..d7f1db4 100644 --- a/common/src/Common/Util/Text.hs +++ b/common/src/Common/Util/Text.hs @@ -1,15 +1,16 @@ module Common.Util.Text ( search - , unaccent + , formatSearch ) where import Data.Text (Text) import qualified Data.Text as T search :: Text -> Text -> Bool -search s t = - (format s) `T.isInfixOf` (format t) - where format = T.toLower . unaccent +search s t = (formatSearch s) `T.isInfixOf` (formatSearch t) + +formatSearch :: Text -> Text +formatSearch = T.toLower . unaccent unaccent :: Text -> Text unaccent = T.map unaccentChar -- cgit v1.2.3 From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 8 Aug 2019 21:28:22 +0200 Subject: Finish payment add modal --- common/src/Common/Message/Translation.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index e95fa74..4eb0523 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -189,8 +189,8 @@ m l Form_InvalidColor = m l Form_InvalidDate = case l of - English -> "DD/MM/YYYY required" - French -> "JJ/MM/AAAA requis" + English -> "Date required" + French -> "Date requise" m l Form_InvalidInt = case l of -- cgit v1.2.3 From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 10 Aug 2019 14:53:41 +0200 Subject: Remove payment category if unused after a payment is deleted --- common/src/Common/Message/Key.hs | 1 - common/src/Common/Message/Translation.hs | 5 ----- 2 files changed, 6 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 4acba93..e460d3e 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -64,7 +64,6 @@ data Key = | Income_Edit | Income_Empty | Income_MonthlyNet - | Income_NotDeleted | Income_Title | Month_January diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 4eb0523..6b9e7be 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -277,11 +277,6 @@ m l Income_MonthlyNet = English -> "Net monthly incomes" French -> "Revenus mensuels nets" -m l Income_NotDeleted = - case l of - English -> "The income could not have been deleted." - French -> "Le revenu n’a pas pu être supprimé." - m l Income_Title = case l of English -> "Income" -- cgit v1.2.3 From 2d79ab0e0a11f55255fc21a5dfab1598d3beeba3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 11 Aug 2019 22:40:09 +0200 Subject: Add payment clone --- common/src/Common/Model.hs | 2 +- common/src/Common/Model/CreatedPayment.hs | 17 ----------------- common/src/Common/Model/EditPayment.hs | 3 ++- common/src/Common/Model/SavedPayment.hs | 17 +++++++++++++++++ 4 files changed, 20 insertions(+), 19 deletions(-) delete mode 100644 common/src/Common/Model/CreatedPayment.hs create mode 100644 common/src/Common/Model/SavedPayment.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 64db890..1abc3e3 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -2,7 +2,6 @@ module Common.Model (module X) where import Common.Model.Category as X import Common.Model.CreateCategory as X -import Common.Model.CreatedPayment as X import Common.Model.CreateIncome as X import Common.Model.CreatePayment as X import Common.Model.Currency as X @@ -17,5 +16,6 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X +import Common.Model.SavedPayment as X import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/CreatedPayment.hs b/common/src/Common/Model/CreatedPayment.hs deleted file mode 100644 index c1bba29..0000000 --- a/common/src/Common/Model/CreatedPayment.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Common.Model.CreatedPayment - ( CreatedPayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) - -data CreatedPayment = CreatedPayment - { _createdPayment_payment :: Payment - , _createdPayment_paymentCategory :: PaymentCategory - } deriving (Show, Generic) - -instance FromJSON CreatedPayment -instance ToJSON CreatedPayment diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index d2c223f..8860b84 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -2,7 +2,7 @@ module Common.Model.EditPayment ( EditPayment(..) ) where -import Data.Aeson (FromJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Data.Time.Calendar (Day) import GHC.Generics (Generic) @@ -21,3 +21,4 @@ data EditPayment = EditPayment } deriving (Show, Generic) instance FromJSON EditPayment +instance ToJSON EditPayment diff --git a/common/src/Common/Model/SavedPayment.hs b/common/src/Common/Model/SavedPayment.hs new file mode 100644 index 0000000..f45c479 --- /dev/null +++ b/common/src/Common/Model/SavedPayment.hs @@ -0,0 +1,17 @@ +module Common.Model.SavedPayment + ( SavedPayment(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) + +data SavedPayment = SavedPayment + { _savedPayment_payment :: Payment + , _savedPayment_paymentCategory :: PaymentCategory + } deriving (Show, Generic) + +instance FromJSON SavedPayment +instance ToJSON SavedPayment -- cgit v1.2.3 From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 9 Oct 2019 23:16:00 +0200 Subject: Use common payment validation in the backend Remove deprecated backend validation --- common/src/Common/Model.hs | 38 ++++++++++++++-------------- common/src/Common/Model/CreatePayment.hs | 34 ------------------------- common/src/Common/Model/CreatePaymentForm.hs | 21 +++++++++++++++ common/src/Common/Model/EditPayment.hs | 24 ------------------ common/src/Common/Model/EditPaymentForm.hs | 23 +++++++++++++++++ common/src/Common/Validation/Payment.hs | 15 +++++++++-- 6 files changed, 76 insertions(+), 79 deletions(-) delete mode 100644 common/src/Common/Model/CreatePayment.hs create mode 100644 common/src/Common/Model/CreatePaymentForm.hs delete mode 100644 common/src/Common/Model/EditPayment.hs create mode 100644 common/src/Common/Model/EditPaymentForm.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 1abc3e3..5b71a84 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -1,21 +1,21 @@ module Common.Model (module X) where -import Common.Model.Category as X -import Common.Model.CreateCategory as X -import Common.Model.CreateIncome as X -import Common.Model.CreatePayment as X -import Common.Model.Currency as X -import Common.Model.EditCategory as X -import Common.Model.EditIncome as X -import Common.Model.EditPayment as X -import Common.Model.Email as X -import Common.Model.Frequency as X -import Common.Model.Income as X -import Common.Model.Init as X -import Common.Model.InitResult as X -import Common.Model.Payer as X -import Common.Model.Payment as X -import Common.Model.PaymentCategory as X -import Common.Model.SavedPayment as X -import Common.Model.SignInForm as X -import Common.Model.User as X +import Common.Model.Category as X +import Common.Model.CreateCategory as X +import Common.Model.CreateIncome as X +import Common.Model.CreatePaymentForm as X +import Common.Model.Currency as X +import Common.Model.EditCategory as X +import Common.Model.EditIncome as X +import Common.Model.EditPaymentForm as X +import Common.Model.Email as X +import Common.Model.Frequency as X +import Common.Model.Income as X +import Common.Model.Init as X +import Common.Model.InitResult as X +import Common.Model.Payer as X +import Common.Model.Payment as X +import Common.Model.PaymentCategory as X +import Common.Model.SavedPayment as X +import Common.Model.SignInForm as X +import Common.Model.User as X diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs deleted file mode 100644 index c61423c..0000000 --- a/common/src/Common/Model/CreatePayment.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Common.Model.CreatePayment - ( CreatePaymentError(..) - , CreatePayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) - -data CreatePaymentError = CreatePaymentError - { _createPaymentError_name :: Maybe Text - , _createPaymentError_cost :: Maybe Text - , _createPaymentError_date :: Maybe Text - , _createPaymentError_category :: Maybe Text - , _createPaymentError_frequency :: Maybe Text - } deriving (Show, Generic) - -instance FromJSON CreatePaymentError -instance ToJSON CreatePaymentError - -data CreatePayment = CreatePayment - { _createPayment_name :: Text - , _createPayment_cost :: Int - , _createPayment_date :: Day - , _createPayment_category :: CategoryId - , _createPayment_frequency :: Frequency - } deriving (Show, Generic) - -instance FromJSON CreatePayment -instance ToJSON CreatePayment diff --git a/common/src/Common/Model/CreatePaymentForm.hs b/common/src/Common/Model/CreatePaymentForm.hs new file mode 100644 index 0000000..60c5423 --- /dev/null +++ b/common/src/Common/Model/CreatePaymentForm.hs @@ -0,0 +1,21 @@ +module Common.Model.CreatePaymentForm + ( CreatePaymentForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) + +data CreatePaymentForm = CreatePaymentForm + { _createPaymentForm_name :: Text + , _createPaymentForm_cost :: Text + , _createPaymentForm_date :: Text + , _createPaymentForm_category :: CategoryId + , _createPaymentForm_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON CreatePaymentForm +instance ToJSON CreatePaymentForm diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs deleted file mode 100644 index 8860b84..0000000 --- a/common/src/Common/Model/EditPayment.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Common.Model.EditPayment - ( EditPayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) -import Common.Model.Payment (PaymentId) - -data EditPayment = EditPayment - { _editPayment_id :: PaymentId - , _editPayment_name :: Text - , _editPayment_cost :: Int - , _editPayment_date :: Day - , _editPayment_category :: CategoryId - , _editPayment_frequency :: Frequency - } deriving (Show, Generic) - -instance FromJSON EditPayment -instance ToJSON EditPayment diff --git a/common/src/Common/Model/EditPaymentForm.hs b/common/src/Common/Model/EditPaymentForm.hs new file mode 100644 index 0000000..168c9ff --- /dev/null +++ b/common/src/Common/Model/EditPaymentForm.hs @@ -0,0 +1,23 @@ +module Common.Model.EditPaymentForm + ( EditPaymentForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) + +data EditPaymentForm = EditPaymentForm + { _editPaymentForm_id :: PaymentId + , _editPaymentForm_name :: Text + , _editPaymentForm_cost :: Text + , _editPaymentForm_date :: Text + , _editPaymentForm_category :: CategoryId + , _editPaymentForm_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON EditPaymentForm +instance ToJSON EditPaymentForm diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs index b6c1d30..1bb00ce 100644 --- a/common/src/Common/Validation/Payment.hs +++ b/common/src/Common/Validation/Payment.hs @@ -2,20 +2,31 @@ module Common.Validation.Payment ( name , cost , date + , category ) where import Data.Text (Text) import Data.Time.Calendar (Day) import Data.Validation (Validation) -import qualified Data.Validation as Validation +import qualified Data.Validation as V +import Common.Model (CategoryId) +import qualified Common.Msg as Msg import qualified Common.Validation.Atomic as Atomic + name :: Text -> Validation Text Text name = Atomic.nonEmpty cost :: Text -> Validation Text Int -cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber +cost input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber date :: Text -> Validation Text Day date = Atomic.day + +category :: [CategoryId] -> CategoryId -> Validation Text CategoryId +category cs c = + if elem c cs then + V.Success c + else + V.Failure $ Msg.get Msg.Form_InvalidCategory -- cgit v1.2.3 From 52331eeadce8d250564851c25fc965172640bc55 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 12 Oct 2019 11:23:10 +0200 Subject: Implement client routing --- common/src/Common/Message/Key.hs | 3 +++ common/src/Common/Message/Translation.hs | 10 ++++++++++ 2 files changed, 13 insertions(+) (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index e460d3e..c2fde58 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -150,3 +150,6 @@ data Key = | WeeklyReport_PaymentDeleted Int | WeeklyReport_PaymentEdited Int | WeeklyReport_Title + + | NotFound_Message + | NotFound_LinkMessage diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 6b9e7be..3173561 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -693,3 +693,13 @@ m l WeeklyReport_Title = case l of English -> "Weekly report" French -> "Rapport hebdomadaire" + +m l NotFound_Message = + case l of + English -> "There is nothing here!" + French -> "Vous vous êtes perdu." + +m l NotFound_LinkMessage = + case l of + English -> "Go back to the home page." + French -> "Retour à l’accueil." -- cgit v1.2.3 From 04c59f08f100ba6a0658d1f2b357f7d8b1e14218 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 13 Oct 2019 22:38:35 +0200 Subject: Show income table --- common/src/Common/Message/Key.hs | 1 + common/src/Common/Message/Translation.hs | 9 +++++++-- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index c2fde58..2561156 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -56,6 +56,7 @@ data Key = | Income_AddLong | Income_AddShort + | Income_Name | Income_Amount | Income_Clone | Income_CumulativeSince Text diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 3173561..25e9f4b 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -237,10 +237,15 @@ m l Income_AddShort = English -> "Add" French -> "Ajouter" +m l Income_Name = + case l of + English -> "Name" + French -> "Nom" + m l Income_Amount = case l of - English -> "Amount" - French -> "Montant" + English -> "Income" + French -> "Revenu" m l Income_Clone = case l of -- cgit v1.2.3 From 284214d3af39143fdbeca57ffa4864389e7d517a Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 14 Oct 2019 09:10:33 +0200 Subject: Show cumulative incomes per user in income page --- common/src/Common/Model/Payer.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index d09dbf6..40228d5 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -1,6 +1,8 @@ module Common.Model.Payer - ( getExceedingPayers - , ExceedingPayer(..) + ( ExceedingPayer(..) + , getExceedingPayers + , useIncomesFrom + , cumulativeIncomesSince ) where import qualified Data.List as List -- cgit v1.2.3 From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 12:02:21 +0200 Subject: Add income --- common/src/Common/Model.hs | 3 ++- common/src/Common/Model/CreateIncome.hs | 14 -------------- common/src/Common/Model/CreateIncomeForm.hs | 15 +++++++++++++++ common/src/Common/Model/EditIncomeForm.hs | 18 ++++++++++++++++++ common/src/Common/Validation/Income.hs | 17 +++++++++++++++++ common/src/Common/Validation/Payment.hs | 1 - 6 files changed, 52 insertions(+), 16 deletions(-) delete mode 100644 common/src/Common/Model/CreateIncome.hs create mode 100644 common/src/Common/Model/CreateIncomeForm.hs create mode 100644 common/src/Common/Model/EditIncomeForm.hs create mode 100644 common/src/Common/Validation/Income.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 5b71a84..c9f500b 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -2,11 +2,12 @@ module Common.Model (module X) where import Common.Model.Category as X import Common.Model.CreateCategory as X -import Common.Model.CreateIncome as X +import Common.Model.CreateIncomeForm as X import Common.Model.CreatePaymentForm as X import Common.Model.Currency as X import Common.Model.EditCategory as X import Common.Model.EditIncome as X +import Common.Model.EditIncomeForm as X import Common.Model.EditPaymentForm as X import Common.Model.Email as X import Common.Model.Frequency as X diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs deleted file mode 100644 index 644a51c..0000000 --- a/common/src/Common/Model/CreateIncome.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.CreateIncome - ( CreateIncome(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -data CreateIncome = CreateIncome - { _createIncome_date :: Day - , _createIncome_amount :: Int - } deriving (Show, Generic) - -instance FromJSON CreateIncome diff --git a/common/src/Common/Model/CreateIncomeForm.hs b/common/src/Common/Model/CreateIncomeForm.hs new file mode 100644 index 0000000..e83bf0a --- /dev/null +++ b/common/src/Common/Model/CreateIncomeForm.hs @@ -0,0 +1,15 @@ +module Common.Model.CreateIncomeForm + ( CreateIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateIncomeForm = CreateIncomeForm + { _createIncomeForm_amount :: Text + , _createIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON CreateIncomeForm +instance ToJSON CreateIncomeForm diff --git a/common/src/Common/Model/EditIncomeForm.hs b/common/src/Common/Model/EditIncomeForm.hs new file mode 100644 index 0000000..ff975fc --- /dev/null +++ b/common/src/Common/Model/EditIncomeForm.hs @@ -0,0 +1,18 @@ +module Common.Model.EditIncomeForm + ( EditIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Income (IncomeId) + +data EditIncomeForm = EditIncomeForm + { _editIncomeForm_id :: IncomeId + , _editIncomeForm_amount :: Text + , _editIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON EditIncomeForm +instance ToJSON EditIncomeForm diff --git a/common/src/Common/Validation/Income.hs b/common/src/Common/Validation/Income.hs new file mode 100644 index 0000000..7a58bab --- /dev/null +++ b/common/src/Common/Validation/Income.hs @@ -0,0 +1,17 @@ +module Common.Validation.Income + ( amount + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V + +import qualified Common.Validation.Atomic as Atomic + +amount :: Text -> Validation Text Int +amount input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs index 1bb00ce..e3c447a 100644 --- a/common/src/Common/Validation/Payment.hs +++ b/common/src/Common/Validation/Payment.hs @@ -14,7 +14,6 @@ import Common.Model (CategoryId) import qualified Common.Msg as Msg import qualified Common.Validation.Atomic as Atomic - name :: Text -> Validation Text Text name = Atomic.nonEmpty -- cgit v1.2.3 From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 21:31:57 +0200 Subject: Load init data per page with AJAX --- common/src/Common/Model/Init.hs | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index 68b3f5d..5ef1535 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -2,24 +2,16 @@ module Common.Model.Init ( Init(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) -import Common.Model.Category (Category) -import Common.Model.Currency (Currency) -import Common.Model.Income (Income) -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) -import Common.Model.User (User, UserId) +import Common.Model.Currency (Currency) +import Common.Model.User (User, UserId) data Init = Init - { _init_users :: [User] - , _init_currentUser :: UserId - , _init_payments :: [Payment] - , _init_incomes :: [Income] - , _init_categories :: [Category] - , _init_paymentCategories :: [PaymentCategory] - , _init_currency :: Currency + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_currency :: Currency } deriving (Show, Generic) instance FromJSON Init -- cgit v1.2.3 From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Oct 2019 20:26:29 +0100 Subject: WIP Set up server side paging for incomes --- common/src/Common/Model.hs | 1 + common/src/Common/Model/IncomesAndCount.hs | 16 ++++++++++++++++ 2 files changed, 17 insertions(+) create mode 100644 common/src/Common/Model/IncomesAndCount.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index c9f500b..3a5a627 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -12,6 +12,7 @@ import Common.Model.EditPaymentForm as X import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X +import Common.Model.IncomesAndCount as X import Common.Model.Init as X import Common.Model.InitResult as X import Common.Model.Payer as X diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs new file mode 100644 index 0000000..4365180 --- /dev/null +++ b/common/src/Common/Model/IncomesAndCount.hs @@ -0,0 +1,16 @@ +module Common.Model.IncomesAndCount + ( IncomesAndCount(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Income (Income) + +data IncomesAndCount = IncomesAndCount + { _incomesAndCount_incomes :: [Income] + , _incomesAndCount_count :: Int + } deriving (Show, Generic) + +instance FromJSON IncomesAndCount +instance ToJSON IncomesAndCount -- cgit v1.2.3 From 9dbb4e6f7c2f0edc1126626e2ff498144c6b9947 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 11:28:42 +0100 Subject: Show income header --- common/src/Common/Model.hs | 3 ++- common/src/Common/Model/IncomeHeader.hs | 18 ++++++++++++++++++ common/src/Common/Model/IncomePage.hs | 18 ++++++++++++++++++ common/src/Common/Model/IncomesAndCount.hs | 16 ---------------- 4 files changed, 38 insertions(+), 17 deletions(-) create mode 100644 common/src/Common/Model/IncomeHeader.hs create mode 100644 common/src/Common/Model/IncomePage.hs delete mode 100644 common/src/Common/Model/IncomesAndCount.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 3a5a627..313f26b 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -12,7 +12,8 @@ import Common.Model.EditPaymentForm as X import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X -import Common.Model.IncomesAndCount as X +import Common.Model.IncomeHeader as X +import Common.Model.IncomePage as X import Common.Model.Init as X import Common.Model.InitResult as X import Common.Model.Payer as X diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs new file mode 100644 index 0000000..a1defdf --- /dev/null +++ b/common/src/Common/Model/IncomeHeader.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomeHeader + ( IncomeHeader(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Clock (UTCTime) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +data IncomeHeader = IncomeHeader + { _incomeHeader_since :: Maybe UTCTime + , _incomeHeader_byUser :: Map UserId Int + } deriving (Show, Generic) + +instance FromJSON IncomeHeader +instance ToJSON IncomeHeader diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs new file mode 100644 index 0000000..c3f478e --- /dev/null +++ b/common/src/Common/Model/IncomePage.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomePage + ( IncomePage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Income (Income) +import Common.Model.IncomeHeader (IncomeHeader) + +data IncomePage = IncomePage + { _incomePage_header :: IncomeHeader + , _incomePage_incomes :: [Income] + , _incomePage_totalCount :: Int + } deriving (Show, Generic) + +instance FromJSON IncomePage +instance ToJSON IncomePage diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs deleted file mode 100644 index 4365180..0000000 --- a/common/src/Common/Model/IncomesAndCount.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Common.Model.IncomesAndCount - ( IncomesAndCount(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Income (Income) - -data IncomesAndCount = IncomesAndCount - { _incomesAndCount_incomes :: [Income] - , _incomesAndCount_count :: Int - } deriving (Show, Generic) - -instance FromJSON IncomesAndCount -instance ToJSON IncomesAndCount -- cgit v1.2.3 From 0f85cbd8ee736b1996e3966bac1f5e47ed7d27a9 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 15:47:11 +0100 Subject: Fetch the first payment date instead of every payment to get cumulative income --- common/src/Common/Model/IncomeHeader.hs | 12 +++--- common/src/Common/Model/Payer.hs | 71 ++++++++++++++++++--------------- 2 files changed, 45 insertions(+), 38 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs index a1defdf..87c7aae 100644 --- a/common/src/Common/Model/IncomeHeader.hs +++ b/common/src/Common/Model/IncomeHeader.hs @@ -2,15 +2,15 @@ module Common.Model.IncomeHeader ( IncomeHeader(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Map (Map) -import Data.Time.Clock (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.User (UserId) +import Common.Model.User (UserId) data IncomeHeader = IncomeHeader - { _incomeHeader_since :: Maybe UTCTime + { _incomeHeader_since :: Maybe Day , _incomeHeader_byUser :: Map UserId Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index 40228d5..3c816c8 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -9,6 +9,7 @@ import qualified Data.List as List import qualified Data.Maybe as Maybe import Data.Time (NominalDiffTime, UTCTime (..)) import qualified Data.Time as Time +import Data.Time.Calendar (Day) import Common.Model.Income (Income (..)) import Common.Model.Payment (Payment (..)) @@ -36,10 +37,11 @@ data ExceedingPayer = ExceedingPayer getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] getExceedingPayers currentTime users incomes payments = let userIds = map _user_id users - payers = getPayers currentTime userIds incomes payments + payers = getPayers userIds incomes payments exceedingPayersOnPreIncome = exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers - mbSince = useIncomesFrom userIds incomes payments + firstPayment = safeHead . List.sort . map _payment_date $ payments + mbSince = useIncomesFrom userIds incomes firstPayment in case mbSince of Just since -> let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers @@ -54,25 +56,30 @@ getExceedingPayers currentTime users incomes payments = _ -> exceedingPayersOnPreIncome -useIncomesFrom :: [UserId] -> [Income] -> [Payment] -> Maybe UTCTime -useIncomesFrom userIds incomes payments = - let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments - mbIncomeTime = incomeDefinedForAll userIds incomes - in case (firstPaymentTime, mbIncomeTime) of - (Just t1, Just t2) -> Just (max t1 t2) - _ -> Nothing +useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day +useIncomesFrom userIds incomes firstPayment = + case (firstPayment, incomeDefinedForAll userIds incomes) of + (Just d1, Just d2) -> Just (max d1 d2) + _ -> Nothing -paymentTime :: Payment -> UTCTime -paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date +dayUTCTime :: Day -> UTCTime +dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0) -getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer] -getPayers currentTime userIds incomes payments = +getPayers :: [UserId] -> [Income] -> [Payment] -> [Payer] +getPayers userIds incomes payments = let incomesDefined = incomeDefinedForAll userIds incomes in flip map userIds (\userId -> Payer { _payer_userId = userId , _payer_preIncomePayments = totalPayments - (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined)) + (\p -> + case incomesDefined of + Just d -> + _payment_date p < d + + Nothing -> + True + ) userId payments , _payer_postIncomePayments = @@ -80,7 +87,7 @@ getPayers currentTime userIds incomes payments = (\p -> case incomesDefined of Nothing -> False - Just t -> paymentTime p >= t + Just t -> _payment_date p >= t ) userId payments @@ -104,7 +111,7 @@ exceedingPayersFromAmounts userAmounts = $ userAmounts where mbMinAmount = safeMinimum . map snd $ userAmounts -getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer +getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer getPostPaymentPayer currentTime since payer = PostPaymentPayer { _postPaymentPayer_userId = _payer_userId payer @@ -120,35 +127,35 @@ getFinalDiff maxRatio payer = truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) in postIncomeDiff + _postPaymentPayer_preIncomePayments payer -incomeDefinedForAll :: [UserId] -> [Income] -> Maybe UTCTime +incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day incomeDefinedForAll userIds incomes = let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds - firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes + firstIncomes = map (safeHead . List.sortOn _income_date) userIncomes in if all Maybe.isJust firstIncomes - then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes + then safeHead . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes else Nothing -cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int +cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int cumulativeIncomesSince currentTime since incomes = getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) -getOrderedIncomesSince :: UTCTime -> [Income] -> [Income] -getOrderedIncomesSince time incomes = - let mbStarterIncome = getIncomeAt time incomes - orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes +getOrderedIncomesSince :: Day -> [Income] -> [Income] +getOrderedIncomesSince since incomes = + let mbStarterIncome = getIncomeAt since incomes + orderedIncomesSince = filter (\income -> _income_date income >= since) incomes in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince -getIncomeAt :: UTCTime -> [Income] -> Maybe Income -getIncomeAt time incomes = +getIncomeAt :: Day -> [Income] -> Maybe Income +getIncomeAt day incomes = case incomes of [x] -> - if incomeTime x < time - then Just $ x { _income_date = utctDay time } + if _income_date x < day + then Just $ x { _income_date = day } else Nothing x1 : x2 : xs -> - if incomeTime x1 < time && incomeTime x2 >= time - then Just $ x1 { _income_date = utctDay time } - else getIncomeAt time (x2 : xs) + if _income_date x1 < day && _income_date x2 >= day + then Just $ x1 { _income_date = day } + else getIncomeAt day (x2 : xs) [] -> Nothing @@ -171,7 +178,7 @@ getIncomesWithDuration currentTime incomes = (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) incomeTime :: Income -> UTCTime -incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date +incomeTime = dayUTCTime . _income_date durationIncome :: (NominalDiffTime, Int) -> Int durationIncome (duration, income) = -- cgit v1.2.3 From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 6 Nov 2019 19:44:15 +0100 Subject: Show the payment table with server side paging --- common/src/Common/Model.hs | 1 + common/src/Common/Model/PaymentPage.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+) create mode 100644 common/src/Common/Model/PaymentPage.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 313f26b..bc626d5 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -19,6 +19,7 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X +import Common.Model.PaymentPage as X import Common.Model.SavedPayment as X import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs new file mode 100644 index 0000000..31039c7 --- /dev/null +++ b/common/src/Common/Model/PaymentPage.hs @@ -0,0 +1,18 @@ +module Common.Model.PaymentPage + ( PaymentPage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) + +data PaymentPage = PaymentPage + { _paymentPage_payments :: [Payment] + , _paymentPage_paymentCategories :: [PaymentCategory] + , _paymentPage_totalCount :: Int + } deriving (Show, Generic) + +instance FromJSON PaymentPage +instance ToJSON PaymentPage -- cgit v1.2.3 From 4dc84dbda7ba3ea60d13e6f81eeec556974b7c72 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 7 Nov 2019 07:59:41 +0100 Subject: Show payment header infos --- common/src/Common/Model.hs | 2 ++ common/src/Common/Model/ExceedingPayer.hs | 16 ++++++++++++++++ common/src/Common/Model/Payer.hs | 25 ++++++++++--------------- common/src/Common/Model/PaymentHeader.hs | 18 ++++++++++++++++++ common/src/Common/Model/PaymentPage.hs | 4 +++- 5 files changed, 49 insertions(+), 16 deletions(-) create mode 100644 common/src/Common/Model/ExceedingPayer.hs create mode 100644 common/src/Common/Model/PaymentHeader.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index bc626d5..fdeac36 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -10,6 +10,7 @@ import Common.Model.EditIncome as X import Common.Model.EditIncomeForm as X import Common.Model.EditPaymentForm as X import Common.Model.Email as X +import Common.Model.ExceedingPayer as X import Common.Model.Frequency as X import Common.Model.Income as X import Common.Model.IncomeHeader as X @@ -19,6 +20,7 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X +import Common.Model.PaymentHeader as X import Common.Model.PaymentPage as X import Common.Model.SavedPayment as X import Common.Model.SignInForm as X diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs new file mode 100644 index 0000000..171b6ff --- /dev/null +++ b/common/src/Common/Model/ExceedingPayer.hs @@ -0,0 +1,16 @@ +module Common.Model.ExceedingPayer + ( ExceedingPayer(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +data ExceedingPayer = ExceedingPayer + { _exceedingPayer_userId :: UserId + , _exceedingPayer_amount :: Int + } deriving (Show, Generic) + +instance FromJSON ExceedingPayer +instance ToJSON ExceedingPayer diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index 3c816c8..39a5788 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -1,19 +1,19 @@ module Common.Model.Payer - ( ExceedingPayer(..) - , getExceedingPayers + ( getExceedingPayers , useIncomesFrom , cumulativeIncomesSince ) where -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import Data.Time (NominalDiffTime, UTCTime (..)) -import qualified Data.Time as Time -import Data.Time.Calendar (Day) +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import Data.Time (NominalDiffTime, UTCTime (..)) +import qualified Data.Time as Time +import Data.Time.Calendar (Day) -import Common.Model.Income (Income (..)) -import Common.Model.Payment (Payment (..)) -import Common.Model.User (User (..), UserId) +import Common.Model.ExceedingPayer (ExceedingPayer (..)) +import Common.Model.Income (Income (..)) +import Common.Model.Payment (Payment (..)) +import Common.Model.User (User (..), UserId) data Payer = Payer { _payer_userId :: UserId @@ -29,11 +29,6 @@ data PostPaymentPayer = PostPaymentPayer , _postPaymentPayer_ratio :: Float } -data ExceedingPayer = ExceedingPayer - { _exceedingPayer_userId :: UserId - , _exceedingPayer_amount :: Int - } deriving (Show) - getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] getExceedingPayers currentTime users incomes payments = let userIds = map _user_id users diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs new file mode 100644 index 0000000..a522cd8 --- /dev/null +++ b/common/src/Common/Model/PaymentHeader.hs @@ -0,0 +1,18 @@ +module Common.Model.PaymentHeader + ( PaymentHeader(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import GHC.Generics (Generic) + +import Common.Model.ExceedingPayer (ExceedingPayer) +import Common.Model.User (UserId) + +data PaymentHeader = PaymentHeader + { _paymentHeader_exceedingPayers :: [ExceedingPayer] + , _paymentHeader_repartition :: Map UserId Int + } deriving (Show, Generic) + +instance FromJSON PaymentHeader +instance ToJSON PaymentHeader diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 31039c7..76c7511 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -7,9 +7,11 @@ import GHC.Generics (Generic) import Common.Model.Payment (Payment) import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.PaymentHeader (PaymentHeader) data PaymentPage = PaymentPage - { _paymentPage_payments :: [Payment] + { _paymentPage_header :: PaymentHeader + , _paymentPage_payments :: [Payment] , _paymentPage_paymentCategories :: [PaymentCategory] , _paymentPage_totalCount :: Int } deriving (Show, Generic) -- cgit v1.2.3 From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- common/src/Common/Message/Translation.hs | 2 +- common/src/Common/Model.hs | 3 - common/src/Common/Model/Payer.hs | 202 ----------------------------- common/src/Common/Model/Payment.hs | 2 + common/src/Common/Model/PaymentCategory.hs | 25 ---- common/src/Common/Model/PaymentPage.hs | 17 ++- common/src/Common/Model/SavedPayment.hs | 17 --- common/src/Common/Util/Text.hs | 1 + 8 files changed, 12 insertions(+), 257 deletions(-) delete mode 100644 common/src/Common/Model/Payer.hs delete mode 100644 common/src/Common/Model/PaymentCategory.hs delete mode 100644 common/src/Common/Model/SavedPayment.hs (limited to 'common/src') diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 25e9f4b..a86a371 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -702,7 +702,7 @@ m l WeeklyReport_Title = m l NotFound_Message = case l of English -> "There is nothing here!" - French -> "Vous vous êtes perdu." + French -> "Il n’y a rien à voir ici." m l NotFound_LinkMessage = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index fdeac36..00d30f6 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -17,11 +17,8 @@ import Common.Model.IncomeHeader as X import Common.Model.IncomePage as X import Common.Model.Init as X import Common.Model.InitResult as X -import Common.Model.Payer as X import Common.Model.Payment as X -import Common.Model.PaymentCategory as X import Common.Model.PaymentHeader as X import Common.Model.PaymentPage as X -import Common.Model.SavedPayment as X import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs deleted file mode 100644 index 39a5788..0000000 --- a/common/src/Common/Model/Payer.hs +++ /dev/null @@ -1,202 +0,0 @@ -module Common.Model.Payer - ( getExceedingPayers - , useIncomesFrom - , cumulativeIncomesSince - ) where - -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import Data.Time (NominalDiffTime, UTCTime (..)) -import qualified Data.Time as Time -import Data.Time.Calendar (Day) - -import Common.Model.ExceedingPayer (ExceedingPayer (..)) -import Common.Model.Income (Income (..)) -import Common.Model.Payment (Payment (..)) -import Common.Model.User (User (..), UserId) - -data Payer = Payer - { _payer_userId :: UserId - , _payer_preIncomePayments :: Int - , _payer_postIncomePayments :: Int - , _payer_incomes :: [Income] - } - -data PostPaymentPayer = PostPaymentPayer - { _postPaymentPayer_userId :: UserId - , _postPaymentPayer_preIncomePayments :: Int - , _postPaymentPayer_cumulativeIncome :: Int - , _postPaymentPayer_ratio :: Float - } - -getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] -getExceedingPayers currentTime users incomes payments = - let userIds = map _user_id users - payers = getPayers userIds incomes payments - exceedingPayersOnPreIncome = - exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers - firstPayment = safeHead . List.sort . map _payment_date $ payments - mbSince = useIncomesFrom userIds incomes firstPayment - in case mbSince of - Just since -> - let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers - mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers - in case mbMaxRatio of - Just maxRatio -> - exceedingPayersFromAmounts - . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p)) - $ postPaymentPayers - Nothing -> - exceedingPayersOnPreIncome - _ -> - exceedingPayersOnPreIncome - -useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day -useIncomesFrom userIds incomes firstPayment = - case (firstPayment, incomeDefinedForAll userIds incomes) of - (Just d1, Just d2) -> Just (max d1 d2) - _ -> Nothing - -dayUTCTime :: Day -> UTCTime -dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0) - -getPayers :: [UserId] -> [Income] -> [Payment] -> [Payer] -getPayers userIds incomes payments = - let incomesDefined = incomeDefinedForAll userIds incomes - in flip map userIds (\userId -> Payer - { _payer_userId = userId - , _payer_preIncomePayments = - totalPayments - (\p -> - case incomesDefined of - Just d -> - _payment_date p < d - - Nothing -> - True - ) - userId - payments - , _payer_postIncomePayments = - totalPayments - (\p -> - case incomesDefined of - Nothing -> False - Just t -> _payment_date p >= t - ) - userId - payments - , _payer_incomes = filter ((==) userId . _income_userId) incomes - } - ) - -exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer] -exceedingPayersFromAmounts userAmounts = - case mbMinAmount of - Nothing -> - [] - Just minAmount -> - filter (\payer -> _exceedingPayer_amount payer > 0) - . map (\userAmount -> - ExceedingPayer - { _exceedingPayer_userId = fst userAmount - , _exceedingPayer_amount = snd userAmount - minAmount - } - ) - $ userAmounts - where mbMinAmount = safeMinimum . map snd $ userAmounts - -getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer -getPostPaymentPayer currentTime since payer = - PostPaymentPayer - { _postPaymentPayer_userId = _payer_userId payer - , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer - , _postPaymentPayer_cumulativeIncome = cumulativeIncome - , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome) - } - where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer) - -getFinalDiff :: Float -> PostPaymentPayer -> Int -getFinalDiff maxRatio payer = - let postIncomeDiff = - truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) - in postIncomeDiff + _postPaymentPayer_preIncomePayments payer - -incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day -incomeDefinedForAll userIds incomes = - let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds - firstIncomes = map (safeHead . List.sortOn _income_date) userIncomes - in if all Maybe.isJust firstIncomes - then safeHead . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes - else Nothing - -cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int -cumulativeIncomesSince currentTime since incomes = - getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) - -getOrderedIncomesSince :: Day -> [Income] -> [Income] -getOrderedIncomesSince since incomes = - let mbStarterIncome = getIncomeAt since incomes - orderedIncomesSince = filter (\income -> _income_date income >= since) incomes - in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince - -getIncomeAt :: Day -> [Income] -> Maybe Income -getIncomeAt day incomes = - case incomes of - [x] -> - if _income_date x < day - then Just $ x { _income_date = day } - else Nothing - x1 : x2 : xs -> - if _income_date x1 < day && _income_date x2 >= day - then Just $ x1 { _income_date = day } - else getIncomeAt day (x2 : xs) - [] -> - Nothing - -getCumulativeIncome :: UTCTime -> [Income] -> Int -getCumulativeIncome currentTime incomes = - sum - . map durationIncome - . getIncomesWithDuration currentTime - . List.sortOn incomeTime - $ incomes - -getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)] -getIncomesWithDuration currentTime incomes = - case incomes of - [] -> - [] - [income] -> - [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)] - (income1 : income2 : xs) -> - (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) - -incomeTime :: Income -> UTCTime -incomeTime = dayUTCTime . _income_date - -durationIncome :: (NominalDiffTime, Int) -> Int -durationIncome (duration, income) = - truncate $ duration * fromIntegral income / (nominalDay * 365 / 12) - -nominalDay :: NominalDiffTime -nominalDay = 86400 - -safeHead :: [a] -> Maybe a -safeHead [] = Nothing -safeHead (x : _) = Just x - -safeMinimum :: (Ord a) => [a] -> Maybe a -safeMinimum [] = Nothing -safeMinimum xs = Just . minimum $ xs - -safeMaximum :: (Ord a) => [a] -> Maybe a -safeMaximum [] = Nothing -safeMaximum xs = Just . maximum $ xs - -totalPayments :: (Payment -> Bool) -> UserId -> [Payment] -> Int -totalPayments paymentFilter userId payments = - sum - . map _payment_cost - . filter (\payment -> paymentFilter payment && _payment_user payment == userId) - $ payments diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index 37a090d..c232fc7 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -10,6 +10,7 @@ import Data.Time (UTCTime) import Data.Time.Calendar (Day) import GHC.Generics (Generic) +import Common.Model.Category (CategoryId) import Common.Model.Frequency import Common.Model.User (UserId) @@ -21,6 +22,7 @@ data Payment = Payment , _payment_name :: Text , _payment_cost :: Int , _payment_date :: Day + , _payment_category :: CategoryId , _payment_frequency :: Frequency , _payment_createdAt :: UTCTime , _payment_editedAt :: Maybe UTCTime diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs deleted file mode 100644 index 2a559ce..0000000 --- a/common/src/Common/Model/PaymentCategory.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Common.Model.PaymentCategory - ( PaymentCategoryId - , PaymentCategory(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) - -type PaymentCategoryId = Int64 - -data PaymentCategory = PaymentCategory - { _paymentCategory_id :: PaymentCategoryId - , _paymentCategory_name :: Text - , _paymentCategory_category :: CategoryId - , _paymentCategory_createdAt :: UTCTime - , _paymentCategory_editedAt :: Maybe UTCTime - } deriving (Show, Generic) - -instance FromJSON PaymentCategory -instance ToJSON PaymentCategory diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 76c7511..3b18bb6 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -2,18 +2,17 @@ module Common.Model.PaymentPage ( PaymentPage(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) -import Common.Model.PaymentHeader (PaymentHeader) +import Common.Model.Payment (Payment) +import Common.Model.PaymentHeader (PaymentHeader) data PaymentPage = PaymentPage - { _paymentPage_header :: PaymentHeader - , _paymentPage_payments :: [Payment] - , _paymentPage_paymentCategories :: [PaymentCategory] - , _paymentPage_totalCount :: Int + { _paymentPage_page :: Int + , _paymentPage_header :: PaymentHeader + , _paymentPage_payments :: [Payment] + , _paymentPage_totalCount :: Int } deriving (Show, Generic) instance FromJSON PaymentPage diff --git a/common/src/Common/Model/SavedPayment.hs b/common/src/Common/Model/SavedPayment.hs deleted file mode 100644 index f45c479..0000000 --- a/common/src/Common/Model/SavedPayment.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Common.Model.SavedPayment - ( SavedPayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) - -data SavedPayment = SavedPayment - { _savedPayment_payment :: Payment - , _savedPayment_paymentCategory :: PaymentCategory - } deriving (Show, Generic) - -instance FromJSON SavedPayment -instance ToJSON SavedPayment diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs index d7f1db4..0f9c187 100644 --- a/common/src/Common/Util/Text.hs +++ b/common/src/Common/Util/Text.hs @@ -1,6 +1,7 @@ module Common.Util.Text ( search , formatSearch + , unaccent ) where import Data.Text (Text) -- cgit v1.2.3 From 3c67fcf1d524811a18f0c4db3ef6eed1270b9a12 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 19:55:22 +0100 Subject: Hide date from monthly payments --- common/src/Common/Model/PaymentPage.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'common/src') diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 3b18bb6..94203a2 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -5,11 +5,13 @@ module Common.Model.PaymentPage import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) +import Common.Model.Frequency (Frequency) import Common.Model.Payment (Payment) import Common.Model.PaymentHeader (PaymentHeader) data PaymentPage = PaymentPage { _paymentPage_page :: Int + , _paymentPage_frequency :: Frequency , _paymentPage_header :: PaymentHeader , _paymentPage_payments :: [Payment] , _paymentPage_totalCount :: Int -- cgit v1.2.3 From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 24 Nov 2019 16:19:53 +0100 Subject: Compute cumulative income with a DB query --- common/src/Common/Model/IncomePage.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'common/src') diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs index c3f478e..0572141 100644 --- a/common/src/Common/Model/IncomePage.hs +++ b/common/src/Common/Model/IncomePage.hs @@ -9,7 +9,8 @@ import Common.Model.Income (Income) import Common.Model.IncomeHeader (IncomeHeader) data IncomePage = IncomePage - { _incomePage_header :: IncomeHeader + { _incomePage_page :: Int + , _incomePage_header :: IncomeHeader , _incomePage_incomes :: [Income] , _incomePage_totalCount :: Int } deriving (Show, Generic) -- cgit v1.2.3 From e622e8fdd2e40b4306b5cc724d8dfb76bf976242 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 25 Nov 2019 08:17:59 +0100 Subject: Remove Loadable2 --- common/src/Common/Model/ExceedingPayer.hs | 2 +- common/src/Common/Model/Income.hs | 2 +- common/src/Common/Model/IncomeHeader.hs | 2 +- common/src/Common/Model/IncomePage.hs | 2 +- common/src/Common/Model/Payment.hs | 2 +- common/src/Common/Model/PaymentHeader.hs | 2 +- common/src/Common/Model/PaymentPage.hs | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs index 171b6ff..b7d3efb 100644 --- a/common/src/Common/Model/ExceedingPayer.hs +++ b/common/src/Common/Model/ExceedingPayer.hs @@ -10,7 +10,7 @@ import Common.Model.User (UserId) data ExceedingPayer = ExceedingPayer { _exceedingPayer_userId :: UserId , _exceedingPayer_amount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON ExceedingPayer instance ToJSON ExceedingPayer diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 0423704..57d07f1 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -21,7 +21,7 @@ data Income = Income , _income_createdAt :: UTCTime , _income_editedAt :: Maybe UTCTime , _income_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Income instance ToJSON Income diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs index 87c7aae..7e712e8 100644 --- a/common/src/Common/Model/IncomeHeader.hs +++ b/common/src/Common/Model/IncomeHeader.hs @@ -12,7 +12,7 @@ import Common.Model.User (UserId) data IncomeHeader = IncomeHeader { _incomeHeader_since :: Maybe Day , _incomeHeader_byUser :: Map UserId Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON IncomeHeader instance ToJSON IncomeHeader diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs index 0572141..977b0ea 100644 --- a/common/src/Common/Model/IncomePage.hs +++ b/common/src/Common/Model/IncomePage.hs @@ -13,7 +13,7 @@ data IncomePage = IncomePage , _incomePage_header :: IncomeHeader , _incomePage_incomes :: [Income] , _incomePage_totalCount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON IncomePage instance ToJSON IncomePage diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index c232fc7..733a145 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -27,7 +27,7 @@ data Payment = Payment , _payment_createdAt :: UTCTime , _payment_editedAt :: Maybe UTCTime , _payment_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Payment instance ToJSON Payment diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs index a522cd8..35f5e1a 100644 --- a/common/src/Common/Model/PaymentHeader.hs +++ b/common/src/Common/Model/PaymentHeader.hs @@ -12,7 +12,7 @@ import Common.Model.User (UserId) data PaymentHeader = PaymentHeader { _paymentHeader_exceedingPayers :: [ExceedingPayer] , _paymentHeader_repartition :: Map UserId Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON PaymentHeader instance ToJSON PaymentHeader diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 94203a2..88d9715 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -15,7 +15,7 @@ data PaymentPage = PaymentPage , _paymentPage_header :: PaymentHeader , _paymentPage_payments :: [Payment] , _paymentPage_totalCount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON PaymentPage instance ToJSON PaymentPage -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- common/src/Common/Model.hs | 45 ++++++++++++++------------- common/src/Common/Model/Category.hs | 2 +- common/src/Common/Model/CategoryPage.hs | 17 ++++++++++ common/src/Common/Model/CreateCategory.hs | 14 --------- common/src/Common/Model/CreateCategoryForm.hs | 15 +++++++++ common/src/Common/Model/EditCategory.hs | 17 ---------- common/src/Common/Model/EditCategoryForm.hs | 18 +++++++++++ common/src/Common/Validation/Atomic.hs | 5 +++ common/src/Common/Validation/Category.hs | 15 +++++++++ 9 files changed, 94 insertions(+), 54 deletions(-) create mode 100644 common/src/Common/Model/CategoryPage.hs delete mode 100644 common/src/Common/Model/CreateCategory.hs create mode 100644 common/src/Common/Model/CreateCategoryForm.hs delete mode 100644 common/src/Common/Model/EditCategory.hs create mode 100644 common/src/Common/Model/EditCategoryForm.hs create mode 100644 common/src/Common/Validation/Category.hs (limited to 'common/src') diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 00d30f6..73cbf6c 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -1,24 +1,25 @@ module Common.Model (module X) where -import Common.Model.Category as X -import Common.Model.CreateCategory as X -import Common.Model.CreateIncomeForm as X -import Common.Model.CreatePaymentForm as X -import Common.Model.Currency as X -import Common.Model.EditCategory as X -import Common.Model.EditIncome as X -import Common.Model.EditIncomeForm as X -import Common.Model.EditPaymentForm as X -import Common.Model.Email as X -import Common.Model.ExceedingPayer as X -import Common.Model.Frequency as X -import Common.Model.Income as X -import Common.Model.IncomeHeader as X -import Common.Model.IncomePage as X -import Common.Model.Init as X -import Common.Model.InitResult as X -import Common.Model.Payment as X -import Common.Model.PaymentHeader as X -import Common.Model.PaymentPage as X -import Common.Model.SignInForm as X -import Common.Model.User as X +import Common.Model.Category as X +import Common.Model.CategoryPage as X +import Common.Model.CreateCategoryForm as X +import Common.Model.CreateIncomeForm as X +import Common.Model.CreatePaymentForm as X +import Common.Model.Currency as X +import Common.Model.EditCategoryForm as X +import Common.Model.EditIncome as X +import Common.Model.EditIncomeForm as X +import Common.Model.EditPaymentForm as X +import Common.Model.Email as X +import Common.Model.ExceedingPayer as X +import Common.Model.Frequency as X +import Common.Model.Income as X +import Common.Model.IncomeHeader as X +import Common.Model.IncomePage as X +import Common.Model.Init as X +import Common.Model.InitResult as X +import Common.Model.Payment as X +import Common.Model.PaymentHeader as X +import Common.Model.PaymentPage as X +import Common.Model.SignInForm as X +import Common.Model.User as X diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index db1da53..cc3f795 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -18,7 +18,7 @@ data Category = Category , _category_createdAt :: UTCTime , _category_editedAt :: Maybe UTCTime , _category_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Category instance ToJSON Category diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs new file mode 100644 index 0000000..476b4ce --- /dev/null +++ b/common/src/Common/Model/CategoryPage.hs @@ -0,0 +1,17 @@ +module Common.Model.CategoryPage + ( CategoryPage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Category (Category) + +data CategoryPage = CategoryPage + { _categoryPage_page :: Int + , _categoryPage_categories :: [Category] + , _categoryPage_totalCount :: Int + } deriving (Eq, Show, Generic) + +instance FromJSON CategoryPage +instance ToJSON CategoryPage diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs deleted file mode 100644 index 51bd2a0..0000000 --- a/common/src/Common/Model/CreateCategory.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.CreateCategory - ( CreateCategory(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -data CreateCategory = CreateCategory - { _createCategory_name :: Text - , _createCategory_color :: Text - } deriving (Show, Generic) - -instance FromJSON CreateCategory diff --git a/common/src/Common/Model/CreateCategoryForm.hs b/common/src/Common/Model/CreateCategoryForm.hs new file mode 100644 index 0000000..4668ef4 --- /dev/null +++ b/common/src/Common/Model/CreateCategoryForm.hs @@ -0,0 +1,15 @@ +module Common.Model.CreateCategoryForm + ( CreateCategoryForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateCategoryForm = CreateCategoryForm + { _createCategoryForm_name :: Text + , _createCategoryForm_color :: Text + } deriving (Show, Generic) + +instance FromJSON CreateCategoryForm +instance ToJSON CreateCategoryForm diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs deleted file mode 100644 index 8b9d9eb..0000000 --- a/common/src/Common/Model/EditCategory.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Common.Model.EditCategory - ( EditCategory(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) - -data EditCategory = EditCategory - { _editCategory_id :: CategoryId - , _editCategory_name :: Text - , _editCategory_color :: Text - } deriving (Show, Generic) - -instance FromJSON EditCategory diff --git a/common/src/Common/Model/EditCategoryForm.hs b/common/src/Common/Model/EditCategoryForm.hs new file mode 100644 index 0000000..a2ceca0 --- /dev/null +++ b/common/src/Common/Model/EditCategoryForm.hs @@ -0,0 +1,18 @@ +module Common.Model.EditCategoryForm + ( EditCategoryForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) + +data EditCategoryForm = EditCategoryForm + { _editCategoryForm_id :: CategoryId + , _editCategoryForm_name :: Text + , _editCategoryForm_color :: Text + } deriving (Show, Generic) + +instance FromJSON EditCategoryForm +instance ToJSON EditCategoryForm diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 3516668..2a356df 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -4,6 +4,7 @@ module Common.Validation.Atomic , number , nonNullNumber , day + , color ) where import Data.Text (Text) @@ -45,3 +46,7 @@ day str = case Time.parseDay str of Just d -> V.Success d Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate + +-- TODO: validate +color :: Text -> Validation Text Text +color str = V.Success str diff --git a/common/src/Common/Validation/Category.hs b/common/src/Common/Validation/Category.hs new file mode 100644 index 0000000..f9e6ab4 --- /dev/null +++ b/common/src/Common/Validation/Category.hs @@ -0,0 +1,15 @@ +module Common.Validation.Category + ( name + , color + ) where + +import Data.Text (Text) +import Data.Validation (Validation) + +import qualified Common.Validation.Atomic as Atomic + +name :: Text -> Validation Text Text +name = Atomic.nonEmpty + +color :: Text -> Validation Text Text +color = Atomic.color -- cgit v1.2.3 From da2a0c13aa89705c65fdb9df2f496fb4eea29654 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 4 Jan 2020 19:22:45 +0100 Subject: Allow to remove only unused categories --- common/src/Common/Model/CategoryPage.hs | 9 +++++---- common/src/Common/Validation/Atomic.hs | 9 +++++++-- 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'common/src') diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs index 476b4ce..e20f49f 100644 --- a/common/src/Common/Model/CategoryPage.hs +++ b/common/src/Common/Model/CategoryPage.hs @@ -5,12 +5,13 @@ module Common.Model.CategoryPage import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Common.Model.Category (Category) +import Common.Model.Category (Category, CategoryId) data CategoryPage = CategoryPage - { _categoryPage_page :: Int - , _categoryPage_categories :: [Category] - , _categoryPage_totalCount :: Int + { _categoryPage_page :: Int + , _categoryPage_categories :: [Category] + , _categoryPage_usedCategories :: [CategoryId] + , _categoryPage_totalCount :: Int } deriving (Eq, Show, Generic) instance FromJSON CategoryPage diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 2a356df..4bb7cad 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -7,6 +7,7 @@ module Common.Validation.Atomic , color ) where +import qualified Data.Char as Char import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day) @@ -47,6 +48,10 @@ day str = Just d -> V.Success d Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate --- TODO: validate color :: Text -> Validation Text Text -color str = V.Success str +color str = + if T.take 1 str == "#" && T.all Char.isHexDigit (T.drop 1 str) then + V.Success str + + else + V.Failure (Msg.get Msg.Form_InvalidColor) -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- common/src/Common/Message/Key.hs | 11 +---- common/src/Common/Message/Translation.hs | 74 +++----------------------------- common/src/Common/Model.hs | 2 +- common/src/Common/Model/InitResult.hs | 18 -------- common/src/Common/Model/Password.hs | 12 ++++++ common/src/Common/Model/SignInForm.hs | 3 +- common/src/Common/Validation/Atomic.hs | 12 ++++-- common/src/Common/Validation/SignIn.hs | 14 +++--- 8 files changed, 38 insertions(+), 108 deletions(-) delete mode 100644 common/src/Common/Model/InitResult.hs create mode 100644 common/src/Common/Model/Password.hs (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 2561156..b778a8f 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -118,16 +118,9 @@ data Key = | SignIn_Button | SignIn_DisconnectSuccess - | SignIn_EmailInvalid + | SignIn_InvalidCredentials | SignIn_EmailLabel - | SignIn_EmailSendFail - | SignIn_EmailSent - | SignIn_LinkExpired - | SignIn_LinkInvalid - | SignIn_LinkUsed - | SignIn_MailTitle - | SignIn_MailBody Text Text - | SignIn_ParseError + | SignIn_PasswordLabel | Statistic_Title | Statistic_ByMonthsAndMean Text diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index a86a371..e74c801 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -517,80 +517,20 @@ m l SignIn_DisconnectSuccess = English -> "You have successfully disconnected" French -> "Vous êtes à présent déconnecté." -m l SignIn_EmailInvalid = +m l SignIn_InvalidCredentials = case l of - English -> "Your email is not valid." - French -> "Votre courriel n’est pas valide." + English -> "Your credentials are not valid." + French -> "Vos identifiants de connexion ne sont pas valides." m l SignIn_EmailLabel = case l of English -> "Email" French -> "Courriel" -m l SignIn_EmailSendFail = - case l of - English -> "You are authorized to sign in, but we failed to send you the sign up email." - French -> "Tu es autorisé à te connecter, mais nous n’avons pas pu t’envoyer le courriel de connexion." - -m l SignIn_EmailSent = - case l of - English -> "We sent you an email with a connexion link." - French -> "Nous t’avons envoyé un courriel avec un lien pour te connecter." - -m l SignIn_LinkExpired = - case l of - English -> "The link expired, please sign in again." - French -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau." - -m l SignIn_LinkInvalid = - case l of - English -> "The link is invalid, please sign in again." - French -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau." - -m l SignIn_LinkUsed = - case l of - English -> "You already used this link, please sign in again." - French -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau." - -m l SignIn_MailTitle = - case l of - English -> T.concat [ "Sign in to ", m l App_Title ] - French -> T.concat [ "Connexion à ", m l App_Title ] - -m l (SignIn_MailBody name url) = - T.intercalate - "\n" - ( case l of - English -> - [ T.concat [ "Hi ", name, "," ] - , "" - , T.concat - [ "Click to the following link in order to sign in to Shared Cost:" - , m l App_Title - , ":" - ] - , url - , "" - , "See you soon!" - ] - French -> - [ T.concat [ "Salut ", name, "," ] - , "" - , T.concat - [ "Clique sur le lien suivant pour te connecter à " - , m l App_Title - , ":" - ] - , url - , "" - , "À très vite !" - ] - ) - -m l SignIn_ParseError = - case l of - English -> "Error while reading initial data." - French -> "Erreur lors de la lecture des données initiales." +m l SignIn_PasswordLabel = + case l of + English -> "Password" + French -> "Mot de passe" m l (Statistic_ByMonthsAndMean amount) = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 73cbf6c..c11d6ef 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -17,7 +17,7 @@ import Common.Model.Income as X import Common.Model.IncomeHeader as X import Common.Model.IncomePage as X import Common.Model.Init as X -import Common.Model.InitResult as X +import Common.Model.Password as X import Common.Model.Payment as X import Common.Model.PaymentHeader as X import Common.Model.PaymentPage as X diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs deleted file mode 100644 index f4c08a9..0000000 --- a/common/src/Common/Model/InitResult.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Common.Model.InitResult - ( InitResult(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -import Common.Model.Init (Init) - -data InitResult = - InitSuccess Init - | InitError Text - | InitEmpty - deriving (Show, Generic) - -instance FromJSON InitResult -instance ToJSON InitResult diff --git a/common/src/Common/Model/Password.hs b/common/src/Common/Model/Password.hs new file mode 100644 index 0000000..1b51a47 --- /dev/null +++ b/common/src/Common/Model/Password.hs @@ -0,0 +1,12 @@ +module Common.Model.Password + ( Password(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Password = Password Text deriving (Show, Generic) + +instance FromJSON Password +instance ToJSON Password diff --git a/common/src/Common/Model/SignInForm.hs b/common/src/Common/Model/SignInForm.hs index 2b8c955..7a25935 100644 --- a/common/src/Common/Model/SignInForm.hs +++ b/common/src/Common/Model/SignInForm.hs @@ -7,7 +7,8 @@ import Data.Text (Text) import GHC.Generics (Generic) data SignInForm = SignInForm - { _signIn_email :: Text + { _signInForm_email :: Text + , _signInForm_password :: Text } deriving (Show, Generic) instance FromJSON SignInForm diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 4bb7cad..9c21e14 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -1,10 +1,11 @@ module Common.Validation.Atomic - ( nonEmpty + ( color + , day , minLength - , number + , nonEmpty , nonNullNumber - , day - , color + , number + , password ) where import qualified Data.Char as Char @@ -55,3 +56,6 @@ color str = else V.Failure (Msg.get Msg.Form_InvalidColor) + +password :: Text -> Validation Text Text +password = minLength 8 diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs index 18ceb44..ac9cc37 100644 --- a/common/src/Common/Validation/SignIn.hs +++ b/common/src/Common/Validation/SignIn.hs @@ -1,19 +1,17 @@ module Common.Validation.SignIn - ( signIn - , email + ( email + , password ) where import Data.Text (Text) import Data.Validation (Validation) import Common.Model.Email (Email (..)) -import Common.Model.SignInForm (SignInForm (..)) +import Common.Model.Password (Password (..)) import qualified Common.Validation.Atomic as Atomic -import qualified Data.Validation as Validation - -signIn :: SignInForm -> Maybe Email -signIn (SignInForm str) = - Validation.validation (const Nothing) Just . email $ str email :: Text -> Validation Text Email email = fmap Email . Atomic.minLength 5 + +password :: Text -> Validation Text Password +password = fmap Password . Atomic.minLength 8 -- cgit v1.2.3 From 47c2a4d6b68c54eed5f7b45671b1ccaf8c0db200 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 20 Jan 2020 19:47:23 +0100 Subject: Show payment stats --- common/src/Common/Message/Key.hs | 6 ++-- common/src/Common/Message/Translation.hs | 6 ++-- common/src/Common/Model.hs | 1 + common/src/Common/Model/PaymentStats.hs | 10 ++++++ common/src/Common/View/Format.hs | 52 ++++++++++++++++++++------------ 5 files changed, 49 insertions(+), 26 deletions(-) create mode 100644 common/src/Common/Model/PaymentStats.hs (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index b778a8f..9b60a16 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -122,9 +122,9 @@ data Key = | SignIn_EmailLabel | SignIn_PasswordLabel - | Statistic_Title - | Statistic_ByMonthsAndMean Text - | Statistic_Total + | Statistics_Title + | Statistics_ByMonthsAndMean Text + | Statistics_Total | WeeklyReport_Empty | WeeklyReport_IncomesCreated Int diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index e74c801..2640da3 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -532,19 +532,19 @@ m l SignIn_PasswordLabel = English -> "Password" French -> "Mot de passe" -m l (Statistic_ByMonthsAndMean amount) = +m l (Statistics_ByMonthsAndMean amount) = case l of English -> T.concat [ "Payments by category by month months (", amount, "on average)" ] French -> T.concat [ "Paiements par catégorie par mois (en moyenne ", amount, ")" ] -m l Statistic_Title = +m l Statistics_Title = case l of English -> "Statistics" French -> "Statistiques" -m l Statistic_Total = +m l Statistics_Total = case l of English -> "Total" French -> "Total" diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index c11d6ef..319d109 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -21,5 +21,6 @@ import Common.Model.Password as X import Common.Model.Payment as X import Common.Model.PaymentHeader as X import Common.Model.PaymentPage as X +import Common.Model.PaymentStats as X import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/PaymentStats.hs b/common/src/Common/Model/PaymentStats.hs new file mode 100644 index 0000000..2dea640 --- /dev/null +++ b/common/src/Common/Model/PaymentStats.hs @@ -0,0 +1,10 @@ +module Common.Model.PaymentStats + ( PaymentStats + ) where + +import Data.Map (Map) +import Data.Time.Calendar (Day) + +import Common.Model.Category (CategoryId) + +type PaymentStats = [(Day, Map CategoryId Int)] diff --git a/common/src/Common/View/Format.hs b/common/src/Common/View/Format.hs index 0597d17..5d879fa 100644 --- a/common/src/Common/View/Format.hs +++ b/common/src/Common/View/Format.hs @@ -3,15 +3,18 @@ module Common.View.Format , longDay , price , number + , monthAndYear ) where -import Data.List (intersperse) -import Data.Maybe (fromMaybe) +import qualified Data.List as L +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day, toGregorian) +import Data.Time.Calendar (Day) +import qualified Data.Time.Calendar as Calendar import Common.Model (Currency (..)) +import Common.Msg (Key) import qualified Common.Msg as Msg shortDay :: Day -> Text @@ -20,29 +23,38 @@ shortDay date = day month (fromIntegral year) - where (year, month, day) = toGregorian date + where (year, month, day) = Calendar.toGregorian date longDay :: Day -> Text longDay date = Msg.get $ Msg.Date_Long day - (fromMaybe "−" . fmap Msg.get . monthToKey $ month) + (Maybe.fromMaybe "−" . fmap Msg.get . monthToKey $ month) (fromIntegral year) - where (year, month, day) = toGregorian date + where (year, month, day) = Calendar.toGregorian date - monthToKey 1 = Just Msg.Month_January - monthToKey 2 = Just Msg.Month_February - monthToKey 3 = Just Msg.Month_March - monthToKey 4 = Just Msg.Month_April - monthToKey 5 = Just Msg.Month_May - monthToKey 6 = Just Msg.Month_June - monthToKey 7 = Just Msg.Month_July - monthToKey 8 = Just Msg.Month_August - monthToKey 9 = Just Msg.Month_September - monthToKey 10 = Just Msg.Month_October - monthToKey 11 = Just Msg.Month_November - monthToKey 12 = Just Msg.Month_December - monthToKey _ = Nothing +monthAndYear :: Day -> Text +monthAndYear date = + T.intercalate " " + [ Maybe.fromMaybe "" . fmap ((\t -> T.concat [t, " "]) . Msg.get) . monthToKey $ month + , T.pack . show $ year + ] + where (year, month, _) = Calendar.toGregorian date + +monthToKey :: Int -> Maybe Key +monthToKey 1 = Just Msg.Month_January +monthToKey 2 = Just Msg.Month_February +monthToKey 3 = Just Msg.Month_March +monthToKey 4 = Just Msg.Month_April +monthToKey 5 = Just Msg.Month_May +monthToKey 6 = Just Msg.Month_June +monthToKey 7 = Just Msg.Month_July +monthToKey 8 = Just Msg.Month_August +monthToKey 9 = Just Msg.Month_September +monthToKey 10 = Just Msg.Month_October +monthToKey 11 = Just Msg.Month_November +monthToKey 12 = Just Msg.Month_December +monthToKey _ = Nothing price :: Currency -> Int -> Text price (Currency currency) amount = T.concat [ number amount, " ", currency ] @@ -53,7 +65,7 @@ number n = . (++) (if n < 0 then "-" else "") . reverse . concat - . intersperse " " + . L.intersperse " " . group 3 . reverse . show -- cgit v1.2.3 From 79e1d8b0099d61b580a499311f1714b1b7eb07b5 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 27 Jan 2020 22:07:18 +0100 Subject: Show total incom by month in statistics --- common/src/Common/Message/Key.hs | 5 +++-- common/src/Common/Message/Translation.hs | 17 +++++++++++------ common/src/Common/Model.hs | 2 +- common/src/Common/Model/PaymentStats.hs | 10 ---------- common/src/Common/Model/Stats.hs | 23 +++++++++++++++++++++++ 5 files changed, 38 insertions(+), 19 deletions(-) delete mode 100644 common/src/Common/Model/PaymentStats.hs create mode 100644 common/src/Common/Model/Stats.hs (limited to 'common/src') diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 9b60a16..f3b0837 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -123,8 +123,9 @@ data Key = | SignIn_PasswordLabel | Statistics_Title - | Statistics_ByMonthsAndMean Text - | Statistics_Total + | Statistics_ByMonthsAndMean Text Text + | Statistics_TotalPayments + | Statistics_TotalIncomes | WeeklyReport_Empty | WeeklyReport_IncomesCreated Int diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 2640da3..4ba9ffc 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -532,22 +532,27 @@ m l SignIn_PasswordLabel = English -> "Password" French -> "Mot de passe" -m l (Statistics_ByMonthsAndMean amount) = +m l (Statistics_ByMonthsAndMean paymentMean incomeMean ) = case l of English -> - T.concat [ "Payments by category by month months (", amount, "on average)" ] + T.concat [ "Payments by category (mean ", paymentMean, ") and income (mean ", incomeMean, ") by month" ] French -> - T.concat [ "Paiements par catégorie par mois (en moyenne ", amount, ")" ] + T.concat [ "Paiements par catégorie (moy. ", paymentMean, ") et revenu (moy. ", incomeMean, ") par mois" ] m l Statistics_Title = case l of English -> "Statistics" French -> "Statistiques" -m l Statistics_Total = +m l Statistics_TotalPayments = case l of - English -> "Total" - French -> "Total" + English -> "Payment total" + French -> "Total des payment" + +m l Statistics_TotalIncomes = + case l of + English -> "Income total" + French -> "Total des revenus" m l WeeklyReport_Empty = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index 319d109..979d876 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -21,6 +21,6 @@ import Common.Model.Password as X import Common.Model.Payment as X import Common.Model.PaymentHeader as X import Common.Model.PaymentPage as X -import Common.Model.PaymentStats as X import Common.Model.SignInForm as X +import Common.Model.Stats as X import Common.Model.User as X diff --git a/common/src/Common/Model/PaymentStats.hs b/common/src/Common/Model/PaymentStats.hs deleted file mode 100644 index 2dea640..0000000 --- a/common/src/Common/Model/PaymentStats.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Common.Model.PaymentStats - ( PaymentStats - ) where - -import Data.Map (Map) -import Data.Time.Calendar (Day) - -import Common.Model.Category (CategoryId) - -type PaymentStats = [(Day, Map CategoryId Int)] diff --git a/common/src/Common/Model/Stats.hs b/common/src/Common/Model/Stats.hs new file mode 100644 index 0000000..86e6ab9 --- /dev/null +++ b/common/src/Common/Model/Stats.hs @@ -0,0 +1,23 @@ +module Common.Model.Stats + ( Stats + , MonthStats(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.User (UserId) + +type Stats = [MonthStats] + +data MonthStats = MonthStats + { _monthStats_start :: Day + , _monthStats_paymentsByCategory :: Map CategoryId Int + , _monthStats_incomeByUser :: Map UserId Int + } deriving (Eq, Show, Generic) + +instance FromJSON MonthStats +instance ToJSON MonthStats -- cgit v1.2.3 From 6a04e640955051616c3ad0874605830c448f2d75 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 27 Jan 2020 22:33:07 +0100 Subject: Fix translation typo --- common/src/Common/Message/Translation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'common/src') diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 4ba9ffc..222e669 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -547,7 +547,7 @@ m l Statistics_Title = m l Statistics_TotalPayments = case l of English -> "Payment total" - French -> "Total des payment" + French -> "Total des paiements" m l Statistics_TotalIncomes = case l of -- cgit v1.2.3