packages feed

yu-core 0.1.0.0 → 0.1.1.2

raw patch · 18 files changed

+3035/−2736 lines, 18 filesdep ~yu-authdep ~yu-utilssetup-changed

Dependency ranges changed: yu-auth, yu-utils

Files

ChangeLog.md view
@@ -1,5 +1,5 @@-# Revision history for yu-core--## 0.1.0.0  -- 2017-12-01-+# Revision history for yu-core
+
+## 0.1.0.0  -- 2017-12-01
+
 * First version. Rename from Glob
LICENSE view
@@ -1,674 +1,674 @@-              GNU GENERAL PUBLIC LICENSE-                Version 3, 29 June 2007-- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>- 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.--    <one line to give the program's name and a brief idea of what it does.>-    Copyright (C) <year>  <name of author>--    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 <http://www.gnu.org/licenses/>.--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:--    <program>  Copyright (C) <year>  <name of author>-    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-<http://www.gnu.org/licenses/>.--  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-<http://www.gnu.org/philosophy/why-not-lgpl.html>.+              GNU GENERAL PUBLIC LICENSE
+                Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ 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.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 <http://www.gnu.org/licenses/>.
+
+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:
+
+    <program>  Copyright (C) <year>  <name of author>
+    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
+<http://www.gnu.org/licenses/>.
+
+  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
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain
src/Yu/Core/Control.hs view
@@ -1,220 +1,240 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RecordWildCards       #-}--{-|-Module       : Yu.Core.Control-Description  : The view of glob-Copyright    : (C) Qinka 2017-License      : GPL3-Maintainer   : me@qinka.pro-Stability    : experimental-Portability  : unknow--The control part of the glob.--}---module Yu.Core.Control-       ( Controly(..)-       , getUrlR-       , putUrlR-       , deleteUrlR-       ) where--import           Yesod.Core-import           Yu.Core.Control.Internal-import           Yu.Core.Model-import           Yu.Core.View-import           Yu.Import.Aeson-import qualified Yu.Import.ByteString     as B-import           Yu.Import.Text           (Text)-import qualified Yu.Import.Text           as T-import           Yu.Utils.Handler------ | get method router-getUrlR :: Controly site-        => [T.Text] -- ^ index-        -> HandlerT site IO TypedContent-getUrlR idx@(".query":_) = getQueryR idx =<< runDbDefault (fetchRes idx)-getUrlR idx = do-  res <- runDbDefault $ fetchRes idx-  case rType <$> res of-    Just "post"   -> getPostR           res-    Just "text"   -> getResourceR True  res-    Just "binary" -> getResourceR False res-    Just "static" -> getStaticR         res-    _             -> liftIO (print res) >> notFound---- | put method router-putUrlR :: Controly site-        => [Text] -- ^ index-        -> HandlerT site IO TypedContent-putUrlR (".query":".nav":_) = putNavR-putUrlR idx = do-  typ <- lookupPostParam "type"-  case typ of-    Just "post"   -> putPostR           idx-    Just "text"   -> putResourceR True  idx-    Just "binary" -> putResourceR False idx-    Just "static" -> putStaticR         idx-    Just "frame"  -> putFrameR          idx-    Just "query"  -> putQueryR          idx-    _             -> notFound---- | delete-deleteUrlR :: Controly site-           => [Text] -- ^ index-           -> HandlerT site IO TypedContent-deleteUrlR (".query":".nav":_) = delNavR-deleteUrlR idx = do-  typ <- lookupPostParam "type"-  db <- case typ of-    Just "post"   -> return "post"-    Just "text"   -> return "resource"-    Just "binary" -> return "resource"-    Just "static" -> return "static"-    Just "query"  -> return "query"-    Just "frame"  -> return "frame"-    _             -> notFound-  rt <- tryH.runDbDefault $ deleteItem idx db-  case rt of-    Left e  -> returnEH e-    Right _ -> returnSucc----- | get post-getPostR :: Controly site-         => Maybe ResT -- ^ index-         -> HandlerT site IO TypedContent-getPostR (Just res@ResT{..}) = do-  html <- runDbDefault $ fetchPost res-  case html of-    Just pH -> respondPost res pH-    _       -> liftIO (putStrLn "Faile to get") >> notFound-getPostR _ = notFound---- | put post-putPostR :: Controly site-            => [Text] -- ^ index-            -> HandlerT site IO TypedContent-putPostR idx = do-  unR  <- lookupPostUnResT idx-  html <- T.decodeUtf8 <#> getFile "html"-  putItem unR html updatePost---- | get resource-getResourceR :: Controly site-                => Bool -- ^ whether item is text-                -> Maybe ResT-                -> HandlerT site IO TypedContent-getResourceR t (Just res@ResT{..}) = do-  ct <- runDbDefault $ fetchItem res-  case ct of-    Just (Left    text) -> respondResourceT res text-    Just (Right binary) -> respondResourceB res binary-    _                   -> notFound-  where-    fetchItem :: Controly site-                  => ResT-                  -> Action (HandlerT site IO) (Maybe (Either T.Text B.ByteString))-    fetchItem = if t-                 then (Left  <#>) <$> fetchResourceT-                 else (Right <#>) <$> fetchResourceB-getResourceR _ _ = notFound---- | put resource-putResourceR :: Controly site-                => Bool -- ^ whether item is text-                -> [T.Text]-                -> HandlerT site IO TypedContent-putResourceR t idx = do-  unR  <- lookupPostUnResT idx-  text <- T.decodeUtf8 <#> getFile "text"-  bin  <- getFile "binary"-  if t-    then putItem unR            text  updateResourceT-    else putItem unR (Binary <$> bin) updateResourceB---- | get static-getStaticR :: Controly site-              => Maybe ResT-              -> HandlerT site IO TypedContent-getStaticR (Just res@ResT{..}) = do-  url <- runDbDefault $ fetchStatic res-  case url of-    Just u -> respondStatic res u-    _      -> notFound-getStaticR _ = notFound---- | put static-putStaticR :: Controly site-               => [Text]-               -> HandlerT site IO  TypedContent-putStaticR idx = do-  unR <- lookupPostUnResT idx-  url <- lookupPostParam "url"-  putItem unR url updateStatic----- | put frame-putFrameR :: Controly site-             => [T.Text]-             -> HandlerT site IO TypedContent-putFrameR idx = do-  unR <- lookupPostUnResT idx-  html <- T.decodeUtf8 <#> getFile "html"-  putItem unR html updateFrame---- | get query-getQueryR :: Controly site-             => [Text]-             -> Maybe ResT-             -> HandlerT site IO TypedContent-getQueryR idx r =-  case tail idx of-    ".version":"author":_ -> queryVersionAuthor-    ".version":"utils":_  -> queryVersionUtils-    ".version":"core":_   -> queryVersionCore-    ".version":_          -> queryVersion-    ".name":_             -> queryName-    ".buildinfo":_        -> queryBuildInfo-    ".servertime":_       -> queryServerTime-    ".nav":_              -> runDbDefault fetchNav >>= queryNav-    ".index":xs           -> runDbDefault fetchResAll >>= queryIndex (T.unpack $ T.concat xs)-    _ -> runDbDefault (fetchMaybeR fetchQuery r)-      >>= (\t -> case t of-              Just text -> queryQuery text-              _         -> notFound-          )---- | put query-putQueryR :: Controly site-            => [T.Text]-            -> HandlerT site IO TypedContent-putQueryR idx = do-  unR <- lookupPostUnResT idx-  var <- lookupPostParam "var"-  putItem unR var updateQuery---- | put navs-putNavR :: Controly site-           => HandlerT site IO TypedContent-putNavR = do-  idx   <- lookupPostParam "label"-  url   <- lookupPostParam "url"-  order <- lookupPostParam "order"-  runDbDefault $ updateNav idx url (T.read <$> order)-  returnSucc---- | delete navs-delNavR :: Controly site-           => HandlerT site IO TypedContent-delNavR = do-  idx <- lookupPostParam "label"-  runDbDefault $ deleteNav idx-  returnSucc-+{-
+
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module       : Yu.Core.Control
+Description  : The view of glob
+Copyright    : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License      : GPL3
+Maintainer   : me@qinka.pro
+Stability    : experimental
+Portability  : unknow
+
+The control part of the glob.
+-}
+
+
+
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+
+
+module Yu.Core.Control
+  ( Controly(..)
+  , getUrlR
+  , putUrlR
+  , deleteUrlR
+  ) where
+
+import           Yesod.Core
+import           Yu.Core.Control.Internal
+import           Yu.Core.Model
+import           Yu.Core.View
+import           Yu.Import.Aeson
+import qualified Yu.Import.ByteString     as B
+import           Yu.Import.Text           (Text)
+import qualified Yu.Import.Text           as T
+import           Yu.Utils.Handler
+
+-- | get method router
+getUrlR :: Controly site
+        => [T.Text] -- ^ index
+        -> HandlerT site IO TypedContent
+getUrlR idx@(".query":_) = getQueryR idx =<< runDbDefault (fetchRes idx)
+getUrlR idx = do
+  res <- runDbDefault $ fetchRes idx
+  case rType <$> res of
+    Just "post"   -> getPostR           res
+    Just "text"   -> getResourceR True  res
+    Just "binary" -> getResourceR False res
+    Just "static" -> getStaticR         res
+    _             -> liftIO (print res) >> notFound
+
+-- | put method router
+putUrlR :: Controly site
+        => [Text] -- ^ index
+        -> HandlerT site IO TypedContent
+putUrlR (".query":".nav":_) = putNavR
+putUrlR idx = do
+  typ <- lookupPostParam "type"
+  case typ of
+    Just "post"   -> putPostR           idx
+    Just "text"   -> putResourceR True  idx
+    Just "binary" -> putResourceR False idx
+    Just "static" -> putStaticR         idx
+    Just "frame"  -> putFrameR          idx
+    Just "query"  -> putQueryR          idx
+    _             -> notFound
+
+-- | delete
+deleteUrlR :: Controly site
+           => [Text] -- ^ index
+           -> HandlerT site IO TypedContent
+deleteUrlR (".query":".nav":_) = delNavR
+deleteUrlR idx = do
+  typ <- lookupPostParam "type"
+  db <- case typ of
+    Just "post"   -> return "post"
+    Just "text"   -> return "resource"
+    Just "binary" -> return "resource"
+    Just "static" -> return "static"
+    Just "query"  -> return "query"
+    Just "frame"  -> return "frame"
+    _             -> notFound
+  rt <- tryH.runDbDefault $ deleteItem idx db
+  case rt of
+    Left e  -> returnEH e
+    Right _ -> returnSucc
+
+
+-- | get post
+getPostR :: Controly site
+         => Maybe ResT -- ^ index
+         -> HandlerT site IO TypedContent
+getPostR (Just res@ResT{..}) = do
+  html <- runDbDefault $ fetchPost res
+  case html of
+    Just pH -> respondPost res pH
+    _       -> liftIO (putStrLn "Faile to get") >> notFound
+getPostR _ = notFound
+
+-- | put post
+putPostR :: Controly site
+            => [Text] -- ^ index
+            -> HandlerT site IO TypedContent
+putPostR idx = do
+  unR  <- lookupPostUnResT idx
+  html <- T.decodeUtf8 <#> getFile "html"
+  putItem unR html updatePost
+
+-- | get resource
+getResourceR :: Controly site
+                => Bool -- ^ whether item is text
+                -> Maybe ResT
+                -> HandlerT site IO TypedContent
+getResourceR t (Just res@ResT{..}) = do
+  ct <- runDbDefault $ fetchItem res
+  case ct of
+    Just (Left    text) -> respondResourceT res text
+    Just (Right binary) -> respondResourceB res binary
+    _                   -> notFound
+  where
+    fetchItem :: Controly site
+                  => ResT
+                  -> Action (HandlerT site IO) (Maybe (Either T.Text B.ByteString))
+    fetchItem = if t
+                 then (Left  <#>) <$> fetchResourceT
+                 else (Right <#>) <$> fetchResourceB
+getResourceR _ _ = notFound
+
+-- | put resource
+putResourceR :: Controly site
+                => Bool -- ^ whether item is text
+                -> [T.Text]
+                -> HandlerT site IO TypedContent
+putResourceR t idx = do
+  unR  <- lookupPostUnResT idx
+  text <- T.decodeUtf8 <#> getFile "text"
+  bin  <- getFile "binary"
+  if t
+    then putItem unR            text  updateResourceT
+    else putItem unR (Binary <$> bin) updateResourceB
+
+-- | get static
+getStaticR :: Controly site
+              => Maybe ResT
+              -> HandlerT site IO TypedContent
+getStaticR (Just res@ResT{..}) = do
+  url <- runDbDefault $ fetchStatic res
+  case url of
+    Just u -> respondStatic res u
+    _      -> notFound
+getStaticR _ = notFound
+
+-- | put static
+putStaticR :: Controly site
+               => [Text]
+               -> HandlerT site IO  TypedContent
+putStaticR idx = do
+  unR <- lookupPostUnResT idx
+  url <- lookupPostParam "url"
+  putItem unR url updateStatic
+
+
+-- | put frame
+putFrameR :: Controly site
+             => [T.Text]
+             -> HandlerT site IO TypedContent
+putFrameR idx = do
+  unR <- lookupPostUnResT idx
+  html <- T.decodeUtf8 <#> getFile "html"
+  putItem unR html updateFrame
+
+-- | get query
+getQueryR :: Controly site
+             => [Text]
+             -> Maybe ResT
+             -> HandlerT site IO TypedContent
+getQueryR idx r =
+  case tail idx of
+    ".version":"author":_ -> queryVersionAuthor
+    ".version":"utils":_  -> queryVersionUtils
+    ".version":"core":_   -> queryVersionCore
+    ".version":_          -> queryVersion
+    ".name":_             -> queryName
+    ".buildinfo":_        -> queryBuildInfo
+    ".servertime":_       -> queryServerTime
+    ".nav":_              -> runDbDefault fetchNav >>= queryNav
+    ".index":xs           -> runDbDefault fetchResAll >>= queryIndex (T.unpack $ T.concat xs)
+    _ -> runDbDefault (fetchMaybeR fetchQuery r)
+      >>= (\t -> case t of
+              Just text -> queryQuery text
+              _         -> notFound
+          )
+
+-- | put query
+putQueryR :: Controly site
+            => [T.Text]
+            -> HandlerT site IO TypedContent
+putQueryR idx = do
+  unR <- lookupPostUnResT idx
+  var <- lookupPostParam "var"
+  putItem unR var updateQuery
+
+-- | put navs
+putNavR :: Controly site
+           => HandlerT site IO TypedContent
+putNavR = do
+  idx   <- lookupPostParam "label"
+  url   <- lookupPostParam "url"
+  order <- lookupPostParam "order"
+  runDbDefault $ updateNav idx url (T.read <$> order)
+  returnSucc
+
+-- | delete navs
+delNavR :: Controly site
+           => HandlerT site IO TypedContent
+delNavR = do
+  idx <- lookupPostParam "label"
+  runDbDefault $ deleteNav idx
+  returnSucc
+
src/Yu/Core/Control/Internal.hs view
@@ -1,102 +1,123 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RecordWildCards       #-}--{-|-Module       : Yu.Core.Control.Internal-Description  : The view of glob-Copyright    : (C) Qinka 2017-License      : GPL3-Maintainer   : me@qinka.pro-Stability    : experimental-Portability  : unknow--The control part of the glob.--}---module Yu.Core.Control.Internal-       ( lookupPostUnResT-       , getFile-       , getField-       , putItem-       , returnSucc-       , Controly(..)-       ) where--import           Data.Conduit-import           Yesod.Core-import           Yu.Core.Model-import           Yu.Core.View-import qualified Yu.Import.ByteString as B-import           Yu.Import.Text       (Text)-import qualified Yu.Import.Text       as T-import           Yu.Utils.Handler------ | for control-class (Mongodic site (HandlerT site IO), MonadHandler (HandlerT site IO), Hamletic site (HandlerT site IO), Yesod site) => Controly site---- | lookup the undefined index-lookupPostUnResT :: Controly site-                 => [Text] -- ^ index-                 -> HandlerT site IO (Maybe ResT)-lookupPostUnResT idx = do-  ty <- lookupPostParam  "type"-  ct <- lookupPostParam  "create-time"-  ut <- lookupPostParam  "update-time"-  ti <- lookupPostParam  "title"-  su <- getField         "summary"-  wh <- lookupPostParam  "whose"-  mi <- lookupPostParam  "mime"-  tg <- lookupPostParams "tag"-  ts <- T.words <#> lookupPostParams "tags"-  return $ case (ty,ct,ut,ti) of-    (Just t,Just c,Just u,Just i) -> Just . ResT-      idx undefined t (T.read c) (T.read u) i su wh mi . concat $ tg:ts-    _ -> Nothing---- | get the uploaded file in ByteString-getFilesBS :: (MonadResource m, MonadHandler m)-           => [FileInfo] -- ^ file infos-           -> m (Maybe B.ByteString)-getFilesBS [] = return Nothing-getFilesBS xs = Just. B.concat.concat <$>-  mapM (sourceToList.fileSource) xs---- | get the file via file name-getFile :: (MonadResource m, MonadHandler m)-        => T.Text -- ^ file name (field name)-        -> m (Maybe B.ByteString)-getFile file = getFilesBS =<< lookupFiles file---- | get the field text-getField :: (MonadResource m, MonadHandler m)-         => T.Text -- ^ field name-         -> m (Maybe T.Text)-getField fieled = do-  su <- T.decodeUtf8 <#> getFile fieled-  case su of-    Just s -> return su-    _      -> lookupPostParam fieled---- | for upload the items-putItem :: (Controly site, Val a)-        => Maybe ResT -- ^ resource index (maybe)-        -> Maybe a    -- ^ item (maybe)-        -> (a -> ResT -> Action (HandlerT site IO) ()) -- ^ upload action for database-        -> HandlerT site IO TypedContent-putItem unR item f = case (unR,item) of-  (Just r,Just i) -> do-    rt <- tryH.runDbDefault $ f i r-    returnI rt-  _ ->  invalidArgs [" args failed"]-  where-    returnI (Left e)  = returnEH e-    returnI (Right _) = respondSource "" $ sendChunkText "success"---- | return sucecess-returnSucc :: HandlerT site IO TypedContent-returnSucc = respondSource "text/plain" $ sendChunkText "success"+{- 
+Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+This file is part of Yu.
+
+Yu 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.
+
+Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+
+{-|
+Module       : Yu.Core.Control.Internal
+Description  : The view of glob
+Copyright    : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License      : GPL3
+Maintainer   : me@qinka.pro
+Stability    : experimental
+Portability  : unknow
+
+The control part of the glob.
+-}
+
+
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+
+
+module Yu.Core.Control.Internal
+  ( lookupPostUnResT
+  , getFile
+  , getField
+  , putItem
+  , returnSucc
+  , Controly(..)
+  ) where
+
+import           Data.Conduit
+import           Yesod.Core
+import           Yu.Core.Model
+import           Yu.Core.View
+import qualified Yu.Import.ByteString as B
+import           Yu.Import.Text       (Text)
+import qualified Yu.Import.Text       as T
+import           Yu.Utils.Handler
+
+
+
+-- | for control
+class (Mongodic site (HandlerT site IO), MonadHandler (HandlerT site IO), Hamletic site (HandlerT site IO), Yesod site) => Controly site
+
+-- | lookup the undefined index
+lookupPostUnResT :: Controly site
+                 => [Text] -- ^ index
+                 -> HandlerT site IO (Maybe ResT)
+lookupPostUnResT idx = do
+  ty <- lookupPostParam  "type"
+  ct <- lookupPostParam  "create-time"
+  ut <- lookupPostParam  "update-time"
+  ti <- lookupPostParam  "title"
+  su <- getField         "summary"
+  wh <- lookupPostParam  "whose"
+  mi <- lookupPostParam  "mime"
+  tg <- lookupPostParams "tag"
+  ts <- T.words <#> lookupPostParams "tags"
+  return $ case (ty,ct,ut,ti) of
+    (Just t,Just c,Just u,Just i) -> Just . ResT
+      idx undefined t (T.read c) (T.read u) i su wh mi . concat $ tg:ts
+    _ -> Nothing
+
+-- | get the uploaded file in ByteString
+getFilesBS :: (MonadResource m, MonadHandler m)
+           => [FileInfo] -- ^ file infos
+           -> m (Maybe B.ByteString)
+getFilesBS [] = return Nothing
+getFilesBS xs = Just. B.concat.concat <$>
+  mapM (sourceToList.fileSource) xs
+
+-- | get the file via file name
+getFile :: (MonadResource m, MonadHandler m)
+        => T.Text -- ^ file name (field name)
+        -> m (Maybe B.ByteString)
+getFile file = getFilesBS =<< lookupFiles file
+
+-- | get the field text
+getField :: (MonadResource m, MonadHandler m)
+         => T.Text -- ^ field name
+         -> m (Maybe T.Text)
+getField fieled = do
+  su <- T.decodeUtf8 <#> getFile fieled
+  case su of
+    Just s -> return su
+    _      -> lookupPostParam fieled
+
+-- | for upload the items
+putItem :: (Controly site, Val a)
+        => Maybe ResT -- ^ resource index (maybe)
+        -> Maybe a    -- ^ item (maybe)
+        -> (a -> ResT -> Action (HandlerT site IO) ()) -- ^ upload action for database
+        -> HandlerT site IO TypedContent
+putItem unR item f = case (unR,item) of
+  (Just r,Just i) -> do
+    rt <- tryH.runDbDefault $ f i r
+    returnI rt
+  _ ->  invalidArgs [" args failed"]
+  where
+    returnI (Left e)  = returnEH e
+    returnI (Right _) = respondSource "" $ sendChunkText "success"
+
+-- | return sucecess
+returnSucc :: HandlerT site IO TypedContent
+returnSucc = respondSource "text/plain" $ sendChunkText "success"
src/Yu/Core/Info.hs view
@@ -1,66 +1,84 @@-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE TemplateHaskell #-}--{-|-Module        : Yu.Core.Info-Description   : THe info of this package-Copyright     : Qinka 2017-License       : GPL-3-Maintainer    : qinka@live.com-                me@qinka.pro-Stability     : experimental-Portability   : x86/64--The information of thos package, such as version, git commit-id.--}------module Yu.Core.Info-       ( -- * TemplateHaskell's variables-         yuCoreVersion-       , yuCoreVersionQuote-       , yuCoreGitBranchQuote-       , yuCoreGitCommitQuote-       , yuBuildInfoQuote-       ) where--import           Data.Char-import           Data.Time-import           Paths_yu_core-import           System.Info-import           Yu.Import.TH-import           Yu.Import.Version---- | The version of this package, in Data.Version.Version-yuCoreVersion :: Version -- ^ The version-yuCoreVersion = version--- | The version of the package, in a Q Exp-yuCoreVersionQuote :: Q Exp -- ^ String-yuCoreVersionQuote = stringE $ showVersion version------ | The commit of the git-yuCoreGitCommitQuote :: Q Exp -- ^ String-yuCoreGitCommitQuote = gitHash--- | The commit of the branch-yuCoreGitBranchQuote :: Q Exp -- ^ String-yuCoreGitBranchQuote = gitBranch---- | build information-yuBuildInfoQuote :: Q Exp -- ^ String-yuBuildInfoQuote = do-  timeStr <- formatTime defaultTimeLocale "-%Y-%m-%d-%H-%M-%S" <$> runIO getCurrentTime-  stringE $ os ++ "-" ++ arch ++ "-"  ++ map toUpper compilerName-    ++ "-" ++ showVersion compilerVersion ++ timeStr-    ++ "-git:" ++ $gitBranch ++ ":" ++ $gitHash------ | Use these as a string--- @---   putStrLn $YuCoreVersionQuote ++ $YuCoreGitCommitQuote--- @+
+{-
+Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module        : Yu.Core.Info
+Description   : THe info of this package
+Copyright     : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License       : GPL-3
+Maintainer    : qinka@live.com
+                me@qinka.pro
+Stability     : experimental
+Portability   : x86/64
+
+The information of thos package, such as version, git commit-id.
+-}
+
+{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+
+
+module Yu.Core.Info
+  ( -- * TemplateHaskell's variables
+    yuCoreVersion
+  , yuCoreVersionQuote
+  , yuCoreGitBranchQuote
+  , yuCoreGitCommitQuote
+  , yuBuildInfoQuote
+  ) where
+
+import           Data.Char
+import           Data.Time
+import           Paths_yu_core
+import           System.Info
+import           Yu.Import.TH
+import           Yu.Import.Version
+
+-- | The version of this package, in Data.Version.Version
+yuCoreVersion :: Version -- ^ The version
+yuCoreVersion = version
+-- | The version of the package, in a Q Exp
+yuCoreVersionQuote :: Q Exp -- ^ String
+yuCoreVersionQuote = stringE $ showVersion version
+
+
+
+-- | The commit of the git
+yuCoreGitCommitQuote :: Q Exp -- ^ String
+yuCoreGitCommitQuote = gitHash
+-- | The commit of the branch
+yuCoreGitBranchQuote :: Q Exp -- ^ String
+yuCoreGitBranchQuote = gitBranch
+
+-- | build information
+yuBuildInfoQuote :: Q Exp -- ^ String
+yuBuildInfoQuote = do
+  timeStr <- formatTime defaultTimeLocale "-%Y-%m-%d-%H-%M-%S" <$> runIO getCurrentTime
+  stringE $ os ++ "-" ++ arch ++ "-"  ++ map toUpper compilerName
+    ++ "-" ++ showVersion compilerVersion ++ timeStr
+    ++ "-git:" ++ $gitBranch ++ ":" ++ $gitHash
+
+
+
+-- | Use these as a string
+-- @
+--   putStrLn $YuCoreVersionQuote ++ $YuCoreGitCommitQuote
+-- @
src/Yu/Core/Model.hs view
@@ -1,155 +1,175 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TemplateHaskell       #-}--{-|-Module       : Yu.Core.Model-Description  : The module for model-Copyright    : (C) Qinka 2017-Maintainer   : me@qinka.pro-License      : GPL3-Stability    : experimental-Portability  : unknown--The codes for model--}--module Yu.Core.Model-       ( -- * run database-         runDb-       , runDbDefault-       , -- * model-         fetchFrame-       , updateFrame-       , fetchPost-       , updatePost-       , fetchResourceB-       , updateResourceB-       , fetchResourceT-       , updateResourceT-       , fetchStatic-       , updateStatic-       , fetchQuery-       , updateQuery-       , fetchMaybeI-       , fetchMaybeR-       , -- ** for navgation-         fetchNav-       , updateNav-       , deleteNav-       , -- re-export-         module Yu.Core.Model.Internal-       ) where---import           Control.Monad-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control-import           Data.Pool-import           Text.Blaze.Html             (Html (..))-import qualified Text.Blaze.Html             as TBH-import           Yu.Core.Model.Internal-import           Yu.Core.Model.TH-import           Yu.Import-import           Yu.Import.ByteString        (ByteString (..))-import           Yu.Import.Text              (Text (..))-import           Yu.Utils.Handler-import           Yu.Utils.Handler---- | escapted to html-preEscapedToHtml :: Text -> Html-preEscapedToHtml = TBH.preEscapedToHtml---- | about frame-makeFetch 'preEscapedToHtml "frame" ''Html "html" "frame"-makeUpdate                 "frame" ''Text "html" "frame"---- | about post-makeFetch 'preEscapedToHtml "post" ''Html "html" "post"-makeUpdate                 "post" ''Text "html" "post"---- | about text resource-makeFetch 'id "resourceT" ''Text "text" "resource"-makeUpdate   "resourceT" ''Text "text" "resource"---- | about binary resource-makeFetch 'fromBinary "resourceB" ''ByteString "binary" "resource"-makeUpdate           "resourceB" ''Binary "binary" "resource"---- | about static-makeFetch 'id "static" ''Text "url" "static"-makeUpdate   "static" ''Text "url" "static"---- | about query-makeFetch 'id "query" ''Text "var" "query"-makeUpdate   "query" ''Text "var" "query"----- | fetch maybe index-fetchMaybeI :: MonadIO m-              => (ResT -> Action m (Maybe a))  -- ^ funcion for action-              -> [Text] -- ^ index-              -> Action m (Maybe a)-fetchMaybeI mf idx =-  fetchRes idx >>= fetchMaybeR mf---- | fetch maybe resource-fetchMaybeR :: MonadIO m-              => (ResT -> Action m (Maybe a)) -- ^ function for action-              -> Maybe ResT -- ^ index-              -> Action m (Maybe a)-fetchMaybeR mf (Just r) = mf r-fetchMaybeR _  _        = return Nothing---- | fetch the nav-fetchNav :: (MonadBaseControl IO m, MonadIO m)-             => Action m [Nav]-fetchNav = do-  cr <- find $ select [] "nav"-  navs <- map docToNav <$> rest cr-  closeCursor cr-  return $ catMaybes navs---- | update nav-updateNav :: MonadIO m-           => Maybe Text  -- ^ label-           -> Maybe Text  -- ^ url-           -> Maybe Int     -- ^ order-           -> Action m ()-updateNav label url order =-  void $ upsert (select ["label" =: label] "nav") $ catMaybes-  [ Just ("index" =: label)-  , "url"   =@ url-  , "order" =@ order-  ]---- | delete the nav-deleteNav :: MonadIO m-           => Maybe Text -- ^ label ( if it is Nothing, the all nav item will be delete)-           -> Action m ()-deleteNav label =-    delete $ select (catMaybes ["index" =@ label]) "nav"---- | run mongo-runDb :: Mongodic site m-       => AccessMode  -- ^ access mode-       -> Database    -- ^ database-       -> Action m a  -- ^ action-       -> m a-runDb am db mf = getPool >>= \pool ->-  withResource pool $ \p -> do-  (user,pass) <- getDbUP-  access p am db $ do-    auth user pass-    mf---- | run mongo with default-runDbDefault  :: Mongodic site m-                => Action m a  -- ^ action-                -> m a-runDbDefault mf = do-  am <- getDefaultAccessMode-  db <- getDefaultDb-  runDb am db mf-+{-
+ Copyright (C) 2017-2018 Johann Lee
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module       : Yu.Core.Model
+Description  : The module for model
+Copyright    : (C) 2017-2018 Johann Lee <me@qinka.pro>
+Maintainer   : me@qinka.pro
+License      : GPL3
+Stability    : experimental
+Portability  : unknown
+
+The codes for model
+-}
+
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+
+module Yu.Core.Model
+       ( -- * run database
+         runDb
+       , runDbDefault
+       , -- * model
+         fetchFrame
+       , updateFrame
+       , fetchPost
+       , updatePost
+       , fetchResourceB
+       , updateResourceB
+       , fetchResourceT
+       , updateResourceT
+       , fetchStatic
+       , updateStatic
+       , fetchQuery
+       , updateQuery
+       , fetchMaybeI
+       , fetchMaybeR
+       , -- ** for navgation
+         fetchNav
+       , updateNav
+       , deleteNav
+       , -- re-export
+         module Yu.Core.Model.Internal
+       ) where
+
+
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Control
+import           Data.Pool
+import           Text.Blaze.Html             (Html (..))
+import qualified Text.Blaze.Html             as TBH
+import           Yu.Core.Model.Internal
+import           Yu.Core.Model.TH
+import           Yu.Import
+import           Yu.Import.ByteString        (ByteString (..))
+import           Yu.Import.Text              (Text (..))
+import           Yu.Utils.Handler
+import           Yu.Utils.Handler
+
+-- | escapted to html
+preEscapedToHtml :: Text -> Html
+preEscapedToHtml = TBH.preEscapedToHtml
+
+-- | about frame
+makeFetch 'preEscapedToHtml "frame" ''Html "html" "frame"
+makeUpdate                 "frame" ''Text "html" "frame"
+
+-- | about post
+makeFetch 'preEscapedToHtml "post" ''Html "html" "post"
+makeUpdate                 "post" ''Text "html" "post"
+
+-- | about text resource
+makeFetch 'id "resourceT" ''Text "text" "resource"
+makeUpdate   "resourceT" ''Text "text" "resource"
+
+-- | about binary resource
+makeFetch 'fromBinary "resourceB" ''ByteString "binary" "resource"
+makeUpdate           "resourceB" ''Binary "binary" "resource"
+
+-- | about static
+makeFetch 'id "static" ''Text "url" "static"
+makeUpdate   "static" ''Text "url" "static"
+
+-- | about query
+makeFetch 'id "query" ''Text "var" "query"
+makeUpdate   "query" ''Text "var" "query"
+
+
+-- | fetch maybe index
+fetchMaybeI :: MonadIO m
+              => (ResT -> Action m (Maybe a))  -- ^ funcion for action
+              -> [Text] -- ^ index
+              -> Action m (Maybe a)
+fetchMaybeI mf idx =
+  fetchRes idx >>= fetchMaybeR mf
+
+-- | fetch maybe resource
+fetchMaybeR :: MonadIO m
+              => (ResT -> Action m (Maybe a)) -- ^ function for action
+              -> Maybe ResT -- ^ index
+              -> Action m (Maybe a)
+fetchMaybeR mf (Just r) = mf r
+fetchMaybeR _  _        = return Nothing
+
+-- | fetch the nav
+fetchNav :: (MonadBaseControl IO m, MonadIO m)
+             => Action m [Nav]
+fetchNav = do
+  cr <- find $ select [] "nav"
+  navs <- map docToNav <$> rest cr
+  closeCursor cr
+  return $ catMaybes navs
+
+-- | update nav
+updateNav :: MonadIO m
+           => Maybe Text  -- ^ label
+           -> Maybe Text  -- ^ url
+           -> Maybe Int     -- ^ order
+           -> Action m ()
+updateNav label url order =
+  void $ upsert (select ["label" =: label] "nav") $ catMaybes
+  [ Just ("index" =: label)
+  , "url"   =@ url
+  , "order" =@ order
+  ]
+
+-- | delete the nav
+deleteNav :: MonadIO m
+           => Maybe Text -- ^ label ( if it is Nothing, the all nav item will be delete)
+           -> Action m ()
+deleteNav label =
+    delete $ select (catMaybes ["index" =@ label]) "nav"
+
+-- | run mongo
+runDb :: Mongodic site m
+       => AccessMode  -- ^ access mode
+       -> Database    -- ^ database
+       -> Action m a  -- ^ action
+       -> m a
+runDb am db mf = getPool >>= \pool ->
+  withResource pool $ \p -> do
+  (user,pass) <- getDbUP
+  access p am db $ do
+    auth user pass
+    mf
+
+-- | run mongo with default
+runDbDefault  :: Mongodic site m
+                => Action m a  -- ^ action
+                -> m a
+runDbDefault mf = do
+  am <- getDefaultAccessMode
+  db <- getDefaultDb
+  runDb am db mf
+
src/Yu/Core/Model/Internal.hs view
@@ -1,284 +1,303 @@-{-|-Model         : Yu.Core.Model.Internal-Description   : The basic methods for model and types-Copyright     : (C) Qinka 2017-License       : GPL3-Maintainer    : me@qinka.pro-Stability     : experimental-Portability   : unknown--The basic method and type for model in MVC--}--{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverloadedStrings      #-}-{-# LANGUAGE RecordWildCards        #-}-{-# LANGUAGE TypeFamilies           #-}--module Yu.Core.Model.Internal-       ( -- * navigation bar-         Nav(..)-       , navToDoc-       , docToNav-       , -- * the resource-         ResT(..)-       , resToDoc-       , docToRes-       , -- * transform-         fromBinary-       , -- * about mongoDB-         Mongodic(..)-       , ConnectionPool-       , fetchContext-       , fetchRes-       , fetchResAll-       , updateContext-       , updateItem-       , updateRes-       , deleteContext-       , deleteItem-       , deleteRes-       , deleteContextMaybe-       , (=@)-       , module Database.MongoDB-       , module Data.Pool-       ) where--import           Control.Monad.IO.Class-import           Control.Monad.Trans.Control-import           Data.Pool-import           Database.MongoDB-import           Yu.Import-import           Yu.Import.Aeson-import qualified Yu.Import.ByteString        as B-import qualified Yu.Import.Text              as T-import           Yu.Utils.Handler---- | ConnectionPool-type ConnectionPool = Pool Pipe---- | model for navigation bar-data Nav = Nav { navUrl   :: T.Text -- ^ The url of the link-               , navLabel :: T.Text -- ^ The label of the link-               , navOrder :: Int    -- ^ The order of the link-               }-         deriving (Show)---- | instance eq, order for nav-instance Eq Nav where-  n1 == n2 = navOrder n1 == navOrder n2-instance Ord Nav where- compare n1 n2 = compare (navOrder n1) (navOrder n2)---- |transform between nav and document-navToDoc :: Nav -> Document-navToDoc Nav{..} =-  [ "index"   =: navLabel-  , "url"   =: navUrl-  , "order" =: navOrder-  ]---- | transform Document to nav-docToNav :: Document -> Maybe Nav-docToNav doc = Nav-  <$> doc !? "url"-  <*> doc !? "index"-  <*> doc !? "order"---- | instance Json(to)-instance ToJSON Nav where-  toJSON Nav{..} = object-    [ "label" .= navLabel-    , "url" .= navUrl-    , "order" .= navOrder-    ]---- | the resource type for item-data ResT = ResT-            { rIndex   :: [T.Text]      -- ^ the path of the url-            , rRes     :: ObjectId      -- ^ the id of the object in the db-            , rType    :: T.Text        -- ^ the type of resource-            , rCTime   :: UTCTime       -- ^ the time when it created-            , rUTime   :: UTCTime       -- ^ the time when it updated-            , rTitle   :: T.Text        -- ^ the title-            , rSummary :: Maybe T.Text  -- ^ the summary of result-            , rWhose   :: Maybe T.Text  -- ^ the own of the result-            , rMIME    :: Maybe T.Text  -- ^ the MIME type of the result-            , rTags    :: [T.Text]      -- ^ the tags for result-            }-          deriving (Show)--instance Eq ResT where-  res1 == res2 = and-    [ abs (rCTime res1 `diffUTCTime` rCTime res2) <= 1-    , abs (rUTime res1 `diffUTCTime` rUTime res2) <= 1-    , rIndex   res1 == rIndex   res2-    , rRes     res1 == rRes     res2-    , rType    res1 == rType    res2-    , rTitle   res1 == rTitle   res2-    , rSummary res1 == rSummary res2-    , rWhose   res1 == rWhose   res2-    , rMIME    res1 == rMIME    res2-    , rTags    res1 == rTags    res2-    ]---- | transform between res document-resToDoc :: ResT -> Document-resToDoc ResT{..} =-  [ "index"       =: rIndex-  , "res"         =: rRes-  , "type"        =: rType-  , "create-time" =: rCTime-  , "update-time" =: rUTime-  , "title"       =: rTitle-  , "summary"     =: rSummary-  , "whose"       =: rWhose-  , "mime"        =: rMIME-  , "tags"        =: rTags-  ]------ | transform between res document-docToRes :: Document -> Maybe ResT-docToRes doc = ResT-  <$>       doc !? "index"-  <*>       doc !? "res"-  <*>       doc !? "type"-  <*>       doc !? "create-time"-  <*>       doc !? "update-time"-  <*>       doc !? "title"-  <*> Just (doc !? "summary")-  <*> Just (doc !? "whose")-  <*> Just (doc !? "mime")-  <*>  m2l (doc !? "tags")-  where-    m2l (Just xs) = Just xs-    m2l _         = Just []--instance ToJSON ResT where-  toJSON ResT{..} = object-    [ "index"       .= rIndex-    , "type"        .= rType-    , "create-time" .= rCTime-    , "update-time" .= rUTime-    , "title"       .= rTitle-    , "summary"     .= rSummary-    , "whose"       .= rWhose-    , "mime"        .= rMIME-    , "tags"        .= rTags-    ]----- | the type-class which means mongoDB available.-class (MonadIO m,MonadBaseControl IO m) => Mongodic a m | m -> a where-  getDefaultAccessMode :: m AccessMode      -- ^ get the accedd mode-  getDefaultDb          :: m Database        -- ^ get the default database-  getDbUP              :: m (T.Text,T.Text) -- ^ get the user and pass-  getPool                :: m ConnectionPool  -- ^ get the connection pool----- | fetch context-fetchContext :: (MonadIO m,Val a)-              => T.Text    -- ^ field name-              -> ResT      -- ^ resource index-              -> T.Text    -- ^ collection-              -> Action m (Maybe a) -- ^ result-fetchContext field ResT{..} =  ((!? field) <%>).findOne.select ["_id" =: rRes]---- | fetch resource index-fetchRes :: MonadIO m-          => [T.Text]-          -> Action m (Maybe ResT)-fetchRes index = (docToRes <%>) . findOne $ select ["index" =: index] "index"---- | fetch all resource index-fetchResAll :: (MonadIO m, MonadBaseControl IO m)-                 => Action m [ResT]-fetchResAll = do-  cur <- find $ select [] "index"-  rt  <- rest cur-  closeCursor cur-  return . catMaybes $ docToRes <$> rt---- | update context-updateContext :: (MonadIO m, Val a)-               => T.Text            -- ^ collection-               -> Maybe ObjectId    -- ^ obj id of item-               -> T.Text            -- ^ field name-               -> a-               -> Action m ObjectId -- ^ return id-updateContext c oid field v = case oid of-  Just i -> upsert (select ["_id" =: i] c) [field =: v] >> return i-  _      -> (\(ObjId i) -> i) <$> insert c [field =: v]---- | the update for item-updateItem :: (MonadIO m, Val a)-            => T.Text   -- ^ type, or say collection-            -> T.Text   -- ^ field name-            -> a        -- ^ item-            -> ResT     -- ^ ``undefined'' ResT-            -> Action m ()-updateItem t f v uR = do-  let index = rIndex uR-  res <- fetchRes index-  rr <- if (rType <$> res) /= Just t-        then deleteContextMaybe res >> return Nothing-        else return $ rRes <$> res-  rO <- updateContext t rr f v-  updateRes (uR {rRes = rO})---- | the update for resource-updateRes :: MonadIO m-           => ResT     -- ^ the index-           -> Action m ()-updateRes res@ResT{..} =-  upsert (select ["index" =: rIndex] "index") $ resToDoc res---- | delete the context-deleteContext :: MonadIO m-               => ResT           -- ^ index-               -> T.Text         -- ^ collection-               -> Action m ()-deleteContext ResT{..} c =-  delete $ select ["_id" =: rRes] c----- | delete resource-deleteRes :: MonadIO m-           => ResT        -- ^ index-           -> Action m ()-deleteRes ResT{..} =-  delete $ select ["index" =: rIndex] "index"---- | delete the resouce in maybe-deleteContextMaybe :: MonadIO m-                     => Maybe ResT -- ^ index-                     -> Action m ()-deleteContextMaybe (Just r) = deleteContext r $ rType r-deleteContextMaybe _        = return ()---- | delete item-deleteItem :: MonadIO m-            => [T.Text] -- ^ url-            -> T.Text   -- ^ collection-            -> Action m ()-deleteItem index c = fetchRes index >>=-  (\res -> case res of-      Just r -> deleteContext r c >> deleteRes r-      _      -> return ())---- | Binary to ByteString-fromBinary :: Binary -> B.ByteString-fromBinary (Binary b) = b----- | update nothing-infix 0 =@-(=@) :: Val v-     => Label        -- ^ label-     -> Maybe v      -- ^ value-     -> Maybe Field  -- ^ maybe field-(=@) l = ((Just.(l =:)) =<<)+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Model         : Yu.Core.Model.Internal
+Description   : The basic methods for model and types
+Copyright     : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License       : GPL3
+Maintainer    : me@qinka.pro
+Stability     : experimental
+Portability   : unknown
+
+The basic method and type for model in MVC
+-}
+
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE RecordWildCards        #-}
+{-# LANGUAGE TypeFamilies           #-}
+
+module Yu.Core.Model.Internal
+  ( -- * navigation bar
+    Nav(..)
+  , navToDoc
+  , docToNav
+  , -- * the resource
+    ResT(..)
+  , resToDoc
+  , docToRes
+  , -- * transform
+    fromBinary
+  , -- * about mongoDB
+    Mongodic(..)
+  , ConnectionPool
+  , fetchContext
+  , fetchRes
+  , fetchResAll
+  , updateContext
+  , updateItem
+  , updateRes
+  , deleteContext
+  , deleteItem
+  , deleteRes
+  , deleteContextMaybe
+  , (=@)
+  , module Database.MongoDB
+  , module Data.Pool
+  ) where
+
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Control
+import           Data.Pool
+import           Database.MongoDB
+import           Yu.Import
+import           Yu.Import.Aeson
+import qualified Yu.Import.ByteString        as B
+import qualified Yu.Import.Text              as T
+import           Yu.Utils.Handler
+
+-- | ConnectionPool
+type ConnectionPool = Pool Pipe
+
+-- | model for navigation bar
+data Nav = Nav { navUrl   :: T.Text -- ^ The url of the link
+               , navLabel :: T.Text -- ^ The label of the link
+               , navOrder :: Int    -- ^ The order of the link
+               }
+         deriving (Show)
+
+-- | instance eq, order for nav
+instance Eq Nav where
+  n1 == n2 = navOrder n1 == navOrder n2
+instance Ord Nav where
+ compare n1 n2 = compare (navOrder n1) (navOrder n2)
+
+-- |transform between nav and document
+navToDoc :: Nav -> Document
+navToDoc Nav{..} =
+  [ "index"   =: navLabel
+  , "url"   =: navUrl
+  , "order" =: navOrder
+  ]
+
+-- | transform Document to nav
+docToNav :: Document -> Maybe Nav
+docToNav doc = Nav
+  <$> doc !? "url"
+  <*> doc !? "index"
+  <*> doc !? "order"
+
+-- | instance Json(to)
+instance ToJSON Nav where
+  toJSON Nav{..} = object
+    [ "label" .= navLabel
+    , "url" .= navUrl
+    , "order" .= navOrder
+    ]
+
+-- | the resource type for item
+data ResT = ResT
+            { rIndex   :: [T.Text]      -- ^ the path of the url
+            , rRes     :: ObjectId      -- ^ the id of the object in the db
+            , rType    :: T.Text        -- ^ the type of resource
+            , rCTime   :: UTCTime       -- ^ the time when it created
+            , rUTime   :: UTCTime       -- ^ the time when it updated
+            , rTitle   :: T.Text        -- ^ the title
+            , rSummary :: Maybe T.Text  -- ^ the summary of result
+            , rWhose   :: Maybe T.Text  -- ^ the own of the result
+            , rMIME    :: Maybe T.Text  -- ^ the MIME type of the result
+            , rTags    :: [T.Text]      -- ^ the tags for result
+            }
+          deriving (Show)
+
+instance Eq ResT where
+  res1 == res2 = and
+    [ abs (rCTime res1 `diffUTCTime` rCTime res2) <= 1
+    , abs (rUTime res1 `diffUTCTime` rUTime res2) <= 1
+    , rIndex   res1 == rIndex   res2
+    , rRes     res1 == rRes     res2
+    , rType    res1 == rType    res2
+    , rTitle   res1 == rTitle   res2
+    , rSummary res1 == rSummary res2
+    , rWhose   res1 == rWhose   res2
+    , rMIME    res1 == rMIME    res2
+    , rTags    res1 == rTags    res2
+    ]
+
+-- | transform between res document
+resToDoc :: ResT -> Document
+resToDoc ResT{..} =
+  [ "index"       =: rIndex
+  , "res"         =: rRes
+  , "type"        =: rType
+  , "create-time" =: rCTime
+  , "update-time" =: rUTime
+  , "title"       =: rTitle
+  , "summary"     =: rSummary
+  , "whose"       =: rWhose
+  , "mime"        =: rMIME
+  , "tags"        =: rTags
+  ]
+
+
+
+-- | transform between res document
+docToRes :: Document -> Maybe ResT
+docToRes doc = ResT
+  <$>       doc !? "index"
+  <*>       doc !? "res"
+  <*>       doc !? "type"
+  <*>       doc !? "create-time"
+  <*>       doc !? "update-time"
+  <*>       doc !? "title"
+  <*> Just (doc !? "summary")
+  <*> Just (doc !? "whose")
+  <*> Just (doc !? "mime")
+  <*>  m2l (doc !? "tags")
+  where
+    m2l (Just xs) = Just xs
+    m2l _         = Just []
+
+instance ToJSON ResT where
+  toJSON ResT{..} = object
+    [ "index"       .= rIndex
+    , "type"        .= rType
+    , "create-time" .= rCTime
+    , "update-time" .= rUTime
+    , "title"       .= rTitle
+    , "summary"     .= rSummary
+    , "whose"       .= rWhose
+    , "mime"        .= rMIME
+    , "tags"        .= rTags
+    ]
+
+
+-- | the type-class which means mongoDB available.
+class (MonadIO m,MonadBaseControl IO m) => Mongodic a m | m -> a where
+  getDefaultAccessMode :: m AccessMode      -- ^ get the accedd mode
+  getDefaultDb          :: m Database        -- ^ get the default database
+  getDbUP              :: m (T.Text,T.Text) -- ^ get the user and pass
+  getPool                :: m ConnectionPool  -- ^ get the connection pool
+
+
+-- | fetch context
+fetchContext :: (MonadIO m,Val a)
+              => T.Text    -- ^ field name
+              -> ResT      -- ^ resource index
+              -> T.Text    -- ^ collection
+              -> Action m (Maybe a) -- ^ result
+fetchContext field ResT{..} =  ((!? field) <%>).findOne.select ["_id" =: rRes]
+
+-- | fetch resource index
+fetchRes :: MonadIO m
+          => [T.Text]
+          -> Action m (Maybe ResT)
+fetchRes index = (docToRes <%>) . findOne $ select ["index" =: index] "index"
+
+-- | fetch all resource index
+fetchResAll :: (MonadIO m, MonadBaseControl IO m)
+                 => Action m [ResT]
+fetchResAll = do
+  cur <- find $ select [] "index"
+  rt  <- rest cur
+  closeCursor cur
+  return . catMaybes $ docToRes <$> rt
+
+-- | update context
+updateContext :: (MonadIO m, Val a)
+               => T.Text            -- ^ collection
+               -> Maybe ObjectId    -- ^ obj id of item
+               -> T.Text            -- ^ field name
+               -> a
+               -> Action m ObjectId -- ^ return id
+updateContext c oid field v = case oid of
+  Just i -> upsert (select ["_id" =: i] c) [field =: v] >> return i
+  _      -> (\(ObjId i) -> i) <$> insert c [field =: v]
+
+-- | the update for item
+updateItem :: (MonadIO m, Val a)
+            => T.Text   -- ^ type, or say collection
+            -> T.Text   -- ^ field name
+            -> a        -- ^ item
+            -> ResT     -- ^ ``undefined'' ResT
+            -> Action m ()
+updateItem t f v uR = do
+  let index = rIndex uR
+  res <- fetchRes index
+  rr <- if (rType <$> res) /= Just t
+        then deleteContextMaybe res >> return Nothing
+        else return $ rRes <$> res
+  rO <- updateContext t rr f v
+  updateRes (uR {rRes = rO})
+
+-- | the update for resource
+updateRes :: MonadIO m
+           => ResT     -- ^ the index
+           -> Action m ()
+updateRes res@ResT{..} =
+  upsert (select ["index" =: rIndex] "index") $ resToDoc res
+
+-- | delete the context
+deleteContext :: MonadIO m
+               => ResT           -- ^ index
+               -> T.Text         -- ^ collection
+               -> Action m ()
+deleteContext ResT{..} c =
+  delete $ select ["_id" =: rRes] c
+
+
+-- | delete resource
+deleteRes :: MonadIO m
+           => ResT        -- ^ index
+           -> Action m ()
+deleteRes ResT{..} =
+  delete $ select ["index" =: rIndex] "index"
+
+-- | delete the resouce in maybe
+deleteContextMaybe :: MonadIO m
+                     => Maybe ResT -- ^ index
+                     -> Action m ()
+deleteContextMaybe (Just r) = deleteContext r $ rType r
+deleteContextMaybe _        = return ()
+
+-- | delete item
+deleteItem :: MonadIO m
+            => [T.Text] -- ^ url
+            -> T.Text   -- ^ collection
+            -> Action m ()
+deleteItem index c = fetchRes index >>=
+  (\res -> case res of
+      Just r -> deleteContext r c >> deleteRes r
+      _      -> return ())
+
+-- | Binary to ByteString
+fromBinary :: Binary -> B.ByteString
+fromBinary (Binary b) = b
+
+
+-- | update nothing
+infix 0 =@
+(=@) :: Val v
+     => Label        -- ^ label
+     -> Maybe v      -- ^ value
+     -> Maybe Field  -- ^ maybe field
+(=@) l = ((Just.(l =:)) =<<)
src/Yu/Core/Model/TH.hs view
@@ -1,80 +1,98 @@-{-|-Module        : Yu.Core.Model.TH-Description   : To generate the codes about module-Copyright     : (C) Qinka, 2017-Maintainer    : me@qinka.pro-License       : GPL3-Stability     : experimental-Portability   : unknown--The codes for generate the codes about modules--}---{-# LANGUAGE QuasiQuotes     #-}-{-# LANGUAGE TemplateHaskell #-}--module Yu.Core.Model.TH-       ( makeFetch-       , makeUpdate-       ) where--import           Control.Monad.IO.Class-import           Data.Char-import           Database.MongoDB       as Mongo-import           Yu.Core.Model.Internal-import           Yu.Import.TH----- | Upper case the first letter-firstUpper :: String -> String-firstUpper (x:xs) = toUpper x:xs-firstUpper xs     = xs---- | To create fetchXxx-makeFetch :: Name   -- ^ filter   name-          -> String -- ^ function name-          -> Name   -- ^ type-          -> String -- ^ field name-          -> String -- ^ collection-          -> Q [Dec]-makeFetch func n kind field collection =-  let name = mkName $ "fetch" ++  firstUpper n-      m    = mkName  "m"-      dec = SigD name $ ForallT [PlainTV m] [AppT (ConT ''MonadIO) (VarT m)]-        (AppT-         (AppT ArrowT (ConT ''ResT))-         (AppT (AppT (ConT ''Action) (VarT m)) (AppT (ConT ''Maybe) (ConT kind))))-      resv = mkName "res"-      body = FunD name-        [Clause [VarP resv] (NormalB $-                             (AppE-                              (AppE (VarE $ mkName "<#>") (VarE func))-                               (AppE (AppE (AppE (VarE 'fetchContext)-                                            (LitE $ StringL field))-                                      (VarE resv))-                                (LitE $ StringL collection)))) []]-  in return [dec,body]----- | to create updateXxx-makeUpdate :: String -- ^ function name-            -> Name   -- ^ type-            -> String -- ^ field-            -> String -- ^ collection-            -> Q [Dec]-makeUpdate n kind f c =-  let field = LitE $ StringL f-      coll  = LitE $ StringL c-      name  = mkName $ "update" ++ firstUpper n-      m     = mkName "m"-      dec   = SigD name $ ForallT [PlainTV m] [AppT (ConT ''MonadIO) (VarT m)]-        (AppT-         (AppT ArrowT (ConT kind))-         (AppT (AppT ArrowT (ConT ''ResT))-          (AppT (AppT (ConT ''Action) (VarT m)) (ConT ''()))))-      body  = FunD name-        [Clause [] (NormalB $-                    (AppE (AppE (VarE 'updateItem) coll)-                     field)) []]-  in return [dec,body]+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module        : Yu.Core.Model.TH
+Description   : To generate the codes about module
+Copyright     : (C) 2017-2018 Johann Lee <me@qinka.pro>
+Maintainer    : me@qinka.pro
+License       : GPL3
+Stability     : experimental
+Portability   : unknown
+
+The codes for generate the codes about modules
+-}
+
+{-# LANGUAGE QuasiQuotes     #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Yu.Core.Model.TH
+  ( makeFetch
+  , makeUpdate
+  ) where
+
+import           Control.Monad.IO.Class
+import           Data.Char
+import           Database.MongoDB       as Mongo
+import           Yu.Core.Model.Internal
+import           Yu.Import.TH
+
+
+-- | Upper case the first letter
+firstUpper :: String -> String
+firstUpper (x:xs) = toUpper x:xs
+firstUpper xs     = xs
+
+-- | To create fetchXxx
+makeFetch :: Name   -- ^ filter   name
+          -> String -- ^ function name
+          -> Name   -- ^ type
+          -> String -- ^ field name
+          -> String -- ^ collection
+          -> Q [Dec]
+makeFetch func n kind field collection =
+  let name = mkName $ "fetch" ++  firstUpper n
+      m    = mkName  "m"
+      dec = SigD name $ ForallT [PlainTV m] [AppT (ConT ''MonadIO) (VarT m)]
+        (AppT
+         (AppT ArrowT (ConT ''ResT))
+         (AppT (AppT (ConT ''Action) (VarT m)) (AppT (ConT ''Maybe) (ConT kind))))
+      resv = mkName "res"
+      body = FunD name
+        [Clause [VarP resv] (NormalB $
+                             (AppE
+                              (AppE (VarE $ mkName "<#>") (VarE func))
+                               (AppE (AppE (AppE (VarE 'fetchContext)
+                                            (LitE $ StringL field))
+                                      (VarE resv))
+                                (LitE $ StringL collection)))) []]
+  in return [dec,body]
+
+
+-- | to create updateXxx
+makeUpdate :: String -- ^ function name
+            -> Name   -- ^ type
+            -> String -- ^ field
+            -> String -- ^ collection
+            -> Q [Dec]
+makeUpdate n kind f c =
+  let field = LitE $ StringL f
+      coll  = LitE $ StringL c
+      name  = mkName $ "update" ++ firstUpper n
+      m     = mkName "m"
+      dec   = SigD name $ ForallT [PlainTV m] [AppT (ConT ''MonadIO) (VarT m)]
+        (AppT
+         (AppT ArrowT (ConT kind))
+         (AppT (AppT ArrowT (ConT ''ResT))
+          (AppT (AppT (ConT ''Action) (VarT m)) (ConT ''()))))
+      body  = FunD name
+        [Clause [] (NormalB $
+                    (AppE (AppE (VarE 'updateItem) coll)
+                     field)) []]
+  in return [dec,body]
+ src/Yu/Core/Route.hs view
@@ -0,0 +1,47 @@+{-
+ Coptright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+
+Module      : Yu.Core.Route
+Description : Export the default route configuration of Yu.
+Copyright   : (C) 2017 - 2018 Johann Lee
+License     : GPL3
+Maintainer  : me@qinka.pro
+Stability   : experimental
+Portability : unknow
+
+Export the default router of site.
+-}
+
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module Yu.Core.Route
+  ( yuRoute
+  ) where
+
+import           Yesod.Core
+import           Yesod.Routes.TH.Types
+import           Yu.Core.Control
+
+-- | default router
+yuRoute :: [ResourceTree String]
+yuRoute = [parseRoutes| /*Texts UrlR GET PUT DELETE |]
src/Yu/Core/View.hs view
@@ -1,118 +1,137 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-{-# LANGUAGE RecordWildCards       #-}-{-# LANGUAGE TypeFamilies          #-}--{-|-Module       : Yu.Core.View-Description  : The view of Yu-Copyright    : (C) Qinka 2017-License      : GPL3-Maintainer   : me@qinka.pro-Stability    : experimental-Portability  : unknow--The view part of the Yu.--}---module Yu.Core.View-       ( -- * responds-         respondPost-       , respondResourceT-       , respondResourceB-       , respondStatic-       , -- * reexport module-         module Yu.Core.View.Internal-       , module Yu.Core.View.Query-       ) where--import           Control.Monad.Writer.Lazy-import           Data.Maybe-import           Data.Monoid-import           Network.HTTP.Types        (status301)-import           Text.Blaze.Html           (Html, preEscapedToHtml)-import           Yesod.Core-import           Yesod.Core.Handler-import           Yesod.Core.Widget-import           Yu.Core.Model             (ResT (..))-import           Yu.Core.View.Internal-import           Yu.Core.View.Query-import           Yu.Import.ByteString      (ByteString)-import qualified Yu.Import.ByteString      as B-import           Yu.Import.Text            (Text)-import qualified Yu.Import.Text            as T-import           Yu.Utils.Handler---- | response the post with ResT and html-respondPost :: (Yesod a, Hamletic a (HandlerT a IO))-             => ResT -- ^ resource index-             -> Html -- ^ html body-             -> HandlerT a IO TypedContent-respondPost res@ResT{..} rawBody = do-  willRaw <- getRaw-  isRaw   <- null <$> lookupHeader "YuRAW"-  body    <- if willRaw == isRaw then return rawBody-             else defaultLayout $ withHtml rawBody res-  respondSource "text/html" $ do-    sendChunkHtml body-    sendFlush---- | with tags, import tags to js-withTags :: [Text] -- ^ tags-          -> WidgetT site IO ()-withTags tags = let tagsJ = toJSON tags in toWidget [julius|tags=#{tagsJ};|]---- | with summary, import summary to page when it not Nothing-withSummary :: Maybe Html -- ^ summary html-             -> WidgetT site IO ()-withSummary (Just summaryHtml) = [whamlet|<summary id=sum>#{summaryHtml}|]-withSummary _                  = return ()---- | with whose, import the author to the js-withWhose :: Maybe Text -- ^ author-           -> WidgetT site IO ()-withWhose (Just whose) = let w = showJs whose in toWidget [julius|author=#{w};|]-withWhose _                    = return ()---- | with html combine the parts to one-withHtml :: Html -- ^ the html for main part-          -> ResT -- ^ resource-          -> WidgetT site IO ()-withHtml body ResT{..} = do-  setTitle $ toHtml rTitle-  withSummary $ preEscapedToHtml <$> rSummary-  [whamlet|#{body}|]-  withWhose rWhose-  withTags rTags----- | respond resource(text)-respondResourceT :: (Yesod a, Hamletic a (HandlerT a IO))-                   => ResT    -- ^ resource index-                   -> Text    -- ^ text-                   -> HandlerT a IO TypedContent-respondResourceT ResT{..} text = do-  respondSource (fromMaybe "" $ fmap T.encodeUtf8 rMIME) $ do-    sendChunkText text-    sendFlush---- | respond resource(binary)-respondResourceB :: (Yesod a, Hamletic a (HandlerT a IO))-                   => ResT    -- ^ resource index-                   -> ByteString    -- ^ text-                   -> HandlerT a IO TypedContent-respondResourceB ResT{..} bin = do-  respondSource (fromMaybe "" $ fmap T.encodeUtf8 rMIME) $ do-    sendChunkBS bin-    sendFlush----- | response the static url-respondStatic :: (Yesod a, Hamletic a (HandlerT a IO))-               => ResT -- ^ index for resource-               -> Text -- ^ Url-               -> HandlerT a IO TypedContent-respondStatic _ url = redirectWith status301 url+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module       : Yu.Core.View
+Description  : The view of Yu
+Copyright    : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License      : GPL3
+Maintainer   : me@qinka.pro
+Stability    : experimental
+Portability  : unknow
+
+The view part of the Yu.
+-}
+
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+
+module Yu.Core.View
+  ( -- * responds
+    respondPost
+  , respondResourceT
+  , respondResourceB
+  , respondStatic
+  , -- * reexport module
+    module Yu.Core.View.Internal
+  , module Yu.Core.View.Query
+  ) where
+
+import           Control.Monad.Writer.Lazy
+import           Data.Maybe
+import           Data.Monoid
+import           Network.HTTP.Types        (status301)
+import           Text.Blaze.Html           (Html, preEscapedToHtml)
+import           Yesod.Core
+import           Yesod.Core.Handler
+import           Yesod.Core.Widget
+import           Yu.Core.Model             (ResT (..))
+import           Yu.Core.View.Internal
+import           Yu.Core.View.Query
+import           Yu.Import.ByteString      (ByteString)
+import qualified Yu.Import.ByteString      as B
+import           Yu.Import.Text            (Text)
+import qualified Yu.Import.Text            as T
+import           Yu.Utils.Handler
+
+-- | response the post with ResT and html
+respondPost :: (Yesod a, Hamletic a (HandlerT a IO))
+             => ResT -- ^ resource index
+             -> Html -- ^ html body
+             -> HandlerT a IO TypedContent
+respondPost res@ResT{..} rawBody = do
+  willRaw <- getRaw
+  isRaw   <- null <$> lookupHeader "YuRAW"
+  body    <- if willRaw == isRaw then return rawBody
+             else defaultLayout $ withHtml rawBody res
+  respondSource "text/html" $ do
+    sendChunkHtml body
+    sendFlush
+
+-- | with tags, import tags to js
+withTags :: [Text] -- ^ tags
+          -> WidgetT site IO ()
+withTags tags = let tagsJ = toJSON tags in toWidget [julius|tags=#{tagsJ};|]
+
+-- | with summary, import summary to page when it not Nothing
+withSummary :: Maybe Html -- ^ summary html
+             -> WidgetT site IO ()
+withSummary (Just summaryHtml) = [whamlet|<summary id=sum>#{summaryHtml}|]
+withSummary _                  = return ()
+
+-- | with whose, import the author to the js
+withWhose :: Maybe Text -- ^ author
+           -> WidgetT site IO ()
+withWhose (Just whose) = let w = showJs whose in toWidget [julius|author=#{w};|]
+withWhose _                    = return ()
+
+-- | with html combine the parts to one
+withHtml :: Html -- ^ the html for main part
+          -> ResT -- ^ resource
+          -> WidgetT site IO ()
+withHtml body ResT{..} = do
+  setTitle $ toHtml rTitle
+  withSummary $ preEscapedToHtml <$> rSummary
+  [whamlet|#{body}|]
+  withWhose rWhose
+  withTags rTags
+
+
+-- | respond resource(text)
+respondResourceT :: (Yesod a, Hamletic a (HandlerT a IO))
+                   => ResT    -- ^ resource index
+                   -> Text    -- ^ text
+                   -> HandlerT a IO TypedContent
+respondResourceT ResT{..} text = do
+  respondSource (fromMaybe "" $ fmap T.encodeUtf8 rMIME) $ do
+    sendChunkText text
+    sendFlush
+
+-- | respond resource(binary)
+respondResourceB :: (Yesod a, Hamletic a (HandlerT a IO))
+                   => ResT    -- ^ resource index
+                   -> ByteString    -- ^ text
+                   -> HandlerT a IO TypedContent
+respondResourceB ResT{..} bin = do
+  respondSource (fromMaybe "" $ fmap T.encodeUtf8 rMIME) $ do
+    sendChunkBS bin
+    sendFlush
+
+
+-- | response the static url
+respondStatic :: (Yesod a, Hamletic a (HandlerT a IO))
+               => ResT -- ^ index for resource
+               -> Text -- ^ Url
+               -> HandlerT a IO TypedContent
+respondStatic _ url = redirectWith status301 url
src/Yu/Core/View/Internal.hs view
@@ -1,135 +1,156 @@-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverloadedStrings      #-}-{-# LANGUAGE QuasiQuotes            #-}--{-|-Module       : Yu.Core.View.Internal-Description  : The internal module for view-Copyright    : (C) Qinka 2017-License      : GPL3-Maintainer   : me@qinka.pro-Stability    : experimental-Portability  : unknown--The internal party for View, including Hamletic.--}---module Yu.Core.View.Internal-       ( Hamletic(..)-       , yuLayout-       , yuErrorHandler-         -- * layouts-       , layoutBootstrap-       ) where--import           Yesod.Core-import           Yesod.Core.Handler-import           Yesod.Core.Json-import           Yu.Core.Model-import           Yu.Import.Text     (Text)-import qualified Yu.Import.Text     as T-import           Yu.Utils.Handler---- | Hamtletic------   Limit, and test-class (MonadHandler m, Mongodic a m) => Hamletic a m | m -> a where-  getTitle        :: m Text  -- ^ get title-  getFramePrefix :: m Text  -- ^ get the prefix path of frame-  getVersion      :: m Text  -- ^ get the version of blog itself or application-  getRaw          :: m Bool  -- ^ return raw html----- | layout for layout-type YuLayout site = (  PageContent (Route site)-                       -> Html -- hd-                       -> Text -- title-                       -> Html -- nav-                       -> Html -- top-                       -> Html -- bottom-                       -> ((Route site -> [(Text, Text)] -> Text) -> Html)-                       )---- | layout with bootstrap-layoutBootstrap :: Yesod site => YuLayout site-layoutBootstrap pageContent hd title nav top bottom = [hamlet|-  $newline never-  $doctype 5-  <html>-    <head>-      <title> #{pageTitle pageContent} - #{title}-      <meta charset=utf-8>-      <meta name=viewport content="width=device-width,initial-scale=1.0,maximum-scale=1.0,user-scalable=no">-      #{hd}-      ^{pageHead pageContent}-    <body>-      #{nav}-      <div id="container">-        #{top}-        <div id="main-part">-          ^{pageBody pageContent}-      #{bottom}-  |]--{-|-The example, or say template for layout--@-layoutXx pageContent hd title nav top bottom = [hamlet|-  $newline never-  $doctype 5-  \<html>\-    \<head\>-      \<title\> #{pageTitle pageContent} - #{title}-      \<meta charset=utf-8\>-      \<meta name=viewport content="width=device-width,initial-scale=1.0,maximum-scale=1.0,user-scalable=no"\>-      #{hd}-      ^{pageHead pageContent}-    \<body\>-      #{nav}-      #{top}-      ^{pageBody pageContent}-      #{bottom}-  |]-@--}---- | the default of yu with Yesod-yuLayout :: (Hamletic a (HandlerT a IO),Yesod a)-            => YuLayout a        -- ^ the layout for yu-            -> WidgetT a IO ()     -- ^ widget-            -> HandlerT a IO Html  -- ^ return-yuLayout layout w = do-  framePrefix <- getFramePrefix-  title        <- getTitle-  pageContent <- widgetToPageContent w-  htmls <- runDbDefault $ do-    topHtml    <- fetchMaybeI fetchFrame [framePrefix,"top"]-    bottomHtml <- fetchMaybeI fetchFrame [framePrefix,"bottom"]-    navHtml    <- fetchMaybeI fetchFrame [framePrefix,"nav"]-    header      <- fetchMaybeI fetchFrame [framePrefix,"header"]-    case (topHtml,bottomHtml,navHtml,header) of-      (Just top, Just bottom, Just nav, Just hd) -> return $ Right (top,bottom,nav,hd)-      _                                          -> return $ Left "cannot launch frames"-  case htmls of-    Left err -> error err-    Right (top,bottom,nav,hd) -> withUrlRenderer $ layout pageContent hd title nav top bottom------ | handler the error-yuErrorHandler :: Yesod site-                      => ErrorResponse -- ^ error-                      -> HandlerT site IO TypedContent-yuErrorHandler er = selectRep $ do-  provideJson er-  provideRep $-    defaultLayout [whamlet|-                          <h1> error-                          <p> #{T.show er}-                          |]--+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-|
+Module       : Yu.Core.View.Internal
+Description  : The internal module for view
+Copyright    : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License      : GPL3
+Maintainer   : me@qinka.pro
+Stability    : experimental
+Portability  : unknown
+
+The internal party for View, including Hamletic.
+-}
+
+
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE QuasiQuotes            #-}
+
+
+module Yu.Core.View.Internal
+  ( Hamletic(..)
+  , yuLayout
+  , yuErrorHandler
+    -- * layouts
+  , layoutBootstrap
+  ) where
+
+import           Yesod.Core
+import           Yesod.Core.Handler
+import           Yesod.Core.Json
+import           Yu.Core.Model
+import           Yu.Import.Text     (Text)
+import qualified Yu.Import.Text     as T
+import           Yu.Utils.Handler
+
+-- | Hamtletic
+--
+--   Limit, and test
+class (MonadHandler m, Mongodic a m) => Hamletic a m | m -> a where
+  getTitle        :: m Text  -- ^ get title
+  getFramePrefix :: m Text  -- ^ get the prefix path of frame
+  getVersion      :: m Text  -- ^ get the version of blog itself or application
+  getRaw          :: m Bool  -- ^ return raw html
+
+
+-- | layout for layout
+type YuLayout site = (  PageContent (Route site)
+                       -> Html -- hd
+                       -> Text -- title
+                       -> Html -- nav
+                       -> Html -- top
+                       -> Html -- bottom
+                       -> ((Route site -> [(Text, Text)] -> Text) -> Html)
+                       )
+
+-- | layout with bootstrap
+layoutBootstrap :: Yesod site => YuLayout site
+layoutBootstrap pageContent hd title nav top bottom = [hamlet|
+  $newline never
+  $doctype 5
+  <html>
+    <head>
+      <title> #{pageTitle pageContent} - #{title}
+      <meta charset=utf-8>
+      <script src=prelude.js>
+      <meta name=viewport content="width=device-width,initial-scale=1.0,maximum-scale=1.0,user-scalable=no">
+      #{hd}
+      ^{pageHead pageContent}
+    <body>
+      #{nav}
+      <div id="container">
+        #{top}
+        <div id="main-part">
+          ^{pageBody pageContent}
+      #{bottom}
+  |]
+
+{-|
+The example, or say template for layout
+
+@
+layoutXx pageContent hd title nav top bottom = [hamlet|
+  $newline never
+  $doctype 5
+  \<html>\
+    \<head\>
+      \<title\> #{pageTitle pageContent} - #{title}
+      \<meta charset=utf-8\>
+      \<meta name=viewport content="width=device-width,initial-scale=1.0,maximum-scale=1.0,user-scalable=no"\>
+      #{hd}
+      ^{pageHead pageContent}
+    \<body\>
+      #{nav}
+      #{top}
+      ^{pageBody pageContent}
+      #{bottom}
+  |]
+@
+-}
+
+-- | the default of yu with Yesod
+yuLayout :: (Hamletic a (HandlerT a IO),Yesod a)
+            => YuLayout a        -- ^ the layout for yu
+            -> WidgetT a IO ()     -- ^ widget
+            -> HandlerT a IO Html  -- ^ return
+yuLayout layout w = do
+  framePrefix <- getFramePrefix
+  title        <- getTitle
+  pageContent <- widgetToPageContent w
+  htmls <- runDbDefault $ do
+    topHtml    <- fetchMaybeI fetchFrame [framePrefix,"top"]
+    bottomHtml <- fetchMaybeI fetchFrame [framePrefix,"bottom"]
+    navHtml    <- fetchMaybeI fetchFrame [framePrefix,"nav"]
+    header      <- fetchMaybeI fetchFrame [framePrefix,"header"]
+    case (topHtml,bottomHtml,navHtml,header) of
+      (Just top, Just bottom, Just nav, Just hd) -> return $ Right (top,bottom,nav,hd)
+      _                                          -> return $ Left "cannot launch frames"
+  case htmls of
+    Left err -> error err
+    Right (top,bottom,nav,hd) -> withUrlRenderer $ layout pageContent hd title nav top bottom
+
+
+
+-- | handler the error
+yuErrorHandler :: Yesod site
+                      => ErrorResponse -- ^ error
+                      -> HandlerT site IO TypedContent
+yuErrorHandler er = selectRep $ do
+  provideJson er
+  provideRep $
+    defaultLayout [whamlet|
+                          <h1> error
+                          <p> #{T.show er}
+                          |]
+
+
src/Yu/Core/View/Query.hs view
@@ -1,103 +1,122 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TemplateHaskell       #-}---{-|-Module        : Yu.Core.View.Query-Description   : The view for query and nav-Copyright     : (C) Qinka 2017-License       : GPLv3+-Maintainer    : me@qinka.pro-Stability     : experimental-Portability   : unknown--The View part for query command, nav query.--}----module Yu.Core.View.Query-       ( -- * querys-         -- ** query version-         queryVersion-       , queryVersionAuthor-       , queryVersionUtils-       , queryVersionCore-       , -- ** name-         queryName-       , -- ** build info-         queryBuildInfo-       , -- ** server time-         queryServerTime-       , -- ** navbar-         queryNav-       , -- ** index-         queryIndex-       , -- ** normal query-         queryQuery-       ) where--import           Data.Time-import           Yesod.Core-import           Yu.Auth.Info-import           Yu.Core.Info-import           Yu.Core.Model.Internal    (Nav, ResT)-import           Yu.Core.View.Internal-import           Yu.Core.View.Query.Parsec-import           Yu.Import-import           Yu.Import.Aeson-import           Yu.Import.Text            (Text)-import qualified Yu.Import.Text            as T-import           Yu.Utils.Info---- | version of Blog version-queryVersion :: Hamletic a (HandlerT a IO)-              => HandlerT a IO TypedContent-queryVersion = getVersion >>= respondSource "text/plain" . sendChunkText---- | version of yu-core-queryVersionAuthor :: HandlerT a IO TypedContent-queryVersionAuthor = respondSource "text/plain" $ sendChunkText $yuAuthVersionQuote---- | version of yu-utils-queryVersionUtils :: HandlerT a IO TypedContent-queryVersionUtils = respondSource "text/plain" $ sendChunkText $yuUtilsVersionQuote---- | version of glov-core-queryVersionCore :: HandlerT a IO TypedContent-queryVersionCore = respondSource "text/plain" $ sendChunkText $yuCoreVersionQuote---- | name of this-queryName :: HandlerT a IO TypedContent-queryName = respondSource "text/plain" $ sendChunkText "Yu"---- | build information-queryBuildInfo :: HandlerT a IO TypedContent-queryBuildInfo = respondSource "text/plain" $ sendChunkText $yuBuildInfoQuote---- | server time-queryServerTime :: HandlerT a IO TypedContent-queryServerTime = T.show <$> (liftIO getCurrentTime) >>= respondSource "text/plain" . sendChunkText---- | fetch the list for nav-queryNav :: [Nav] -- ^ navs (from Model)-          -> HandlerT a IO TypedContent-queryNav = respondSource "application/json" . sendChunkLBS . encode---- | index-queryIndex :: String -- ^ parameters-            -> [ResT] -- ^ resources index (from Model)-            -> HandlerT a IO TypedContent-queryIndex t = respondSource "application/json" . sendChunkLBS . encode . (run $ runQp t)-  where run (Left e)  = error $ show e-        run (Right i) = i---- | query-queryQuery :: Text -- ^ query value (from Model)-            -> HandlerT a IO TypedContent-queryQuery t = respondSource "text/plain" $ do-  sendChunkText t-  sendFlush-+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+
+{-|
+Module        : Yu.Core.View.Query
+Description   : The view for query and nav
+Copyright     : (C) 2017-2018 Johann Lee <me@qinka.pro>
+License       : GPLv3+
+Maintainer    : me@qinka.pro
+Stability     : experimental
+Portability   : unknown
+
+The View part for query command, nav query.
+-}
+
+
+
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Yu.Core.View.Query
+  ( -- * querys
+    -- ** query version
+    queryVersion
+  , queryVersionAuthor
+  , queryVersionUtils
+  , queryVersionCore
+  , -- ** name
+    queryName
+  , -- ** build info
+    queryBuildInfo
+  , -- ** server time
+    queryServerTime
+  , -- ** navbar
+    queryNav
+  , -- ** index
+    queryIndex
+  , -- ** normal query
+    queryQuery
+  ) where
+
+import           Data.Time
+import           Yesod.Core
+import           Yu.Auth.Info
+import           Yu.Core.Info
+import           Yu.Core.Model.Internal    (Nav, ResT)
+import           Yu.Core.View.Internal
+import           Yu.Core.View.Query.Parsec
+import           Yu.Import
+import           Yu.Import.Aeson
+import           Yu.Import.Text            (Text)
+import qualified Yu.Import.Text            as T
+import           Yu.Utils.Info
+
+-- | version of Blog version
+queryVersion :: Hamletic a (HandlerT a IO)
+              => HandlerT a IO TypedContent
+queryVersion = getVersion >>= respondSource "text/plain" . sendChunkText
+
+-- | version of yu-core
+queryVersionAuthor :: HandlerT a IO TypedContent
+queryVersionAuthor = respondSource "text/plain" $ sendChunkText $yuAuthVersionQuote
+
+-- | version of yu-utils
+queryVersionUtils :: HandlerT a IO TypedContent
+queryVersionUtils = respondSource "text/plain" $ sendChunkText $yuUtilsVersionQuote
+
+-- | version of glov-core
+queryVersionCore :: HandlerT a IO TypedContent
+queryVersionCore = respondSource "text/plain" $ sendChunkText $yuCoreVersionQuote
+
+-- | name of this
+queryName :: HandlerT a IO TypedContent
+queryName = respondSource "text/plain" $ sendChunkText "Yu"
+
+-- | build information
+queryBuildInfo :: HandlerT a IO TypedContent
+queryBuildInfo = respondSource "text/plain" $ sendChunkText $yuBuildInfoQuote
+
+-- | server time
+queryServerTime :: HandlerT a IO TypedContent
+queryServerTime = T.show <$> (liftIO getCurrentTime) >>= respondSource "text/plain" . sendChunkText
+
+-- | fetch the list for nav
+queryNav :: [Nav] -- ^ navs (from Model)
+          -> HandlerT a IO TypedContent
+queryNav = respondSource "application/json" . sendChunkLBS . encode
+
+-- | index
+queryIndex :: String -- ^ parameters
+            -> [ResT] -- ^ resources index (from Model)
+            -> HandlerT a IO TypedContent
+queryIndex t = respondSource "application/json" . sendChunkLBS . encode . (run $ runQp t)
+  where run (Left e)  = error $ show e
+        run (Right i) = i
+
+-- | query
+queryQuery :: Text -- ^ query value (from Model)
+            -> HandlerT a IO TypedContent
+queryQuery t = respondSource "text/plain" $ do
+  sendChunkText t
+  sendFlush
+
src/Yu/Core/View/Query/Parsec.hs view
@@ -1,147 +1,167 @@-{-# LANGUAGE RecordWildCards #-}--{-|-Module      : Yu.Core.View.Query.Parsec-Description : The parsec for query command-Copyright   : (C) Qinka 2017-License     : GPL v3+-Maintainer  : me@qinka.pro-Stability   : experimental-Portability : unknown--This module is for the query command, to parsec the query command--}--module Yu.Core.View.Query.Parsec-       ( -- | parse the query command for query-         ---         -- $query-         runQp-       ) where--import           Data.Time-import           Text.Parsec-import           Yu.Core.Model  (ResT (..))-import qualified Yu.Import.Text as T---- $query commands------ The query commands include--- * type={t,f}={post,text,binary,query,..}--- * take=SIZE--- * drop=SIZE--- * befor=DATE--- * after=DATE--- * tag={t,f}=TAG--- * or--- * and--- * true--- * false----- | the ADT for parser-data QueryParser = QPTake  Int                 -- ^ like @take@-                 | QPDrop  Int                 -- ^ like @drop@-                 | QPBefor UTCTime      Bool   -- ^ select those whose dates are earlier than given date-                 | QPAfter UTCTime      Bool   -- ^ select those whose dates are later than given date-                 | QPTag   Bool         String -- ^ select those whose tags include or not include given tag-                 | QPType  Bool         String -- ^ select those whose content's type include or not include-                                               --   given type-                 | QPOr   [QueryParser]        -- ^ like @or@-                 | QPAnd  [QueryParser]        -- ^ like @and@-                 deriving (Show)----- | get an empty command-qpEmpty :: Parsec String () [QueryParser]-qpEmpty = do-  string ";"-  return []--- | get the command type-qpType :: Parsec String () [QueryParser]-qpType = do-  t <- string "type=" *> oneOf ['t','f'] <* char '='-  typ <- many letter <* char ';'-  return [QPType (t=='t') typ]--- | get command take-qpTake :: Parsec String () [QueryParser]-qpTake = do-  len <- string "take=" *> many (oneOf ['0'..'9']) <* char ';'-  return [QPTake (read len)]--- | get command drop-qpDrop :: Parsec String () [QueryParser]-qpDrop = do-  len <- string "drop=" *> many (oneOf ['0'..'9']) <* char ';'-  return [QPDrop (read len)]--- | get command befor-qpBefor :: Parsec String () [QueryParser]-qpBefor = do-  date <- parseTimeM True defaultTimeLocale "%F+%T" =<<-    (string "befor=" *> many (noneOf "@") <* char '@')-  b <- true <|> false <* char ';'-  return [QPBefor date b]--- | get true-true :: Parsec String () Bool-true = string "true" >> return True--- | get false-false :: Parsec String () Bool-false = string "false" >> return False--- | get command after-qpAfter :: Parsec String () [QueryParser]-qpAfter = do-  date <- parseTimeM True defaultTimeLocale "%F+%T" =<<-    (string "after=" *> many (noneOf "@") <* char '@')-  b <- true <|> false <* char ';'-  return [QPAfter date b]--- | get command tag-qpTag :: Parsec String () [QueryParser]-qpTag = do-  t <- string "tag=" *> oneOf ['t','f'] <* char '='-  tag <- many (noneOf ";") <* char ';'-  return [QPTag (t=='t') tag]--- | get command and-qpAnd :: Parsec String () [QueryParser]-qpAnd = do-  sub <- char '[' *> many qps <* char ']'-  return [QPAnd $ concat sub]--- | get command or-qpOr :: Parsec String () [QueryParser]-qpOr = do-  sub <- char '{' *> many qps <* char '}'-  return [QPOr $ concat sub]--- | parser for query command-qp :: Parsec String () [QueryParser]-qp =  concat <$> many qps--- | single command-qps :: Parsec String () [QueryParser]-qps = foldl (<|>) qpEmpty $ try <$>-  [qpTake,qpDrop,qpBefor,qpAfter,qpTag,qpOr,qpAnd-  , qpType-  ]---- | transform to filter-toFilter :: [QueryParser] -> ([ResT] -> [ResT])-toFilter [] = id-toFilter (QPTake i:xs) = take i . toFilter xs-toFilter (QPDrop i:xs) = drop i . toFilter xs-toFilter (QPBefor i b:xs) = filter (timeFilter i (>) b) . toFilter xs-toFilter (QPAfter i b:xs) = filter (timeFilter i (<) b) . toFilter xs-toFilter (QPTag  t i:xs) = filter ((==t) . tagFilter i) . toFilter xs-toFilter (QPType t i:xs) = filter ((==t) . typFilter i) . toFilter xs-toFilter (QPOr s:xs) = concat . map sg . toFilter xs-  where funcs = (\y -> toFilter [y]) <$> s-        sg y = take 1 $ concatMap (\f -> f [y]) funcs-toFilter (QPAnd s:xs) = toFilter s . toFilter xs--typFilter :: String -> ResT -> Bool-typFilter t ResT{..} = rType == T.pack t-tagFilter :: String -> ResT -> Bool-tagFilter t ResT{..} = T.pack t `elem` rTags-timeFilter :: UTCTime -> (UTCTime -> UTCTime -> Bool) -> Bool -> ResT -> Bool-timeFilter t o b ResT{..} = t `o` resTime-  where resTime = if b then rCTime else rUTime---- | transform the command to function-runQp :: String -> Either ParseError ([ResT]->[ResT])-runQp str = toFilter <$> runP qp () "QueryPaserError" str-+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+
+{-|
+Module      : Yu.Core.View.Query.Parsec
+Description : The parsec for query command
+Copyright   : (C) 2017-2018 Johann Lee
+License     : GPL v3+
+Maintainer  : me@qinka.pro
+Stability   : experimental
+Portability : unknown
+
+This module is for the query command, to parsec the query command
+-}
+
+{-# LANGUAGE RecordWildCards #-}
+
+module Yu.Core.View.Query.Parsec
+  ( -- | parse the query command for query
+    --
+    -- $query
+    runQp
+  ) where
+
+import           Data.Time
+import           Text.Parsec
+import           Yu.Core.Model  (ResT (..))
+import qualified Yu.Import.Text as T
+
+-- $query commands
+--
+-- The query commands include
+-- * type={t,f}={post,text,binary,query,..}
+-- * take=SIZE
+-- * drop=SIZE
+-- * befor=DATE
+-- * after=DATE
+-- * tag={t,f}=TAG
+-- * or
+-- * and
+-- * true
+-- * false
+
+
+-- | the ADT for parser
+data QueryParser = QPTake  Int                 -- ^ like @take@
+                 | QPDrop  Int                 -- ^ like @drop@
+                 | QPBefor UTCTime      Bool   -- ^ select those whose dates are earlier than given date
+                 | QPAfter UTCTime      Bool   -- ^ select those whose dates are later than given date
+                 | QPTag   Bool         String -- ^ select those whose tags include or not include given tag
+                 | QPType  Bool         String -- ^ select those whose content's type include or not include
+                                               --   given type
+                 | QPOr   [QueryParser]        -- ^ like @or@
+                 | QPAnd  [QueryParser]        -- ^ like @and@
+                 deriving (Show)
+
+
+-- | get an empty command
+qpEmpty :: Parsec String () [QueryParser]
+qpEmpty = do
+  string ";"
+  return []
+-- | get the command type
+qpType :: Parsec String () [QueryParser]
+qpType = do
+  t <- string "type=" *> oneOf ['t','f'] <* char '='
+  typ <- many letter <* char ';'
+  return [QPType (t=='t') typ]
+-- | get command take
+qpTake :: Parsec String () [QueryParser]
+qpTake = do
+  len <- string "take=" *> many (oneOf ['0'..'9']) <* char ';'
+  return [QPTake (read len)]
+-- | get command drop
+qpDrop :: Parsec String () [QueryParser]
+qpDrop = do
+  len <- string "drop=" *> many (oneOf ['0'..'9']) <* char ';'
+  return [QPDrop (read len)]
+-- | get command befor
+qpBefor :: Parsec String () [QueryParser]
+qpBefor = do
+  date <- parseTimeM True defaultTimeLocale "%F+%T" =<<
+    (string "befor=" *> many (noneOf "@") <* char '@')
+  b <- true <|> false <* char ';'
+  return [QPBefor date b]
+-- | get true
+true :: Parsec String () Bool
+true = string "true" >> return True
+-- | get false
+false :: Parsec String () Bool
+false = string "false" >> return False
+-- | get command after
+qpAfter :: Parsec String () [QueryParser]
+qpAfter = do
+  date <- parseTimeM True defaultTimeLocale "%F+%T" =<<
+    (string "after=" *> many (noneOf "@") <* char '@')
+  b <- true <|> false <* char ';'
+  return [QPAfter date b]
+-- | get command tag
+qpTag :: Parsec String () [QueryParser]
+qpTag = do
+  t <- string "tag=" *> oneOf ['t','f'] <* char '='
+  tag <- many (noneOf ";") <* char ';'
+  return [QPTag (t=='t') tag]
+-- | get command and
+qpAnd :: Parsec String () [QueryParser]
+qpAnd = do
+  sub <- char '[' *> many qps <* char ']'
+  return [QPAnd $ concat sub]
+-- | get command or
+qpOr :: Parsec String () [QueryParser]
+qpOr = do
+  sub <- char '{' *> many qps <* char '}'
+  return [QPOr $ concat sub]
+-- | parser for query command
+qp :: Parsec String () [QueryParser]
+qp =  concat <$> many qps
+-- | single command
+qps :: Parsec String () [QueryParser]
+qps = foldl (<|>) qpEmpty $ try <$>
+  [qpTake,qpDrop,qpBefor,qpAfter,qpTag,qpOr,qpAnd
+  , qpType
+  ]
+
+-- | transform to filter
+toFilter :: [QueryParser] -> ([ResT] -> [ResT])
+toFilter [] = id
+toFilter (QPTake i:xs) = take i . toFilter xs
+toFilter (QPDrop i:xs) = drop i . toFilter xs
+toFilter (QPBefor i b:xs) = filter (timeFilter i (>) b) . toFilter xs
+toFilter (QPAfter i b:xs) = filter (timeFilter i (<) b) . toFilter xs
+toFilter (QPTag  t i:xs) = filter ((==t) . tagFilter i) . toFilter xs
+toFilter (QPType t i:xs) = filter ((==t) . typFilter i) . toFilter xs
+toFilter (QPOr s:xs) = concat . map sg . toFilter xs
+  where funcs = (\y -> toFilter [y]) <$> s
+        sg y = take 1 $ concatMap (\f -> f [y]) funcs
+toFilter (QPAnd s:xs) = toFilter s . toFilter xs
+
+typFilter :: String -> ResT -> Bool
+typFilter t ResT{..} = rType == T.pack t
+tagFilter :: String -> ResT -> Bool
+tagFilter t ResT{..} = T.pack t `elem` rTags
+timeFilter :: UTCTime -> (UTCTime -> UTCTime -> Bool) -> Bool -> ResT -> Bool
+timeFilter t o b ResT{..} = t `o` resTime
+  where resTime = if b then rCTime else rUTime
+
+-- | transform the command to function
+runQp :: String -> Either ParseError ([ResT]->[ResT])
+runQp str = toFilter <$> runP qp () "QueryPaserError" str
+
test-src/Internal.hs view
@@ -1,34 +1,53 @@-{-# LANGUAGE OverloadedStrings #-}--module Internal-  ( module Database.MongoDB-  , module Control.Exception-  , runDB-  , testDBName-  ) where---import           Control.Exception-import           Database.MongoDB-import           System.Environment-import           System.IO.Error    (catchIOError)-import qualified Yu.Import.Text     as T----- | envrionment variable for mongo db url-mongoHostEnvVar :: String-mongoHostEnvVar = "MONGODB_URL"---- | test database name-testDBName :: T.Text-testDBName = "test"---- | run db action-runDB :: Action IO a -> IO a-runDB action = do-    mongodbHost <- getEnv mongoHostEnvVar `catchIOError` (\_ -> return "localhost")-    pipe <- connect (readHostPort mongodbHost)-    result <- access pipe master testDBName action-    close pipe-    return result-+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Internal
+  ( module Database.MongoDB
+  , module Control.Exception
+  , runDB
+  , testDBName
+  ) where
+
+
+import           Control.Exception
+import           Database.MongoDB
+import           System.Environment
+import           System.IO.Error    (catchIOError)
+import qualified Yu.Import.Text     as T
+
+
+-- | envrionment variable for mongo db url
+mongoHostEnvVar :: String
+mongoHostEnvVar = "MONGODB_URL"
+
+-- | test database name
+testDBName :: T.Text
+testDBName = "test"
+
+-- | run db action
+runDB :: Action IO a -> IO a
+runDB action = do
+    mongodbHost <- getEnv mongoHostEnvVar `catchIOError` (\_ -> return "localhost")
+    pipe <- connect (readHostPort mongodbHost)
+    result <- access pipe master testDBName action
+    close pipe
+    return result
+
test-src/ModelSpec.hs view
@@ -1,549 +1,568 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}---- | The test module for model for glob-module ModelSpec-  ( spec-  ) where--import           Control.Monad-import           Data.IORef-import qualified Data.Text.Lazy           as TL-import           Data.Time                (UTCTime, diffUTCTime, getCurrentTime)-import           Internal-import           System.IO-import           Test.Hspec-import           Text.Blaze.Renderer.Text-import           Yu.Core.Model-import qualified Yu.Import.Text           as T---- | step one: get pipe-getPipe :: IO Pipe-getPipe = connect $ readHostPort "localhost:27017"--cleanDatabase :: IO ()-cleanDatabase = void $ runDB $ dropDatabase testDBName---spec :: Spec-spec = do-  runIO $ putStrLn "Test for Model part for Yu"-  describe "Nav and Document" $ do-    let navItem  = Nav { navUrl   = "url"-                       , navLabel = "label"-                       , navOrder = 0-                       }-        docItem  = [ "index" =: ("label" :: String)-                   , "url"   =: ("url" :: String)-                   , "order" =: (0 :: Int)-                   ]-        docItem' = [ "labsel" =: ("label" :: String)-                   , "ural"   =: ("url" :: String)-                   , "order"  =: (0 :: Int)-                   ]-    it "transform nav to doc" $-      navToDoc navItem  `shouldMatchList` docItem-    it "transform doc to nav (just)" $-      docToNav docItem  `shouldBe` Just navItem-    it "transform doc to nav(nothing)" $-      docToNav docItem' `shouldBe` Nothing-  describe "ResT and Document" $ do-    now <- runIO $ getCurrentTime-    let resItem = ResT { rIndex   = ["the","path","to","resource"]-                       , rRes     = Oid 233 233-                       , rType    = "type"-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-        docItem   = [ "index"       =: ["the","path","to","resource" :: String]-                    , "res"         =: Oid 233 233-                    , "type"        =: ("type" :: String)-                    , "create-time" =: now-                    , "update-time" =: now-                    , "title"       =: ("title" :: String)-                    , "summary"     =: Just ("summary" :: String)-                    , "whose"       =: Just ("whose" :: String)-                    , "mime"        =: Just ("mime" :: String)-                    , "tags"        =: ["tag","s" :: String]-                    ]-        docItem'  = [ "inddex"      =: ["the","path","to","resource" :: String]-                    , "res"         =: Oid 233 233-                    , "type"        =: ("type" :: String)-                    , "create-time" =: now-                    , "update-time" =: now-                    , "title"       =: ("title" :: String)-                    , "summary"     =: Just ("summary" :: String)-                    , "whose"       =: Just ("whose" :: String)-                    , "mime"        =: Just ("mime" :: String)-                    , "tags"        =: ["tag","s" :: String]-                    ]-    it "transfrom res to doc" $-      resToDoc resItem  `shouldMatchList` docItem-    it "transform doc to res(just)" $-      docToRes docItem  `shouldBe` Just resItem-    it "transform doc to res(nothing)" $-      docToRes docItem' `shouldBe` Nothing-  describe "database actions" $ do-    describe "for context" $ beforeAll_ cleanDatabase $ do-      let contextTestCollection = "ctc"-          contextTestField      = "ctf"-          contextTestItem       = "cti"    :: String-          contextTestItemNew    = "ctinew" :: String-          contextTestOidBad (Oid a b) = Oid (a-1) (b-1)-      contextTestOid <- runIO $ newIORef Nothing-      it "update a context(new)" $ do-        cto <- readIORef contextTestOid-        oid <- runDB $ updateContext-          contextTestCollection-          cto-          contextTestField-          contextTestItem-        Just doc <- runDB $ findOne (select ["_id" =: oid] contextTestCollection)-        writeIORef contextTestOid $ Just oid-        doc `shouldContain` [ "_id"            =: oid-                            , contextTestField =: contextTestItem-                            ]-      it "update context(again)" $ do-        cto <- readIORef contextTestOid-        print cto-        oid <- runDB $ updateContext-          contextTestCollection-          cto-          contextTestField-          contextTestItemNew-        Just doc <- runDB $ findOne (select ["_id" =: oid] contextTestCollection)-        writeIORef contextTestOid $ Just oid-        doc `shouldContain` [ "_id"            =: oid-                            , contextTestField =: contextTestItemNew-                            ]-      it "fetch context(just)" $ do-        Just cto <- readIORef contextTestOid-        rt <- runDB $ fetchContext-          contextTestField-          ResT {rRes = cto}-          contextTestCollection-        rt `shouldBe` Just contextTestItemNew-      it "fetch context(nothing)" $ do-        Just cto <- readIORef contextTestOid-        rt <- runDB $ fetchContext-          contextTestField-          ResT {rRes = contextTestOidBad cto}-          contextTestCollection-        let shouldBE :: Maybe String -> Maybe String -> IO ()-            shouldBE = shouldBe-        rt `shouldBE` Nothing-      it "delete context" $ do-        Just cto <- readIORef contextTestOid-        runDB $ deleteContext ResT{rRes = cto} contextTestCollection-        rt <- runDB $ rest =<< find (select [] contextTestCollection)-        rt `shouldBe` []-    describe "for res" $ beforeAll_ cleanDatabase $ do-      now <- runIO $ getCurrentTime-      let resItem1 = ResT { rIndex   = ["the","path","to","resource","1"]-                          , rRes     = Oid 233 233-                          , rType    = "type"-                          , rCTime   = now-                          , rUTime   = now-                          , rTitle   = "title"-                          , rSummary = Just "summary"-                          , rWhose   = Just "whose"-                          , rMIME    = Just "mime"-                          , rTags    = ["tag","s"]-                          }-          resItem2 = ResT { rIndex   = ["the","path","to","resource","2"]-                          , rRes     = Oid 233 233-                          , rType    = "type"-                          , rCTime   = now-                          , rUTime   = now-                          , rTitle   = "title"-                          , rSummary = Just "summary"-                          , rWhose   = Just "whose"-                          , rMIME    = Just "mime"-                          , rTags    = ["tag","s"]-                          }-          docItem1  = [ "index"       =: ["the","path","to","resource","1" :: String]-                      , "res"         =: Oid 233 233-                      , "type"        =: ("type" :: String)-                      , "create-time" =: now-                      , "update-time" =: now-                      , "title"       =: ("title" :: String)-                      , "summary"     =: Just ("summary" :: String)-                      , "whose"       =: Just ("whose" :: String)-                      , "mime"        =: Just ("mime" :: String)-                      , "tags"        =: ["tag","s" :: String]-                      ]-          docItem2  = [ "index"       =: ["the","path","to","resource","2" :: String]-                      , "res"         =: Oid 233 233-                      , "type"        =: ("type" :: String)-                      , "create-time" =: now-                      , "update-time" =: now-                      , "title"       =: ("title" :: String)-                      , "summary"     =: Just ("summary" :: String)-                      , "whose"       =: Just ("whose" :: String)-                      , "mime"        =: Just ("mime" :: String)-                      , "tags"        =: ["tag","s" :: String]-                      ]-      it "update a new resource index" $ do-        runDB $ updateRes resItem1-        rt:_ <- runDB $ rest =<< find (select [] "index")-        docToRes rt `shouldBe` Just resItem1-      it "fetch a resource index" $ do-        rt1 <- runDB $ fetchRes ["the","path","to","resource","1"]-        rt2  <- runDB $ fetchRes ["the","path","to","resource","2"]-        rt1 `shouldBe` Just resItem1-        rt2 `shouldBe` Nothing-      it "fetch all inedxes, when there are indexes in database" $ do-        runDB $ updateRes resItem2-        rt <- runDB $ fetchResAll-        rt `shouldBe` [resItem1,resItem2]-      it "delete a index" $ do-        runDB $ deleteRes resItem1-        rt1:_ <- runDB $ rest =<< find (select [] "index")-        docToRes rt1 `shouldBe` Just resItem2-        runDB $ deleteRes resItem2-        rt2 <- runDB $ rest =<< find (select [] "index")-        rt2 `shouldBe` []-      it "fetch all indexes, when database is empty" $ do-        rt <- runDB $ fetchResAll-        rt `shouldBe` []-    describe "for item" $ beforeAll_ cleanDatabase $ do-      now <- runIO $ getCurrentTime-      let itemTestTypeOld = "itto"-          itemTestType    = "itt" :: T.Text-          itemTestIndex   = ["i","t","i"]-          itemTestField   = "itf"-          itemTestItem    = "item" :: T.Text-          resItemOld = ResT { rIndex   = itemTestIndex-                            , rRes     = undefined-                            , rType    = itemTestTypeOld-                            , rCTime   = now-                            , rUTime   = now-                            , rTitle   = "title"-                            , rSummary = Just "summary"-                            , rWhose   = Just "whose"-                            , rMIME    = Just "mime"-                            , rTags    = ["tag","s"]-                            }-          resItem = ResT { rIndex   = itemTestIndex-                         , rRes     = undefined-                         , rType    = itemTestType-                         , rCTime   = now-                         , rUTime   = now-                         , rTitle   = "title"-                         , rSummary = Just "summary"-                         , rWhose   = Just "whose"-                         , rMIME    = Just "mime"-                         , rTags    = ["tag","s"]-                         }-          docC = [ itemTestField =: itemTestItem ]-          docR = [ "index"       =: itemTestIndex-                 , "type"        =: itemTestType-                 , "create-time" =: now-                 , "update-time" =: now-                 , "title"       =: ("title" :: String)-                 , "summary"     =: Just ("summary" :: String)-                 , "whose"       =: Just ("whose" :: String)-                 , "mime"        =: Just ("mime" :: String)-                 , "tags"        =: ["tag","s" :: String]-                 ]-      it "update an old item" $ do-        runDB $ updateItem-          itemTestTypeOld-          itemTestField-          itemTestItem-          resItemOld-        rt1:_ <- runDB $ rest =<< find (select [] itemTestTypeOld)-        rt2:_ <- runDB $ rest =<< find (select [] "index")-        rt1 `shouldContain` docC-        let Just rt2' = docToRes rt2-        rt2' `shouldBe` resItemOld {rRes = rRes rt2'}-      it "update an new item" $ do-        runDB $ updateItem-          itemTestType-          itemTestField-          itemTestItem-          resItem-        rt1:_ <- runDB $ rest =<< find (select [] itemTestType)-        rt3   <- runDB $ rest =<< find (select [] itemTestTypeOld)-        rt2:_ <- runDB $ rest =<< find (select [] "index")-        rt1 `shouldContain` docC-        rt3 `shouldBe` []-        let Just rt2' = docToRes rt2-        rt2' `shouldBe` resItem {rRes = rRes rt2'}-      it "delete the item" $ do-        runDB $ deleteItem itemTestIndex itemTestType-        rt1 <- runDB $ rest =<< find (select [] itemTestType)-        rt2 <- runDB $ rest =<< find (select [] "index")-        rt1 `shouldBe` []-        rt2 `shouldBe` []-    describe "for update/fetch" $ do-      describe "for frame" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "frame"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["html" =: item]-        it "update" $ do-          runDB $ updateFrame item res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchFrame r-          renderMarkup rt `shouldBe` TL.fromStrict item-      describe "for html" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "post"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["html" =: item]-        it "update" $ do-          runDB $ updatePost item res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchPost r-          renderMarkup rt `shouldBe` TL.fromStrict item-      describe "for text" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "resource"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["text" =: item]-        it "update" $ do-          runDB $ updateResourceT item res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchResourceT r-          rt `shouldBe` item-      describe "for binary" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "resource"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["binary" =: Binary item]-        it "update" $ do-          runDB $ updateResourceB (Binary item) res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchResourceB r-          rt `shouldBe` item-      describe "for static" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "static"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["url" =: item]-        it "update" $ do-          runDB $ updateStatic item res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchStatic r-          rt `shouldBe` item-      describe "for query" $ beforeAll_ cleanDatabase $ do-        now <- runIO $ getCurrentTime-        let res = ResT { rIndex   = itemIndex-                       , rRes     = undefined-                       , rType    = itemType-                       , rCTime   = now-                       , rUTime   = now-                       , rTitle   = "title"-                       , rSummary = Just "summary"-                       , rWhose   = Just "whose"-                       , rMIME    = Just "mime"-                       , rTags    = ["tag","s"]-                       }-            doc = [ "index"       =: itemIndex-                  , "type"        =: itemType-                  , "create-time" =: now-                  , "update-time" =: now-                  , "title"       =: ("title" :: String)-                  , "summary"     =: Just ("summary" :: String)-                  , "whose"       =: Just ("whose" :: String)-                  , "mime"        =: Just ("mime" :: String)-                  , "tags"        =: ["tag","s" :: String]-                  ]-            itemType = "query"-            itemIndex = ["path","to","item"]-            item    = "123"-            itemDoc = ["var" =: item]-        it "update" $ do-          runDB $ updateQuery item res-          rt1:_ <- runDB $ rest =<< find (select [] itemType)-          rt2:_ <- runDB $ rest =<< find (select [] "index")-          rt1 `shouldContain` itemDoc-          let Just rt2' = docToRes rt2-          rt2' `shouldBe` res {rRes = rRes rt2'}-        it "fetch" $ do-          Just r  <- runDB $ fetchRes   itemIndex-          Just rt <- runDB $ fetchQuery r-          rt `shouldBe` item-    describe "for navigate bar" $ beforeAll_ cleanDatabase $ do-      let label = "label"-          url   = "url"-          order = 0-          nav = Nav { navLabel = label-                    , navUrl   = url-                    , navOrder = order-                    }-          doc = [ "index" =: label-                , url     =: url-                , "order" =: order-                ]-      it "update/add one" $ do-        runDB $ updateNav (Just label) (Just url) (Just order)-        rt:_ <- runDB $ rest =<< find (select [] "nav")-        rt `shouldContain` doc-      it "fetch" $ do-        rt:_ <- runDB $ fetchNav-        rt `shouldBe` nav-      it "delete one" $ do-        runDB $ updateNav (Just label) (Just url) (Just order)-        runDB $ updateNav (Just "345") (Just url) (Just order)-        runDB $ updateNav (Just "123") (Just url) (Just order)-        runDB $ deleteNav $ Just "123"-        rt <- runDB $ fetchNav-        length rt `shouldBe` 3-      it "delete all" $ do-        runDB $ deleteNav Nothing-        rt <- runDB $ fetchNav-        rt `shouldBe` []-------+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+
+-- | The test module for model for glob
+module ModelSpec
+  ( spec
+  ) where
+
+import           Control.Monad
+import           Data.IORef
+import qualified Data.Text.Lazy           as TL
+import           Data.Time                (UTCTime, diffUTCTime, getCurrentTime)
+import           Internal
+import           System.IO
+import           Test.Hspec
+import           Text.Blaze.Renderer.Text
+import           Yu.Core.Model
+import qualified Yu.Import.Text           as T
+
+-- | step one: get pipe
+getPipe :: IO Pipe
+getPipe = connect $ readHostPort "localhost:27017"
+
+cleanDatabase :: IO ()
+cleanDatabase = void $ runDB $ dropDatabase testDBName
+
+
+spec :: Spec
+spec = do
+  runIO $ putStrLn "Test for Model part for Yu"
+  describe "Nav and Document" $ do
+    let navItem  = Nav { navUrl   = "url"
+                       , navLabel = "label"
+                       , navOrder = 0
+                       }
+        docItem  = [ "index" =: ("label" :: String)
+                   , "url"   =: ("url" :: String)
+                   , "order" =: (0 :: Int)
+                   ]
+        docItem' = [ "labsel" =: ("label" :: String)
+                   , "ural"   =: ("url" :: String)
+                   , "order"  =: (0 :: Int)
+                   ]
+    it "transform nav to doc" $
+      navToDoc navItem  `shouldMatchList` docItem
+    it "transform doc to nav (just)" $
+      docToNav docItem  `shouldBe` Just navItem
+    it "transform doc to nav(nothing)" $
+      docToNav docItem' `shouldBe` Nothing
+  describe "ResT and Document" $ do
+    now <- runIO $ getCurrentTime
+    let resItem = ResT { rIndex   = ["the","path","to","resource"]
+                       , rRes     = Oid 233 233
+                       , rType    = "type"
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+        docItem   = [ "index"       =: ["the","path","to","resource" :: String]
+                    , "res"         =: Oid 233 233
+                    , "type"        =: ("type" :: String)
+                    , "create-time" =: now
+                    , "update-time" =: now
+                    , "title"       =: ("title" :: String)
+                    , "summary"     =: Just ("summary" :: String)
+                    , "whose"       =: Just ("whose" :: String)
+                    , "mime"        =: Just ("mime" :: String)
+                    , "tags"        =: ["tag","s" :: String]
+                    ]
+        docItem'  = [ "inddex"      =: ["the","path","to","resource" :: String]
+                    , "res"         =: Oid 233 233
+                    , "type"        =: ("type" :: String)
+                    , "create-time" =: now
+                    , "update-time" =: now
+                    , "title"       =: ("title" :: String)
+                    , "summary"     =: Just ("summary" :: String)
+                    , "whose"       =: Just ("whose" :: String)
+                    , "mime"        =: Just ("mime" :: String)
+                    , "tags"        =: ["tag","s" :: String]
+                    ]
+    it "transfrom res to doc" $
+      resToDoc resItem  `shouldMatchList` docItem
+    it "transform doc to res(just)" $
+      docToRes docItem  `shouldBe` Just resItem
+    it "transform doc to res(nothing)" $
+      docToRes docItem' `shouldBe` Nothing
+  describe "database actions" $ do
+    describe "for context" $ beforeAll_ cleanDatabase $ do
+      let contextTestCollection = "ctc"
+          contextTestField      = "ctf"
+          contextTestItem       = "cti"    :: String
+          contextTestItemNew    = "ctinew" :: String
+          contextTestOidBad (Oid a b) = Oid (a-1) (b-1)
+      contextTestOid <- runIO $ newIORef Nothing
+      it "update a context(new)" $ do
+        cto <- readIORef contextTestOid
+        oid <- runDB $ updateContext
+          contextTestCollection
+          cto
+          contextTestField
+          contextTestItem
+        Just doc <- runDB $ findOne (select ["_id" =: oid] contextTestCollection)
+        writeIORef contextTestOid $ Just oid
+        doc `shouldContain` [ "_id"            =: oid
+                            , contextTestField =: contextTestItem
+                            ]
+      it "update context(again)" $ do
+        cto <- readIORef contextTestOid
+        print cto
+        oid <- runDB $ updateContext
+          contextTestCollection
+          cto
+          contextTestField
+          contextTestItemNew
+        Just doc <- runDB $ findOne (select ["_id" =: oid] contextTestCollection)
+        writeIORef contextTestOid $ Just oid
+        doc `shouldContain` [ "_id"            =: oid
+                            , contextTestField =: contextTestItemNew
+                            ]
+      it "fetch context(just)" $ do
+        Just cto <- readIORef contextTestOid
+        rt <- runDB $ fetchContext
+          contextTestField
+          ResT {rRes = cto}
+          contextTestCollection
+        rt `shouldBe` Just contextTestItemNew
+      it "fetch context(nothing)" $ do
+        Just cto <- readIORef contextTestOid
+        rt <- runDB $ fetchContext
+          contextTestField
+          ResT {rRes = contextTestOidBad cto}
+          contextTestCollection
+        let shouldBE :: Maybe String -> Maybe String -> IO ()
+            shouldBE = shouldBe
+        rt `shouldBE` Nothing
+      it "delete context" $ do
+        Just cto <- readIORef contextTestOid
+        runDB $ deleteContext ResT{rRes = cto} contextTestCollection
+        rt <- runDB $ rest =<< find (select [] contextTestCollection)
+        rt `shouldBe` []
+    describe "for res" $ beforeAll_ cleanDatabase $ do
+      now <- runIO $ getCurrentTime
+      let resItem1 = ResT { rIndex   = ["the","path","to","resource","1"]
+                          , rRes     = Oid 233 233
+                          , rType    = "type"
+                          , rCTime   = now
+                          , rUTime   = now
+                          , rTitle   = "title"
+                          , rSummary = Just "summary"
+                          , rWhose   = Just "whose"
+                          , rMIME    = Just "mime"
+                          , rTags    = ["tag","s"]
+                          }
+          resItem2 = ResT { rIndex   = ["the","path","to","resource","2"]
+                          , rRes     = Oid 233 233
+                          , rType    = "type"
+                          , rCTime   = now
+                          , rUTime   = now
+                          , rTitle   = "title"
+                          , rSummary = Just "summary"
+                          , rWhose   = Just "whose"
+                          , rMIME    = Just "mime"
+                          , rTags    = ["tag","s"]
+                          }
+          docItem1  = [ "index"       =: ["the","path","to","resource","1" :: String]
+                      , "res"         =: Oid 233 233
+                      , "type"        =: ("type" :: String)
+                      , "create-time" =: now
+                      , "update-time" =: now
+                      , "title"       =: ("title" :: String)
+                      , "summary"     =: Just ("summary" :: String)
+                      , "whose"       =: Just ("whose" :: String)
+                      , "mime"        =: Just ("mime" :: String)
+                      , "tags"        =: ["tag","s" :: String]
+                      ]
+          docItem2  = [ "index"       =: ["the","path","to","resource","2" :: String]
+                      , "res"         =: Oid 233 233
+                      , "type"        =: ("type" :: String)
+                      , "create-time" =: now
+                      , "update-time" =: now
+                      , "title"       =: ("title" :: String)
+                      , "summary"     =: Just ("summary" :: String)
+                      , "whose"       =: Just ("whose" :: String)
+                      , "mime"        =: Just ("mime" :: String)
+                      , "tags"        =: ["tag","s" :: String]
+                      ]
+      it "update a new resource index" $ do
+        runDB $ updateRes resItem1
+        rt:_ <- runDB $ rest =<< find (select [] "index")
+        docToRes rt `shouldBe` Just resItem1
+      it "fetch a resource index" $ do
+        rt1 <- runDB $ fetchRes ["the","path","to","resource","1"]
+        rt2  <- runDB $ fetchRes ["the","path","to","resource","2"]
+        rt1 `shouldBe` Just resItem1
+        rt2 `shouldBe` Nothing
+      it "fetch all inedxes, when there are indexes in database" $ do
+        runDB $ updateRes resItem2
+        rt <- runDB $ fetchResAll
+        rt `shouldBe` [resItem1,resItem2]
+      it "delete a index" $ do
+        runDB $ deleteRes resItem1
+        rt1:_ <- runDB $ rest =<< find (select [] "index")
+        docToRes rt1 `shouldBe` Just resItem2
+        runDB $ deleteRes resItem2
+        rt2 <- runDB $ rest =<< find (select [] "index")
+        rt2 `shouldBe` []
+      it "fetch all indexes, when database is empty" $ do
+        rt <- runDB $ fetchResAll
+        rt `shouldBe` []
+    describe "for item" $ beforeAll_ cleanDatabase $ do
+      now <- runIO $ getCurrentTime
+      let itemTestTypeOld = "itto"
+          itemTestType    = "itt" :: T.Text
+          itemTestIndex   = ["i","t","i"]
+          itemTestField   = "itf"
+          itemTestItem    = "item" :: T.Text
+          resItemOld = ResT { rIndex   = itemTestIndex
+                            , rRes     = undefined
+                            , rType    = itemTestTypeOld
+                            , rCTime   = now
+                            , rUTime   = now
+                            , rTitle   = "title"
+                            , rSummary = Just "summary"
+                            , rWhose   = Just "whose"
+                            , rMIME    = Just "mime"
+                            , rTags    = ["tag","s"]
+                            }
+          resItem = ResT { rIndex   = itemTestIndex
+                         , rRes     = undefined
+                         , rType    = itemTestType
+                         , rCTime   = now
+                         , rUTime   = now
+                         , rTitle   = "title"
+                         , rSummary = Just "summary"
+                         , rWhose   = Just "whose"
+                         , rMIME    = Just "mime"
+                         , rTags    = ["tag","s"]
+                         }
+          docC = [ itemTestField =: itemTestItem ]
+          docR = [ "index"       =: itemTestIndex
+                 , "type"        =: itemTestType
+                 , "create-time" =: now
+                 , "update-time" =: now
+                 , "title"       =: ("title" :: String)
+                 , "summary"     =: Just ("summary" :: String)
+                 , "whose"       =: Just ("whose" :: String)
+                 , "mime"        =: Just ("mime" :: String)
+                 , "tags"        =: ["tag","s" :: String]
+                 ]
+      it "update an old item" $ do
+        runDB $ updateItem
+          itemTestTypeOld
+          itemTestField
+          itemTestItem
+          resItemOld
+        rt1:_ <- runDB $ rest =<< find (select [] itemTestTypeOld)
+        rt2:_ <- runDB $ rest =<< find (select [] "index")
+        rt1 `shouldContain` docC
+        let Just rt2' = docToRes rt2
+        rt2' `shouldBe` resItemOld {rRes = rRes rt2'}
+      it "update an new item" $ do
+        runDB $ updateItem
+          itemTestType
+          itemTestField
+          itemTestItem
+          resItem
+        rt1:_ <- runDB $ rest =<< find (select [] itemTestType)
+        rt3   <- runDB $ rest =<< find (select [] itemTestTypeOld)
+        rt2:_ <- runDB $ rest =<< find (select [] "index")
+        rt1 `shouldContain` docC
+        rt3 `shouldBe` []
+        let Just rt2' = docToRes rt2
+        rt2' `shouldBe` resItem {rRes = rRes rt2'}
+      it "delete the item" $ do
+        runDB $ deleteItem itemTestIndex itemTestType
+        rt1 <- runDB $ rest =<< find (select [] itemTestType)
+        rt2 <- runDB $ rest =<< find (select [] "index")
+        rt1 `shouldBe` []
+        rt2 `shouldBe` []
+    describe "for update/fetch" $ do
+      describe "for frame" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "frame"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["html" =: item]
+        it "update" $ do
+          runDB $ updateFrame item res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchFrame r
+          renderMarkup rt `shouldBe` TL.fromStrict item
+      describe "for html" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "post"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["html" =: item]
+        it "update" $ do
+          runDB $ updatePost item res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchPost r
+          renderMarkup rt `shouldBe` TL.fromStrict item
+      describe "for text" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "resource"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["text" =: item]
+        it "update" $ do
+          runDB $ updateResourceT item res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchResourceT r
+          rt `shouldBe` item
+      describe "for binary" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "resource"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["binary" =: Binary item]
+        it "update" $ do
+          runDB $ updateResourceB (Binary item) res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchResourceB r
+          rt `shouldBe` item
+      describe "for static" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "static"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["url" =: item]
+        it "update" $ do
+          runDB $ updateStatic item res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchStatic r
+          rt `shouldBe` item
+      describe "for query" $ beforeAll_ cleanDatabase $ do
+        now <- runIO $ getCurrentTime
+        let res = ResT { rIndex   = itemIndex
+                       , rRes     = undefined
+                       , rType    = itemType
+                       , rCTime   = now
+                       , rUTime   = now
+                       , rTitle   = "title"
+                       , rSummary = Just "summary"
+                       , rWhose   = Just "whose"
+                       , rMIME    = Just "mime"
+                       , rTags    = ["tag","s"]
+                       }
+            doc = [ "index"       =: itemIndex
+                  , "type"        =: itemType
+                  , "create-time" =: now
+                  , "update-time" =: now
+                  , "title"       =: ("title" :: String)
+                  , "summary"     =: Just ("summary" :: String)
+                  , "whose"       =: Just ("whose" :: String)
+                  , "mime"        =: Just ("mime" :: String)
+                  , "tags"        =: ["tag","s" :: String]
+                  ]
+            itemType = "query"
+            itemIndex = ["path","to","item"]
+            item    = "123"
+            itemDoc = ["var" =: item]
+        it "update" $ do
+          runDB $ updateQuery item res
+          rt1:_ <- runDB $ rest =<< find (select [] itemType)
+          rt2:_ <- runDB $ rest =<< find (select [] "index")
+          rt1 `shouldContain` itemDoc
+          let Just rt2' = docToRes rt2
+          rt2' `shouldBe` res {rRes = rRes rt2'}
+        it "fetch" $ do
+          Just r  <- runDB $ fetchRes   itemIndex
+          Just rt <- runDB $ fetchQuery r
+          rt `shouldBe` item
+    describe "for navigate bar" $ beforeAll_ cleanDatabase $ do
+      let label = "label"
+          url   = "url"
+          order = 0
+          nav = Nav { navLabel = label
+                    , navUrl   = url
+                    , navOrder = order
+                    }
+          doc = [ "index" =: label
+                , url     =: url
+                , "order" =: order
+                ]
+      it "update/add one" $ do
+        runDB $ updateNav (Just label) (Just url) (Just order)
+        rt:_ <- runDB $ rest =<< find (select [] "nav")
+        rt `shouldContain` doc
+      it "fetch" $ do
+        rt:_ <- runDB $ fetchNav
+        rt `shouldBe` nav
+      it "delete one" $ do
+        runDB $ updateNav (Just label) (Just url) (Just order)
+        runDB $ updateNav (Just "345") (Just url) (Just order)
+        runDB $ updateNav (Just "123") (Just url) (Just order)
+        runDB $ deleteNav $ Just "123"
+        rt <- runDB $ fetchNav
+        length rt `shouldBe` 3
+      it "delete all" $ do
+        runDB $ deleteNav Nothing
+        rt <- runDB $ fetchNav
+        rt `shouldBe` []
+
+
+
+
+
+
+
test-src/Spec.hs view
@@ -1,1 +1,19 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-
+ Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+ This file is part of Yu.
+
+ Yu 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.
+
+ Yu 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 Yu.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
yu-core.cabal view
@@ -1,63 +1,64 @@--- Initial yu-core.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/--name:                yu-core-version:             0.1.0.0-synopsis:            The core of Yu.-description:         The core module for Yu.-homepage:            https://github.com/Qinka/Yu-license:             GPL-3-license-file:        LICENSE-author:              Johann Lee-maintainer:          qinka@live.com-copyright:           Copyright (C) 2017 Johann Lee-category:            Web-build-type:          Simple-extra-source-files:  ChangeLog.md-cabal-version:       >= 1.10--library -  exposed-modules:     Yu.Core.Model.Internal-                       Yu.Core.Model.TH-                       Yu.Core.Model-                       Yu.Core.View.Internal-                       Yu.Core.View.Query.Parsec-                       Yu.Core.View.Query-                       Yu.Core.View-                       Yu.Core.Info-                       Yu.Core.Control-                       Yu.Core.Control.Internal-  other-modules:       Paths_yu_core-  build-depends:       base >= 4 && < 5-                     , yu-utils == 0.1.0.*-                     , yu-auth  == 0.1.0.*-  hs-source-dirs:      src-  default-language:    Haskell2010-  other-extensions:    FlexibleContexts-                       FunctionalDependencies-                       MultiParamTypeClasses-                       OverloadedStrings-                       QuasiQuotes-                       RecordWildCards-                       TemplateHaskell-                       TypeFamilies--test-suite test-mvc-  type:             exitcode-stdio-1.0-  main-is:          Spec.hs-  hs-source-dirs:   test-src-  build-depends:    base >= 4 && < 5-                  , hspec-                  , yu-utils-                  , yu-core-                  , blaze-markup-  other-modules:    ModelSpec-                    Internal-  default-language: Haskell2010-  ghc-options:      -Wno-missing-fields-                       -source-repository head-  type: git-  location: https://github.com/Qinka/Yu.git-  subdir: yu-core+-- Initial yu-core.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                yu-core
+version:             0.1.1.2
+synopsis:            The core of Yu.
+description:         The core module for Yu.
+homepage:            https://github.com/Qinka/Yu
+license:             GPL-3
+license-file:        LICENSE
+author:              Johann Lee
+maintainer:          qinka@live.com
+copyright:           Copyright (C) 2017-2018 Johann Lee <me@qinka.pro>
+category:            Web
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >= 1.10
+
+library 
+  exposed-modules:     Yu.Core.Model.Internal
+                       Yu.Core.Model.TH
+                       Yu.Core.Model
+                       Yu.Core.View.Internal
+                       Yu.Core.View.Query.Parsec
+                       Yu.Core.View.Query
+                       Yu.Core.View
+                       Yu.Core.Info
+                       Yu.Core.Route
+                       Yu.Core.Control
+                       Yu.Core.Control.Internal
+  other-modules:       Paths_yu_core
+  build-depends:       base >= 4 && < 5
+                     , yu-utils == 0.1.1.*
+                     , yu-auth  == 0.1.1.*
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  other-extensions:    FlexibleContexts
+                       FunctionalDependencies
+                       MultiParamTypeClasses
+                       OverloadedStrings
+                       QuasiQuotes
+                       RecordWildCards
+                       TemplateHaskell
+                       TypeFamilies
+
+test-suite test-mvc
+  type:             exitcode-stdio-1.0
+  main-is:          Spec.hs
+  hs-source-dirs:   test-src
+  build-depends:    base >= 4 && < 5
+                  , hspec
+                  , yu-utils
+                  , yu-core
+                  , blaze-markup
+  other-modules:    ModelSpec
+                    Internal
+  default-language: Haskell2010
+  ghc-options:      -Wno-missing-fields
+                       
+source-repository head
+  type: git
+  location: https://github.com/Qinka/Yu.git
+  subdir: yu-core
   branch: 0.1/dev/master