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/LICENSE | 674 ++++++++++++++++++++++++++++ common/Setup.hs | 2 + common/common.cabal | 41 ++ 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 +++ 26 files changed, 2068 insertions(+) create mode 100644 common/LICENSE create mode 100644 common/Setup.hs create mode 100644 common/common.cabal 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') diff --git a/common/LICENSE b/common/LICENSE new file mode 100644 index 0000000..45644ff --- /dev/null +++ b/common/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/common/Setup.hs b/common/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/common/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/common/common.cabal b/common/common.cabal new file mode 100644 index 0000000..e072acf --- /dev/null +++ b/common/common.cabal @@ -0,0 +1,41 @@ +name: common +version: 0.0.1 +license: GPL-3 +license-file: LICENSE +author: Joris Guyonvarch +maintainer: joris@guyonvarch.me +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + ghc-options: -Wall -Werror + exposed-modules: Common.Message + , Common.Message.Key + , Common.Model + , Common.Util.Text + , Common.View.Format + other-modules: Common.Message.Lang + , Common.Message.Translation + , Common.Model.PaymentCategory + , Common.Model.CreateCategory + , Common.Model.CreatePayment + , Common.Model.CreateIncome + , Common.Model.EditCategory + , Common.Model.EditPayment + , Common.Model.InitResult + , Common.Model.EditIncome + , Common.Model.Frequency + , Common.Model.Currency + , Common.Model.Category + , Common.Model.Payment + , Common.Model.Income + , Common.Model.SignIn + , Common.Model.Init + , Common.Model.User + build-depends: aeson + , base >=4.9 && <4.11 + , text + , time + hs-source-dirs: src + default-language: Haskell2010 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 213cf7ede058b781fc957de2cd9f6a5988c08004 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 12 Nov 2017 22:58:23 +0100 Subject: Add mocked pages --- common/common.cabal | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index e072acf..8b60743 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -10,6 +10,12 @@ cabal-version: >=1.10 library ghc-options: -Wall -Werror + build-depends: aeson + , base >=4.9 && <4.11 + , text + , time + hs-source-dirs: src + default-language: Haskell2010 exposed-modules: Common.Message , Common.Message.Key , Common.Model @@ -33,9 +39,3 @@ library , Common.Model.SignIn , Common.Model.Init , Common.Model.User - build-depends: aeson - , base >=4.9 && <4.11 - , text - , time - hs-source-dirs: src - default-language: Haskell2010 -- 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/Setup.hs | 2 +- common/common.cabal | 86 ++++++++++++++++-------------- 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 +++--- 24 files changed, 206 insertions(+), 200 deletions(-) (limited to 'common') diff --git a/common/Setup.hs b/common/Setup.hs index 9a994af..4467109 100644 --- a/common/Setup.hs +++ b/common/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/common/common.cabal b/common/common.cabal index 8b60743..c3073d9 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -1,41 +1,47 @@ -name: common -version: 0.0.1 -license: GPL-3 -license-file: LICENSE -author: Joris Guyonvarch -maintainer: joris@guyonvarch.me -category: Web -build-type: Simple -cabal-version: >=1.10 +Name: common +Version: 0.0.1 +License: GPL-3 +License-file: LICENSE +Author: Joris Guyonvarch +Maintainer: joris@guyonvarch.me +Category: Web +Build-type: Simple +Cabal-version: >=1.10 -library - ghc-options: -Wall -Werror - build-depends: aeson - , base >=4.9 && <4.11 - , text - , time - hs-source-dirs: src - default-language: Haskell2010 - exposed-modules: Common.Message - , Common.Message.Key - , Common.Model - , Common.Util.Text - , Common.View.Format - other-modules: Common.Message.Lang - , Common.Message.Translation - , Common.Model.PaymentCategory - , Common.Model.CreateCategory - , Common.Model.CreatePayment - , Common.Model.CreateIncome - , Common.Model.EditCategory - , Common.Model.EditPayment - , Common.Model.InitResult - , Common.Model.EditIncome - , Common.Model.Frequency - , Common.Model.Currency - , Common.Model.Category - , Common.Model.Payment - , Common.Model.Income - , Common.Model.SignIn - , Common.Model.Init - , Common.Model.User +Library + Ghc-options: -Wall -Werror + Hs-source-dirs: src + Default-language: Haskell2010 + + Build-depends: + aeson + , base >=4.9 && <4.11 + , text + , time + + Exposed-modules: + Common.Message + Common.Message.Key + Common.Model + Common.Util.Text + Common.View.Format + + other-modules: + Common.Message.Lang + Common.Message.Translation + Common.Model.PaymentCategory + Common.Model.CreateCategory + Common.Model.CreatePayment + Common.Model.CreateIncome + Common.Model.EditCategory + Common.Model.EditPayment + Common.Model.InitResult + Common.Model.EditIncome + Common.Model.Frequency + Common.Model.Currency + Common.Model.Category + Common.Model.Payment + Common.Model.Income + Common.Model.SignIn + Common.Model.Init + Common.Model.User 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/common.cabal | 26 +++++++++++++--------- 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 ++++++++++++++---------------- 22 files changed, 51 insertions(+), 81 deletions(-) delete mode 100644 common/src/Common/Message.hs create mode 100644 common/src/Common/Msg.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index c3073d9..e4a9c59 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -13,6 +13,12 @@ Library Hs-source-dirs: src Default-language: Haskell2010 + Default-extensions: + DeriveGeneric + ExistentialQuantification + MultiParamTypeClasses + OverloadedStrings + Build-depends: aeson , base >=4.9 && <4.11 @@ -20,28 +26,28 @@ Library , time Exposed-modules: - Common.Message - Common.Message.Key Common.Model + Common.Msg Common.Util.Text Common.View.Format other-modules: + Common.Message.Key Common.Message.Lang Common.Message.Translation - Common.Model.PaymentCategory + Common.Model.Category Common.Model.CreateCategory - Common.Model.CreatePayment Common.Model.CreateIncome + Common.Model.CreatePayment + Common.Model.Currency Common.Model.EditCategory - Common.Model.EditPayment - Common.Model.InitResult Common.Model.EditIncome + Common.Model.EditPayment Common.Model.Frequency - Common.Model.Currency - Common.Model.Category - Common.Model.Payment Common.Model.Income - Common.Model.SignIn Common.Model.Init + Common.Model.InitResult + Common.Model.Payment + Common.Model.PaymentCategory + Common.Model.SignIn Common.Model.User 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/common.cabal | 1 + common/src/Common/Model.hs | 1 + common/src/Common/Model/Payer.hs | 198 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 200 insertions(+) create mode 100644 common/src/Common/Model/Payer.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index e4a9c59..7eadb49 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -47,6 +47,7 @@ Library Common.Model.Income Common.Model.Init Common.Model.InitResult + Common.Model.Payer Common.Model.Payment Common.Model.PaymentCategory Common.Model.SignIn 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') 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') 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') 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/common.cabal | 1 + common/src/Common/Model/CreatePayment.hs | 3 ++- common/src/Common/Model/InitResult.hs | 3 ++- common/src/Common/Util/Time.hs | 26 ++++++++++++++++++++++++++ 4 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 common/src/Common/Util/Time.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 7eadb49..6e5c8fb 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,6 +29,7 @@ Library Common.Model Common.Msg Common.Util.Text + Common.Util.Time Common.View.Format other-modules: 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/common.cabal | 6 +++--- common/src/Common/Message/Key.hs | 4 ++-- common/src/Common/Message/Translation.hs | 12 ++++++------ common/src/Common/Model/CreatePayment.hs | 14 +++++++++++++- 4 files changed, 24 insertions(+), 12 deletions(-) (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 6e5c8fb..151326a 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -21,12 +21,14 @@ Library Build-depends: aeson - , base >=4.9 && <4.11 + , base >=4.9 && <5 , text , time Exposed-modules: Common.Model + Common.Model.CreatePayment + Common.Model.Payment Common.Msg Common.Util.Text Common.Util.Time @@ -39,7 +41,6 @@ Library Common.Model.Category Common.Model.CreateCategory Common.Model.CreateIncome - Common.Model.CreatePayment Common.Model.Currency Common.Model.EditCategory Common.Model.EditIncome @@ -49,7 +50,6 @@ Library Common.Model.Init Common.Model.InitResult Common.Model.Payer - Common.Model.Payment Common.Model.PaymentCategory Common.Model.SignIn Common.Model.User 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/common.cabal | 2 +- common/src/Common/Util/Time.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 151326a..78f2927 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,6 +29,7 @@ Library Common.Model Common.Model.CreatePayment Common.Model.Payment + Common.Model.User Common.Msg Common.Util.Text Common.Util.Time @@ -52,4 +53,3 @@ Library Common.Model.Payer Common.Model.PaymentCategory Common.Model.SignIn - Common.Model.User 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/common.cabal | 12 ++++++-- 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 +++++++++++++ 11 files changed, 145 insertions(+), 20 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') diff --git a/common/common.cabal b/common/common.cabal index 78f2927..9881c64 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -20,19 +20,26 @@ Library OverloadedStrings Build-depends: - aeson - , base >=4.9 && <5 + aeson + , base >= 4.11 && < 5 , text , time + , validation Exposed-modules: Common.Model Common.Model.CreatePayment + Common.Model.Email Common.Model.Payment + Common.Model.SignInForm Common.Model.User Common.Msg Common.Util.Text Common.Util.Time + Common.Util.Validation + Common.Validation.Atomic + Common.Validation.Payment + Common.Validation.SignIn Common.View.Format other-modules: @@ -52,4 +59,3 @@ Library Common.Model.InitResult Common.Model.Payer Common.Model.PaymentCategory - Common.Model.SignIn 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/common.cabal | 1 + common/src/Common/Model.hs | 1 + common/src/Common/Model/CreatedPayment.hs | 17 +++++++++++++++++ 3 files changed, 19 insertions(+) create mode 100644 common/src/Common/Model/CreatedPayment.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 9881c64..b7e0416 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,6 +29,7 @@ Library Exposed-modules: Common.Model Common.Model.CreatePayment + Common.Model.CreatedPayment Common.Model.Email Common.Model.Payment Common.Model.SignInForm 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') 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') 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') 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 c542424b7b41c78a170763f6996c12f56b359860 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 10 Aug 2019 21:31:27 +0200 Subject: Add smooth transitions to modal show and hide --- common/common.cabal | 1 + 1 file changed, 1 insertion(+) (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index b7e0416..0edd8e2 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -16,6 +16,7 @@ Library Default-extensions: DeriveGeneric ExistentialQuantification + LambdaCase MultiParamTypeClasses OverloadedStrings -- 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/common.cabal | 2 +- 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 +++++++++++++++++ 5 files changed, 21 insertions(+), 20 deletions(-) delete mode 100644 common/src/Common/Model/CreatedPayment.hs create mode 100644 common/src/Common/Model/SavedPayment.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 0edd8e2..a454270 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -30,9 +30,9 @@ Library Exposed-modules: Common.Model Common.Model.CreatePayment - Common.Model.CreatedPayment Common.Model.Email Common.Model.Payment + Common.Model.SavedPayment Common.Model.SignInForm Common.Model.User Common.Msg 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/common.cabal | 4 +-- 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 +++++++++-- 7 files changed, 78 insertions(+), 81 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') diff --git a/common/common.cabal b/common/common.cabal index a454270..64a3b3e 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,7 +29,7 @@ Library Exposed-modules: Common.Model - Common.Model.CreatePayment + Common.Model.CreatePaymentForm Common.Model.Email Common.Model.Payment Common.Model.SavedPayment @@ -54,7 +54,7 @@ Library Common.Model.Currency Common.Model.EditCategory Common.Model.EditIncome - Common.Model.EditPayment + Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income Common.Model.Init 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') 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') 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') 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/common.cabal | 4 +++- 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 - 7 files changed, 55 insertions(+), 17 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') diff --git a/common/common.cabal b/common/common.cabal index 64a3b3e..6c7c779 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -29,6 +29,7 @@ Library Exposed-modules: Common.Model + Common.Model.CreateIncomeForm Common.Model.CreatePaymentForm Common.Model.Email Common.Model.Payment @@ -40,6 +41,7 @@ Library Common.Util.Time Common.Util.Validation Common.Validation.Atomic + Common.Validation.Income Common.Validation.Payment Common.Validation.SignIn Common.View.Format @@ -50,10 +52,10 @@ Library Common.Message.Translation Common.Model.Category Common.Model.CreateCategory - Common.Model.CreateIncome Common.Model.Currency Common.Model.EditCategory Common.Model.EditIncome + Common.Model.EditIncomeForm Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income 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') 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 80f09e8b3a5c856e60922a73c9161a8c5392e4d4 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 22 Oct 2019 21:35:03 +0200 Subject: Create ModalForm component --- common/common.cabal | 1 + 1 file changed, 1 insertion(+) (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 6c7c779..1a441c5 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -19,6 +19,7 @@ Library LambdaCase MultiParamTypeClasses OverloadedStrings + ScopedTypeVariables Build-depends: aeson -- 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/common.cabal | 1 + common/src/Common/Model.hs | 1 + common/src/Common/Model/IncomesAndCount.hs | 16 ++++++++++++++++ 3 files changed, 18 insertions(+) create mode 100644 common/src/Common/Model/IncomesAndCount.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 1a441c5..9f3f65b 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -60,6 +60,7 @@ Library Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income + Common.Model.IncomesAndCount Common.Model.Init Common.Model.InitResult Common.Model.Payer 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/common.cabal | 4 +++- 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 ---------------- 5 files changed, 41 insertions(+), 18 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') diff --git a/common/common.cabal b/common/common.cabal index 9f3f65b..651673f 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -24,6 +24,7 @@ Library Build-depends: aeson , base >= 4.11 && < 5 + , containers , text , time , validation @@ -60,7 +61,8 @@ Library Common.Model.EditPaymentForm Common.Model.Frequency Common.Model.Income - Common.Model.IncomesAndCount + Common.Model.IncomeHeader + Common.Model.IncomePage Common.Model.Init Common.Model.InitResult Common.Model.Payer 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') 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/common.cabal | 1 + common/src/Common/Model.hs | 1 + common/src/Common/Model/PaymentPage.hs | 18 ++++++++++++++++++ 3 files changed, 20 insertions(+) create mode 100644 common/src/Common/Model/PaymentPage.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 651673f..4a6d728 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -67,3 +67,4 @@ Library Common.Model.InitResult Common.Model.Payer Common.Model.PaymentCategory + Common.Model.PaymentPage 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/common.cabal | 2 ++ 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 +++- 6 files changed, 51 insertions(+), 16 deletions(-) create mode 100644 common/src/Common/Model/ExceedingPayer.hs create mode 100644 common/src/Common/Model/PaymentHeader.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 4a6d728..75d6cc8 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -59,6 +59,7 @@ Library Common.Model.EditIncome Common.Model.EditIncomeForm Common.Model.EditPaymentForm + Common.Model.ExceedingPayer Common.Model.Frequency Common.Model.Income Common.Model.IncomeHeader @@ -67,4 +68,5 @@ Library Common.Model.InitResult Common.Model.Payer Common.Model.PaymentCategory + Common.Model.PaymentHeader Common.Model.PaymentPage 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/common.cabal | 3 - 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 + 9 files changed, 12 insertions(+), 260 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') diff --git a/common/common.cabal b/common/common.cabal index 75d6cc8..17a0ee1 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -35,7 +35,6 @@ Library Common.Model.CreatePaymentForm Common.Model.Email Common.Model.Payment - Common.Model.SavedPayment Common.Model.SignInForm Common.Model.User Common.Msg @@ -66,7 +65,5 @@ Library Common.Model.IncomePage Common.Model.Init Common.Model.InitResult - Common.Model.Payer - Common.Model.PaymentCategory Common.Model.PaymentHeader Common.Model.PaymentPage 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') 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') 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') 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/common.cabal | 6 ++-- 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 +++++++++ 10 files changed, 98 insertions(+), 56 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') diff --git a/common/common.cabal b/common/common.cabal index 17a0ee1..fdede8f 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -31,6 +31,7 @@ Library Exposed-modules: Common.Model + Common.Model.CreateCategoryForm Common.Model.CreateIncomeForm Common.Model.CreatePaymentForm Common.Model.Email @@ -42,6 +43,7 @@ Library Common.Util.Time Common.Util.Validation Common.Validation.Atomic + Common.Validation.Category Common.Validation.Income Common.Validation.Payment Common.Validation.SignIn @@ -52,9 +54,9 @@ Library Common.Message.Lang Common.Message.Translation Common.Model.Category - Common.Model.CreateCategory + Common.Model.CategoryPage Common.Model.Currency - Common.Model.EditCategory + Common.Model.EditCategoryForm Common.Model.EditIncome Common.Model.EditIncomeForm Common.Model.EditPaymentForm 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') 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/common.cabal | 2 +- 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 +++--- 9 files changed, 39 insertions(+), 109 deletions(-) delete mode 100644 common/src/Common/Model/InitResult.hs create mode 100644 common/src/Common/Model/Password.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index fdede8f..d09e29b 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -35,6 +35,7 @@ Library Common.Model.CreateIncomeForm Common.Model.CreatePaymentForm Common.Model.Email + Common.Model.Password Common.Model.Payment Common.Model.SignInForm Common.Model.User @@ -66,6 +67,5 @@ Library Common.Model.IncomeHeader Common.Model.IncomePage Common.Model.Init - Common.Model.InitResult Common.Model.PaymentHeader Common.Model.PaymentPage 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/common.cabal | 1 + 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 ++++++++++++++++++++------------ 6 files changed, 50 insertions(+), 26 deletions(-) create mode 100644 common/src/Common/Model/PaymentStats.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index d09e29b..020a987 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -69,3 +69,4 @@ Library Common.Model.Init Common.Model.PaymentHeader Common.Model.PaymentPage + Common.Model.PaymentStats 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/common.cabal | 2 +- 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 +++++++++++++++++++++++ 6 files changed, 39 insertions(+), 20 deletions(-) delete mode 100644 common/src/Common/Model/PaymentStats.hs create mode 100644 common/src/Common/Model/Stats.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 020a987..dffc8d0 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -69,4 +69,4 @@ Library Common.Model.Init Common.Model.PaymentHeader Common.Model.PaymentPage - Common.Model.PaymentStats + Common.Model.Stats 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') 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