diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/bamboo.cabal b/bamboo.cabal new file mode 100644 --- /dev/null +++ b/bamboo.cabal @@ -0,0 +1,76 @@ +Name: bamboo +Version: 2009.4.22 +Build-type: Simple +Synopsis: A simple blog engine on Hack +Description: A simple blog engine on Hack +License: GPL +License-file: LICENSE +Author: Wang, Jinjing +Maintainer: Wang, Jinjing +Build-Depends: base +Cabal-version: >= 1.2 +category: Web +homepage: http://www.haskell.org/haskellwiki/Bamboo +data-files: readme.md, changelog.md + +library + ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults + build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, process, mps >= 2008.11.6, parsedate >= 3000.0.0, rss >= 3000.0.1, xhtml, kibro >= 0.4.2, utf8-string >= 0.3.3, pandoc, parsec >= 2, MissingH, gravatar >= 0.3, data-default >= 0.2, hcheat >= 2008.11.6, hack >= 2009.4.22 + hs-source-dirs: src/ + exposed-modules: + Bamboo + other-modules: + Bamboo.Config.Global + + Bamboo.Controller.Application + + Bamboo.Helper.Helper + Bamboo.Helper.StateHelper + Bamboo.Helper.Html + Bamboo.Helper.Env + Bamboo.Helper.PreludeEnv + Bamboo.Helper.ThumbHelper + + Bamboo.Model.Tag + Bamboo.Model.Post + Bamboo.Model.Helper + Bamboo.Model.Video + Bamboo.Model.Comment + Bamboo.Model.Album + Bamboo.Model.Static + + + Bamboo.Type.Theme + Bamboo.Type.Plugin + Bamboo.Type.Pager + Bamboo.Type.State + Bamboo.Type.StaticWidget + Bamboo.Type.Reader + Bamboo.Type.Extension + + Bamboo.View.Atom.Tag + Bamboo.View.Atom.Post + Bamboo.View.Atom.Video + Bamboo.View.Atom.Comment + Bamboo.View.Atom.Album + Bamboo.View.Atom.Static + + Bamboo.View.Control.Tag + Bamboo.View.Control.Post + Bamboo.View.Control.Helper + Bamboo.View.Control.Comment + Bamboo.View.Control.Search + Bamboo.View.Control.Static + + Bamboo.View.Widget.Template + Bamboo.View.Widget.Helper + Bamboo.View.Widget.Header + Bamboo.View.Widget.Sidebar + Bamboo.View.Widget.Navigation + Bamboo.View.Widget.SearchBar + Bamboo.View.Widget.Head + Bamboo.View.Widget.RSS + Bamboo.View.Widget.Body + Bamboo.View.Widget.Footer + + diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,6 @@ +2009.4.21 +----------- + +### Feature + +* Panda ported to Hack, with a new name diff --git a/readme.md b/readme.md new file mode 100644 --- /dev/null +++ b/readme.md @@ -0,0 +1,207 @@ +## Bamboo: a blog engine on Hack + +### Features + +#### simple file structure + + db + |---- blog + | |---- 08-09-01 first post + | |---- 09-09-02 learn javascript.html + | + |---- tag + | |---- programming + | |---- funny + | + |---- static + |---- About + +#### simple config file + + blog_title = C大调 + blog_subtitle = 野猫不吃薯片 + host_name = jinjing.easymic.com + author_email = nfjinjing@gmail.com + + navigation = About + per_page = 7 + sidebar = Blogroll.md + favicon = bamboo_icon.png + +#### standard web technology + +extend/customize with pure css and javascript ( note the custom part in css and js from the last section ) + +#### hacker friendly + +* posts are in plain text +* SCM for publishing / data managing ( not really a feature, but a design goal from the beginning ) +* blindly follows the KISS principle from code to UI: be a simple blog, no more no less + +## Demo + +### blog + +[My blog](http://jinjing.easymic.com) source is available as a git repo: + + git clone git://github.com/nfjinjing/jinjing-blog.git + +Or [browser](http://github.com/nfjinjing/jinjing-blog/tree/master) online + +### config + +[jinjing's blog config file](http://github.com/nfjinjing/jinjing-blog/blob/401a541443d88bbf8d844874c1473d4b3bc81784/config/site.txt) + +## Install + +### Quick setup + +#### install [lighttpd](http://www.lighttpd.net/ ) + +Note: only version 1.4.19 has been successfully tested, 1.4.20 is bugged for reasons unknown. + +#### install [ghc](http://www.haskell.org/ghc/download.html) + +#### install [darcs](http://www.darcs.net/) for `cabal-install` + +#### install [cabal-install](http://hackage.haskell.org/trac/hackage/wiki/CabalInstall) + + darcs get --partial http://darcs.haskell.org/cabal-install/ + cd cabal-install + sh bootstrap.sh + +#### install bamboo + + cabal update; cabal install bamboo + +#### bootstrap + + # bamboo is a kibro project + kibro new myblog + cd myblog + + # get a template to start + git clone git://github.com/nfjinjing/bamboo-template.git db + sh db/extra/scripts/bootstrap.sh + +#### run + + kibro start + +It should be running on [http://127.0.0.1:3000](http://127.0.0.1:3000) now. + +Since Bamboo is based on Kibro, it helps to read how [Kibro](http://chrisdone.com/blog/tag/Kibro) works. + +### Goodies + +Install `Ruby` / `Rake`, then `rake -T` to see a list of helper commands. + +### Config + +Edit `db/config/site.txt` + + blog_title = My shiny blog + host_name = yourhost.com + author_email = your_mail@yourhost.com + +Restart required. (hint: `rake r`) + +## User's guide + +### posts + +All posts are placed in `db/blog` folder, with naming convention [yy-mm-dd title], in Markdown format by default. + +Markdown supports embedding HTML snippets, so embedding youtube video is a peace of cake. + + + +You can create static pages, in `db/static`, and link to them via `/static/static_file_name` inside your blogs. + +For example `db/static/About`, where you can put some profile in. + +### tagging + +Create a file in `db/tag`, the name of the file will be the name of the new tag. +edit the tag file, insert the full name of a blog post, e.g. `08-09-04 Welcome to Bamboo` + +### html / tex / restructured text format + +Just create the file in blog as usual with an extension (e.g. html, rst, tex ), and you are all set. + +### customize navigation bar + +see example in `config/site`: + + navigation = About, Gallery + +Multiple renderer supported, use extension as hints. + +Note, the navigation configuration requires the full name of your static page, so you should include extension in configuration as well. + +### customize sidebar + +see example in `config/site`, `config/sidebar/Blogroll.md` + + sidebar = Blogroll.md + +Sidebar items are html snippets plugged into view. You can create these plugins in multiple formats, use extension. + +### styling + +Styling is done by editing `public/theme/blueprint/css/custom.css`, see the default `custom.css` for inspiration. + +### theming + +New theme can be created without touching `Bamboo` code, example blueprint theme in `db/config/theme/blueprint.txt` + + container = container + header = column span-12 first + navigation = column span-12 first large + main = column span-9 first + sidebar = column span-3 last + footer = footer + + css = screen, blueprint-wp, custom + js = jquery-1.2.6.min, jquery.getUrlParam, jquery.highlight-2, custom + + +These are custom class names for each element block. + +You can create new themes by adding theme definition files in `db/config/theme`, put theme resources under `db/public/theme/your_theme_name` and place + + theme = your_new_theme + +inside `site.txt`. + +note: `css` and `js` are required to be placed under `db/public/theme/your_theme_name/css` and `db/public/theme/your_theme_name/js`, leave out the file extensions in `site.txt`. + +### syntax highlighting + + + + +Highlight for `HTML` is enabled by default, see `public/theme/blueprint/js/custom.js` for more language support. + +Highlight style is configured at `config/theme/blueprint.txt`, just change `highlight/default` to any css inside `theme/blueprint/css/highlight`. + + +### analytics + +Google analytics is available, put your `tracker_id` in `site.txt`, if you don't want analytics, ignore the setting. + +Once site module is introduced, those `js` code could be configured to be gone forever, but not yet in the current release. + +### final note + +try to use `

` for heading in your posts, at least `wordpress` is using this convention. `

` is not styled in the blueprint theme, so they look kind of unfitted. But this does not stop anyone from styling `

,

` if wished. + +### Links + +* [Kibro](http://chrisdone.com/blog/tag/Kibro) +* [Bamboo on Jinjing's blog](http://jinjing.easymic.com/tag/Bamboo) +* [Source](http://github.com/nfjinjing/bamboo/tree) diff --git a/src/Bamboo.hs b/src/Bamboo.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE QuasiQuotes #-} + +module Bamboo + ( + module Bamboo.Controller.Application, + bamboo + ) where + +import Bamboo.Controller.Application +import Hack.Handler.Kibro +import Hack.Utils +import Hack +import Hack.Contrib.RawRouter +import Hack.Contrib.ContentType +import Bamboo.Helper.Env hiding (body, not_found, (>)) + +default_content_type = "text/plain; charset=UTF-8" + +middleware_stack = + [ content_type default_content_type + , route paths + ] + +app = not_found_app .use middleware_stack + +bamboo :: IO () +bamboo = run app diff --git a/src/Bamboo/Config/Global.hs b/src/Bamboo/Config/Global.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Config/Global.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Config.Global where + +import Bamboo.Helper.Helper +import Bamboo.Helper.PreludeEnv + + +import Data.Maybe +import Data.Default + +import Bamboo.Type.StaticWidget +import Bamboo.Type.Theme ( to_theme ) +import Bamboo.Type.Extension + + +db_id = "db" +flat_id = "." +post_id = "blog" +config_id = "config" +tag_id = "tag" +comment_id = "comment" +sidebar_id = "sidebar" +theme_id = "theme" +config_file_id = "site.txt" +album_id = "album" +image_id = "images" +public_id = "public" +static_id = "static" +topic_id = "forum/post" +thumb_id = "thumb" + +db_uri = db_id +flat_uri = db_uri / flat_id +public_uri = db_uri / public_id +image_uri = public_uri / image_id + +config_uri = flat_uri / config_id / config_file_id +sidebar_uri = flat_uri / config_id / sidebar_id +footer_uri = flat_uri / config_id +post_uri = flat_uri / post_id +tag_uri = flat_uri / tag_id +comment_uri = flat_uri / comment_id +theme_uri = flat_uri / config_id / theme_id + +album_uri = image_uri / album_id +topic_uri = flat_uri / topic_id + +data ConfigData = + BlogTitle + | BlogSubtitle + | HostName + | AuthorEmail + | PerPage + | Navigation + | Root + | Sidebar + | Footer + | Favicon + | AnalyticsAccountId + | Extensions + | Theme + | PostDateFormat + | CommentDateFormat + | UrlDateFormat + | UrlDateMatcher + | UrlTitleSubs + | UrlDateTitleSeperator + | Cut + | SummaryForRoot + | SummaryForTag + | SummaryForRss + | PicturePrefix + | NumberOfLatestPosts + deriving (Show) + +-- unsafe, must restart server after changing config file, sorry about that ... +-- but these configs are read only, and keep the view pure, so no monad headaches involved. + +user_config = parse_config config_uri +for' x d = user_config.lookup (x.show_data) .fromMaybe d +for_int' x d = for' x d .read :: Int +for_list' x d = for' x d .parse_list +for x = for' x (x.show_data) + +blog_title = for BlogTitle +blog_subtitle = for BlogSubtitle +host_name = for HostName +author_email = for AuthorEmail + +per_page = for_int' PerPage "7" +navigation = for_list' Navigation "About" .(home_nav :) + +bamboo_url = "http://www.haskell.org/haskellwiki/Bamboo" + +root + | user_root.belongs_to ["/", ""] = "/" + | otherwise = user_root.("/" /).remove_trailing_slash + where user_root = for' Root "/" + +default_reader = def + +load_widget = read_static_widget default_reader > purify +sidebar = for_list' Sidebar "" .map (sidebar_uri /).select (file_exist > purify ) + .map load_widget + +footer = for Footer + .(footer_uri / ) + .(\x -> if x.file_exist.purify then Just $ load_widget x else Nothing) + +favicon = for' Favicon "/favicon.ico" + +-- extensions +analytics_account_id = for AnalyticsAccountId +extensions = for_list' Extensions "search, comment, analytics" .read_data_list :: [Extension] + +-- theme +default_theme = def +user_theme_name = for Theme +user_theme_uri = (theme_uri / user_theme_name) ++ ".txt" + +theme = if user_theme_uri.file_exist.purify + then parse_config user_theme_uri .(("name", user_theme_name) : ) .to_theme + else default_theme + +-- custom +as_l s = "[" ++ s ++ "]" +post_date_format = for' PostDateFormat "%y-%m-%d" +comment_date_format = for' CommentDateFormat "%y-%m-%d %T" +url_date_format = for' UrlDateFormat "%y-%m-%d" +url_date_matcher = for' UrlDateMatcher "\\d{2}-\\d{2}-\\d{2}" +url_title_subs = for' UrlTitleSubs "" .as_l .read :: [(String, String)] +url_date_title_seperator = for' UrlDateTitleSeperator " " + +-- summary +cut = for' Cut "✂-----" +summary_for_root = for SummaryForRoot .parse_boolean +summary_for_tag = for SummaryForTag .parse_boolean +summary_for_rss = for SummaryForRss .parse_boolean + +-- album +picture_prefix = for' PicturePrefix "\\d+-" + +-- latest +number_of_latest_posts = for_int' NumberOfLatestPosts "15" + diff --git a/src/Bamboo/Controller/Application.hs b/src/Bamboo/Controller/Application.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Controller/Application.hs @@ -0,0 +1,181 @@ +-- the controller is the most complex module for a reason: +-- models are made as simple and small as possible +-- views are pure functions. + +-- a note on encoding: +-- uniform utf-8 enforced by custom io wrapper + +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Controller.Application where + +import qualified Data.Map as Map + +-- env +import Bamboo.Helper.Env hiding (tag, uri) +import Bamboo.Helper.StateHelper hiding (only_for) +import qualified Bamboo.Type.State as S +import qualified Bamboo.Config.Global as G +import qualified Bamboo.Type.Pager as Pager +import Bamboo.Type.Extension +import Hack +import Hack.Utils (not_found_app) + +-- model +import qualified Bamboo.Model.Post as Post +import qualified Bamboo.Model.Static as Static +import qualified Bamboo.Model.Tag as Tag +import qualified Bamboo.Model.Comment as Comment + +-- view +import qualified Bamboo.View.Control.Post as PostV +import qualified Bamboo.View.Control.Static as StaticV +import qualified Bamboo.View.Control.Tag as TagV +import qualified Bamboo.View.Control.Search as SearchV +import qualified Bamboo.View.Widget.RSS as RSSV + + +-- helpers +-- liftIO: move to an (u)pper level monad +u = liftIO +blog_regex = G.url_date_matcher +init_post tags x = x.Tag.fill_tag tags.Comment.fill_comment_size +tag_list = list + + +-- main controller +paths = + [ ("$" ,index ) + , ("(\\?.+)?$" ,index ) + , ("rss.xml$" ,index_feed ) + , (blog_regex ,blog ) + , ("static/." ,static ) + , ("tag/.*/rss.xml$" ,tag_feed ) + , ("tag/." ,tag ) + , ("search" ,only_for Search $ search ) +-- , ("comment/create" ,only_for Comment $ comment_create ) + ] + .map_fst ((G.root /) > ("^" ++)) + + +only_for ext x = if has_extension ext then x else not_found_app + + +default_state = do + latest_posts <- Post.latest G.number_of_latest_posts + def { S.latest_posts = latest_posts } .return + +index :: Application +index env = do + posts <- list + let p = posts.paginate env + tags <- tag_list + let nav = if p.Pager.current == 1 then home_nav else no_navigation + s <- default_state + let state = s { S.uid = G.post_id, S.tags = tags, S.pager = p, S.nav_location = nav } + + posts.mapM (init_post tags) ^ PostV.list state >>= output_html + +index_feed env = do + posts <- list + posts.RSSV.rss "" "" .output_html + +blog env = do + let id = env .uri .Post.uri_to_id + blog <- get id + comments <- list_for id + tags <- tag_list + + test_data <- S.mk_human_test + s <- default_state + let state = s { S.uid = id, S.tags = tags, S.resource_title = blog.resource_title, S.human_test_data = test_data } + blog.(init_post tags) ^ PostV.view state comments >>= output_html + +static env = do + let id = env.uri + static_page <- get id + tags <- tag_list + let nav_id = static_page.Static.uid.id_to_resource + let nav = if nav_id.belongs_to G.navigation then nav_id else no_navigation + s <- default_state + let state = s { S.uid = id, S.tags = tags, S.nav_location = nav, S.resource_title = static_page.resource_title } + StaticV.view state static_page .output_html + + +tag env = do + let id = env.uri + tags <- tag_list + let tag_name = Tag.get_name id + case Tag.tag_map' tags .Map.lookup tag_name of + Nothing -> not_found + Just post_set -> do + posts <- post_set.to_list.rsort.mapM (get) >>= mapM (init_post tags) + let p = posts.paginate env + s <- default_state + let state = s { S.uid = id, S.tags = tags, S.pager = p, S.resource_title = tag_name.Tag.resource_title_from_name } + posts.TagV.view state.output_html + +tag_feed env = do + let id = env .uri .split "/" .init .join "/" + tags <- tag_list + let tag_name = Tag.get_name id + case Tag.tag_map' tags .Map.lookup tag_name of + Nothing -> not_found + Just post_set -> do + posts <- post_set.to_list.rsort.mapM get ^ map (Tag.fill_tag tags) + posts.RSSV.rss G.tag_id tag_name .output_html + +search env = do + let s = env.param_with_default "s" "" + posts <- Post.search s + + let p = posts.paginate env + tags <- tag_list + let query = env.uri + s' <- default_state + let state = s' { S.uid = query, S.pager = p, S.tags = tags, S.resource_title = query } + + posts.mapM (init_post tags) >>= \x -> x.SearchV.view state s.output_html + +{- +comment_create = do + post_id <- input_with_default (show_data Comment.PostId) (G.post_id / "nothing") + exists <- (G.flat_uri / post_id) .file_exist .u + let valid_path = equalFilePath G.post_id (takeDirectory post_id) + checked <- check_create + + if [checked, valid_path, exists].and + then + inputs >>= (Comment.create_comment > u) + else + return () + redirect $ (post_id.Post.id_to_uri.u2b).urlEncode + +get_input_data = show_data > get_input + +check_human = do + [l, r, op, h] <- [Comment.LeftNumber, Comment.RightNumber, Comment.Operator, Comment.HumanHack].mapM get_input_data ^ map fromJust + return $ S.simple_eval (l.read) (r.read) (op.S.read_op) .is (h.read) + +-- create helper, should be refactored to some common aspect +check_create = + [ validate Comment.Author ( length > (`gt` 0)) + , validate Comment.AuthorLink ( const True) + , validate Comment.Body ( length > (`gt` 0)) + , validate Comment.EmptyField ( empty ) + , validate Comment.LeftNumber ( belongs_to (S.nums.map show)) + , validate Comment.RightNumber ( belongs_to (S.nums.map show)) + , validate Comment.Operator ( belongs_to (S.ops.map S.display_op)) + , validate Comment.HumanHack ( belongs_to (S.nums.map show)) + , check_human + ] .sequence ^ and + + +validate s f = do + maybe_s <- get_input_data s + case maybe_s of + Nothing -> return False + Just v -> return $ f v + +-} diff --git a/src/Bamboo/Helper/Env.hs b/src/Bamboo/Helper/Env.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/Env.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- this sets some scoping for every module, which prevents importing +-- common modules in every file + +module Bamboo.Helper.Env ( + module Bamboo.Helper.PreludeEnv + , module Control.Monad + , module Control.Arrow + , module Data.List + , module Network.URI + , module Network.CGI + , module System.Locale + , module System.Time.Parse + , module Bamboo.Helper.Helper + , module Data.Maybe + , module System.FilePath + , module System.IO.UTF8 + , module Text.XHtml.Strict + , module System.Time + , module System.Directory + , module Data.Foldable + , module Data.Default +) where + +import Bamboo.Helper.PreludeEnv hiding (FilePath) +import Control.Monad (liftM2, liftM3, liftM4, liftM5) +import Control.Arrow ((>>>), (&&&), (***)) +import Data.List (isSuffixOf, isInfixOf, isPrefixOf, sortBy, intersperse) +import Network.URI +import Network.CGI hiding (Html) +import System.Locale +import System.Time.Parse +import Bamboo.Helper.Helper +import Data.Maybe (fromMaybe, fromJust, isJust, isNothing) +import System.FilePath hiding ((<.>)) +import System.IO.UTF8 (readFile, writeFile) +import Text.XHtml.Strict hiding (select, sub, meta) +import System.Time +import System.Directory +import Data.Foldable (find) +import Data.Default diff --git a/src/Bamboo/Helper/Helper.hs b/src/Bamboo/Helper/Helper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/Helper.hs @@ -0,0 +1,189 @@ +-- helper module is a central place for reusable functions +-- for this project, more general helpers are usually moved +-- to MPS package, for multi-project usage + +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Helper.Helper where + +import Bamboo.Helper.PreludeEnv +import Network.URI +import Network.CGI + +import Text.XHtml.Strict hiding (p, meta, body) +import qualified Text.XHtml.Strict as Html +import Control.Monad hiding (join) +import Data.Maybe +import qualified Bamboo.Type.Pager as Pager +import Char +import Data.List hiding (length) +import qualified Data.List as L +import Bamboo.Type.Reader +import System.FilePath.Posix hiding ((<.>)) +import System.Time +import qualified Prelude as P +import Data.Default +import Data.Map (Map) +import System.Directory +import Hack +import Hack.Utils (not_found_app) + +(/) :: FilePath -> FilePath -> FilePath +(/) = () +infixl 5 / + +gt = (P.>) + +-- global +parse_config_io s = read_file s ^ (\x -> x.filter_comment.lines.map strip .map (split "\\s*=\\s*") .map fill_snd_blank .map tuple2) + where fill_snd_blank [x] = [x,""] + fill_snd_blank xs = xs + +parse_config = parse_config_io > purify +write_config_io s xs = xs.map(\(x, y) -> x ++ " = " ++ y) .join "\n" .write_file s + +-- model +take_extension = takeExtension -- > split "\\." > last +take_known_extension s + | ext.belongs_to exts = ext + | otherwise = "" + where + ext = s.take_extension + exts = readers.only_snd.join' + +drop_known_extension s + | s.take_extension.belongs_to exts = dropExtension s + | otherwise = s + where exts = readers.only_snd.join' + +meta = (++ ".meta") + +image_extensions = ["jpg", "jpeg", "png", "gif"] +is_image x = image_extensions.any (suffix_of x) +suffix_of = flip isSuffixOf + +-- controller +raw_uri env = ( env.script_name ++ env.path_info ) .(urlDecode > tail > remove_trailing_slash ) + +remove_trailing_slash s = if s.last.is '/' then s.init else s + +params env = do + case env.query_string of + [] -> [] + s -> s.formDecode .map_snd ( unescape_unicode_xml > b2u) + +inputs = getInputs ^ map_snd (strip > unescape_unicode_xml > b2u) + +param_with_default s d env = env .get_param s .fromMaybe d +input_with_default s d env = env .get_input s .fromMaybe d + +get_param s env = env .params .lookup s +get_input s env = env .inputs .lookup s + +just_param s env = env .get_param s .fromJust +just_input s env = env .get_input s .fromJust + +full_paginate per_page total env = Pager.Pager per_page current has_next has_previous next previous where + current = env.param_with_default "page" "1" .read + has_next = current * per_page < total.from_i + has_previous = current `gt` 1 + next = current + 1 + previous = current + (-1) + + +for_current_page p xs = xs.drop ((p.Pager.current - 1) * p.Pager.length) .take (p.Pager.length) + +no_navigation = "" +home_nav = "Home" + +-- view +id = identifier + +css_link l = itag "link" ! [rel "stylesheet", thetype "text/css", href l] +ie_tag x = ("").primHtml +ie6_tag x = ("").primHtml +ie7_tag x = ("").primHtml +js_link l = itag "script" ! [thetype "text/javascript", src l] +js_src s = tag "script" ! [thetype "text/javascript"] << s +rss_link l = itag "link" ! [rel "alternate", thetype "application/rss+xml", href l, title "RSS 2.0"] +favicon_link l = itag "link" ! [rel "icon", thetype "image/png", href l] +meta_tag = Html.meta ! [httpequiv "Content-Type", content "text/html; charset=utf-8"] + +div_id s = thediv ! [id s] +div_class s = thediv ! [theclass s] +div_class_id x y = thediv ! [theclass x, id y] + +xml_header = "\n" +output_html x = Response + { status = 200 + , headers = [("Content-Type", "text/html; charset=UTF-8")] + , body = x.show + } + .return + +spaced_url = gsub "/" " / " + +empty_html = toHtml "" +html_if p x = if p then x else empty_html + +-- config +parse_list s = s.split "," .map strip .reject null +not_found = not_found_app def + + +-- generic +show_data = show > snake_case +ifM p t f = p >>= (\p' -> if p' then t else f) +parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"] +mkdir = u2b > createDirectory + +-- class +class DataRenderer a where + render_data :: a -> Html + +-- id: /type/resoruce +id_to_type x = x.split "/" .first +id_to_resource x = x.split "/" .tail.join "/" + +class (Show a) => Resource a where + resource_title :: a -> String + resource_type :: a -> String + resource_type = show_data + +class Markable a where + markup :: a -> Html + +class Datable a where + date :: a -> CalendarTime + +class Addressable a where + uri :: a -> String + +-- class Pluggable a where +-- render_plugin :: a -> String + +class Gettable a where + get :: String -> IO a + +type Assoc = [(String, String)] + +class Mappable a where + from_assoc :: Assoc -> IO a + +class Creatable a where + create :: a -> IO () + +class Listable a where + list :: IO [a] + list = return [] + + list_for :: String -> IO [a] + list_for = const list + cheat_list :: IO [a] + cheat_list = list + +class FlatRead a where + flat_read :: String -> IO a + + diff --git a/src/Bamboo/Helper/Html.hs b/src/Bamboo/Helper/Html.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/Html.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Helper.Html where + +import Text.XHtml.Strict +import Bamboo.Helper.PreludeEnv +import Char + + +span = thespan + +div = thediv +id = identifier +klass = theclass + +d = div +c x = d ! [klass x] +i x = d ! [id x] + +ic x y = d ! [id x, klass y] +ci x y = ic y x + +ul = ulist + + + +escape_html_unicode = concatMap fixChar + where + fixChar '<' = "<" + fixChar '>' = ">" + fixChar '&' = "&" + fixChar '"' = "\"" + fixChar c | ord c < 0x80 = [c] + fixChar c = "&#" ++ show (ord c) ++ ";" + +link = hotlink +img = image diff --git a/src/Bamboo/Helper/PreludeEnv.hs b/src/Bamboo/Helper/PreludeEnv.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/PreludeEnv.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude, NoMonomorphismRestriction #-} + +module Bamboo.Helper.PreludeEnv ( + module MPSUTF8 + , module Prelude + , (>) + , strip +) where + +import Prelude hiding ((.), (/), (^), id, span, readFile, writeFile, div, (>)) +import MPSUTF8 hiding (base, col, date, strip) +import qualified MPSUTF8 as MPS +import Control.Arrow ((>>>)) + +(>) = (>>>) +infixl 8 > + +strip x = MPS.strip (x.u2b) .b2u diff --git a/src/Bamboo/Helper/StateHelper.hs b/src/Bamboo/Helper/StateHelper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/StateHelper.hs @@ -0,0 +1,51 @@ +-- trying to merge this helper with the generic one results in cyclic imports + +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Helper.StateHelper where + +import Bamboo.Helper.Env +import qualified Bamboo.Config.Global as G +import Hack + +-- G.root = /blog +-- raw_uri = blog/x +-- full_uri = /blog/x +-- uri = full_uri - (/blog/) +remove_root s + | G.root.is "/" = s + | otherwise = s.slice (G.root.length) (s.length) + +uri env = raw_uri env .b2u .remove_root +-- uri = raw_uri + +-- global +parse_date format s = case maybe_d of + Nothing -> Nothing + Just d -> Just $ if d.ctYear < 1910 then d {ctYear = d.ctYear + 100} else d + where + maybe_d = parseCalendarTime defaultTimeLocale format s + +format_date = formatCalendarTime defaultTimeLocale +default_date = parse_date "%Y-%m-%d %T" "2000-1-1 00:00:00".fromJust +parse_post_date = parse_date G.post_date_format +default_parse_date s = s.parse_post_date .fromMaybe default_date + +has_extension x = G.extensions.has x +only_for ext x = if has_extension ext then x else toHtml "" + +-- controller +paginate env xs = full_paginate (G.per_page) (xs.length) env + +cut = G.cut +match_cut = isInfixOf cut +is_cut = isPrefixOf cut + +-- not used for efficiency +-- cut_re = "^\\s*" ++ cut +-- split_cut = split cut_re + + +-- model +path id = G.flat_uri / id diff --git a/src/Bamboo/Helper/ThumbHelper.hs b/src/Bamboo/Helper/ThumbHelper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Helper/ThumbHelper.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Helper.ThumbHelper where + +-- env +import Bamboo.Helper.Env hiding (match, body, quote) +import qualified Bamboo.Config.Global as G +import System.Cmd + +convert_if_missing_thumb w x = do + thumb_exists <- dir_exist (thumb_path) + if thumb_exists + then return () + else mkdir thumb_path >> convert w x + + where + thumb_path = x / G.thumb_id + +convert w x = do + images <- ls x ^ filter is_image + images.map (convert_cmd w x).sequence >>= print + return () + +quote x = "\"" ++ x ++ "\"" + +system_utf8 = u2b > system + +convert_cmd w p x = do + system_utf8 $ ["convert -resize", w.show, i, o].join " ".trace' + where + i = quote $ p / x + o = quote $ p / G.thumb_id / x diff --git a/src/Bamboo/Model/Album.hs b/src/Bamboo/Model/Album.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Album.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Model.Album where + +-- env +import Bamboo.Helper.Env hiding (title, body, size, path, meta, get) +import qualified Bamboo.Config.Global as G +import Bamboo.Helper.StateHelper +import Bamboo.Helper.ThumbHelper +import List (sort) + +data AlbumType = Galleria | Fade | SlideViewer | Popeye deriving (Eq, Show, Read) + +instance Default AlbumType where + def = Fade + +data Album = Album + { uid :: String -- album/08-06-10 + , prefix :: String + , show_description :: Bool + , album_type :: AlbumType + , width :: Int + , pictures :: [String] + } + deriving (Show, Eq) + +instance Resource Album where + resource_title = uid > spaced_url + +-- CRUD +ls_l x = ls x ^ map (x /) +image_path id = G.image_uri / id + +get pre desc t w id = do + id.image_path.convert_if_missing_thumb w + get_pictures id ^ Album id pre desc t w + +get_pictures = image_path > ls > (^ filter is_image) > (^ sort) + +get_picture_title pre x + | pre.empty = x + | otherwise = x.split pre.last.dropExtension + +for_post pre id = get pre def def def (G.album_id / id.id_to_resource) + +picture_links x = x.pictures .map ("/" / G.image_id / x.uid /) +picture_thumbs x = x.pictures .map ("/" / G.image_id / x.uid / G.thumb_id /) +picture_titles x = x.pictures .map (get_picture_title (x.prefix)) + +data_list x = zip3 (x.picture_links) (x.picture_titles) (x.picture_thumbs) + +data AlbumData = + Prefix + | Name + | Pictures + | ShowDescription + | Type + | Width + deriving (Show) + +from_list xs = get prefix show_description t w (G.album_id / at Name) where + at x = xs.lookup (x.show_data).fromJust + at' x d = xs.lookup (x .show_data) .fromMaybe d + prefix = at' Prefix G.picture_prefix + show_description = at' ShowDescription "y" .parse_boolean + t = at' Type "fade" .camel_case .read + w = at' Width "400" .read + diff --git a/src/Bamboo/Model/Comment.hs b/src/Bamboo/Model/Comment.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Comment.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Model.Comment where + +-- env +import Bamboo.Helper.Env hiding (title, body, size, path) +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Reader +import qualified Bamboo.Model.Post as Post +import Bamboo.Helper.StateHelper +import Network.Gravatar + +data Comment = Comment + { uid :: String -- comment/08-09-04 blog title + , author :: String + , body :: String + , author_email :: String + , author_link :: String + } + deriving (Show, Eq) + +data CommentData = + Author + | AuthorEmail + | AuthorLink + | Body + | PostId + deriving (Show) + +data SpamFilter = + HumanHack + | EmptyField + | LeftNumber + | RightNumber + | Operator + deriving (Show) + +instance Resource Comment where + resource_title = uid > spaced_url + +instance Markable Comment where + markup x = render_to_html Markdown (x.body) + +instance Datable Comment where + date x = x.uid.split "/".last.default_parse_date + +instance Default Comment where + def = Comment def def def def def + +-- CRUD +instance FlatRead Comment where + flat_read x = do + t <- x.path.read_file + def {body = t, uid = x} .return + +instance Gettable Comment where + get id = do + x <- flat_read id + meta <- id.path.meta.parse_config_io + let at s = meta.lookup (s.show_data) .fromJust + let author = at Author + let author_email = at AuthorEmail + let author_link = at AuthorLink + x { author = author, author_email = author_email, author_link = author_link } .return + +instance Listable Comment where + list_for resource_id = do + ifM (dir_exist d) (idsM >>= mapM (get :: String -> IO Comment)) (return []) + where + idsM = ls d ^ reject (isSuffixOf ".meta") ^ rsort ^ map (G.comment_id / r /) + d = (G.comment_uri / r) + r = resource_id.id_to_resource + +instance Creatable Comment where + create = write_to + +instance Mappable Comment where + from_assoc h = do + let at s = h.lookup (s.show_data) .fromJust + let body = at Body + let post_id = at PostId + + timestamp <- ( getClockTime >>= toCalendarTime ) ^ format_date G.comment_date_format + let comment_path = post_id_to_uid post_id + mkdir_p comment_path + + let uid = comment_path / timestamp + def + { uid = uid + , body = at Body + , author = at Author + , author_email = at AuthorEmail + , author_link = at AuthorLink + } + .return + +write_to x = do + write_file (x.uid) (x.body) + write_config_io (x.uid.meta) meta_data + where + meta_data = + [ (Author, x.author) + , (AuthorLink, x.author_link) + , (AuthorEmail, x.author_email) + ] .map_fst show_data + +create_comment x = x.from_assoc >>= (create :: Comment -> IO ()) + +-- extra +from_post_id x = def { uid = post_id_to_uid x } + +post_id_to_uid x = G.flat_uri / G.comment_id / x.split "/" .last +uid_to_post_id x = G.post_id / x.split "/" .last + +fill_comment_size x = do + size <- x.Post.uid.(list_for :: String -> IO [Comment] ) ^ length + return $ x { Post.comment_size = size } + +gravatar_default_size = size 40 +gravatar_link x = gravatarWith (x.author_email) def gravatar_default_size def diff --git a/src/Bamboo/Model/Helper.hs b/src/Bamboo/Model/Helper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Helper.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Model.Helper where + +import Bamboo.Helper.Env +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Reader +import Bamboo.Type.Plugin (apply_plugin) + +get_body id = (G.flat_uri / id) .read_file >>= apply_plugin_for_resource id +get_reader id = id.take_extension.guess_reader.fromMaybe G.default_reader + +apply_plugin_for_resource id + | id.id_to_type.belongs_to [G.post_id, G.static_id] = apply_plugin + | otherwise = return diff --git a/src/Bamboo/Model/Post.hs b/src/Bamboo/Model/Post.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Post.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- what about performance? +-- Haskell takes care of that, since IOs are also lazy. +-- Posts are not read unless specifically required, i.e. after pagination + +module Bamboo.Model.Post where + +-- env +import Bamboo.Helper.Env hiding (match, title, body, date) +import qualified MPS as MPS +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Reader +import Bamboo.Helper.StateHelper hiding (uri) +import Bamboo.Helper.Helper (date) +import Bamboo.Model.Helper + + +data Post = Post + { uid :: String -- blog/08-09-04 blog title + , title :: String + , body :: String + , tags :: [String] + , comment_size :: Int + , reader :: Reader + } + deriving (Show, Eq) + +instance Resource Post where + resource_title = title + resource_type = const G.post_id + +instance Markable Post where + markup x = render_to_html (x.reader) (x.full) + +instance Datable Post where + date = uid > get_date + +instance Addressable Post where + uri = uid > id_to_uri + +instance Default Post where + def = Post def def def def def def + +instance FlatRead Post where + flat_read x = do + t <- get_body x + def {body = t, uid = x} .return + +-- CRUD +instance Gettable Post where + get id = do + x <- flat_read id + x { + title = get_title id + , reader = get_reader id + } + .return + +instance Listable Post where + list = list_ids >>= mapM get + cheat_list = fast_list + +list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /) +fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title}) + + +get_title id = id.words.tail.unwords.drop_known_extension +get_date id = id.words.first.split "/".last.default_parse_date + +match s x = [title, body] .map (send_to x > lower > isInfixOf (s.lower)) .or +search "" = return [] +search s = list ^ filter (match s) + +summary x = x.body.lines.takeWhile (is_cut > not) .unlines +full x | x.body.match_cut.not = x.body +full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).unlines where + not_cut = is_cut > not + xs = x.body.lines + +has_continue = body > match_cut + +latest n = cheat_list ^ take n + +-- extra +id_to_uri id = G.root / ( pretty_date ++ G.url_date_title_seperator ++ formatted_title ++ ext ) where + formatted_title = G.url_title_subs.map (\(a,b) -> gsub a b).inject (id.get_title) apply + pretty_date = id.get_date.format_date G.url_date_format + ext = id.take_known_extension + +uri_to_id s = G.post_id / (d ++ " " ++ t) where + (raw_d, (_, title_with_sep)) = s.MPS.match G.url_date_matcher.fromJust.fst + raw_t = title_with_sep.drop (G.url_date_title_seperator.length) + t = G.url_title_subs.map (\(a,b) -> gsub b a) .inject raw_t apply + d = raw_d.parse_date G.url_date_format .fromJust.format_date G.post_date_format + + +-- summary +markup_summary x = post_summary x +++ next where + post_summary = (reader &&& summary) > splash render_to_html + next = if x.has_continue then toHtml $ p << hotlink (x.uri) << "Read the rest of the post »" else empty_html + + + diff --git a/src/Bamboo/Model/Static.hs b/src/Bamboo/Model/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Static.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Model.Static where + +-- env +import Bamboo.Helper.Env hiding (match, body) +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Reader +import Bamboo.Model.Helper + +data Static = Static + { uid :: String + , body :: String + , reader :: Reader + } + deriving (Show, Eq) + +instance Resource Static where + resource_title x = ("static" / x.uid.get_title) .spaced_url + +instance Markable Static where + markup x = render_to_html (x.reader) (x.body) + +instance Default Static where + def = Static def def def + +-- CRUD +instance FlatRead Static where + flat_read x = do + t <- get_body x + def {body = t, uid = x} .return + +instance Gettable Static where + get id = do + x <- flat_read id + x { reader = get_reader id } .return + +get_title = id_to_resource > drop_known_extension > split "/" > last +title = uid > get_title diff --git a/src/Bamboo/Model/Tag.hs b/src/Bamboo/Model/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Tag.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Model.Tag where + +import qualified Bamboo.Model.Post as Post + +-- env +import Bamboo.Helper.Env hiding (name) +import qualified Data.Set as S +import qualified Bamboo.Config.Global as G + + +data Tag = Tag + { uid :: String -- tag/name + , name :: String + , resources :: S.Set String + } + deriving (Show, Eq) + +instance Resource Tag where + resource_title = uid > spaced_url + +-- CRUD +instance Gettable Tag where + get id = get_resources id ^ Tag id (get_name id) + +instance Listable Tag where + list = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get + + +get_name id = id.split "/" .tail.join' +get_resources id = (G.flat_uri / id) .read_file + ^ filter_comment ^ lines ^ map (G.post_id / ) ^ to_set + +resource_title_from_name x = ("tag" / x) .spaced_url +tag_map' xs = xs . map (name &&& resources) . to_h +tag_map = list ^ tag_map' + +for_resource xs x = xs.select (resources > has x) .map name +fill_tag xs x = x { Post.tags = for_resource xs (x.Post.uid) } + +-- extra +sorted xs = xs.sortBy(compare_by (resources > S.size)).reverse +name_to_id x = G.tag_id / x diff --git a/src/Bamboo/Model/Video.hs b/src/Bamboo/Model/Video.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Model/Video.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Model.Video where + +-- env +import Bamboo.Helper.Env hiding (title, body, size, path, meta, get, width, height) +import qualified Bamboo.Config.Global as G +import Bamboo.Helper.StateHelper + +data VideoType = MediaPlayer deriving (Eq, Show, Read) + +instance Default VideoType where + def = MediaPlayer + +data Video = Video + { uid :: String -- album/08-06-10 + , preview :: String + , width :: Int + , height :: Int + , video_type :: VideoType + } + deriving (Show, Eq) + +instance Resource Video where + resource_title = uid > spaced_url + +data VideoData = + Link + | Preview + | Width + | Height + | Type + deriving (Show) + +from_list xs = Video + { uid = at Link + , preview = at' Preview "" + , width = at' Width "400" .read + , height = at' Height "300" .read + , video_type = at' Type "media_player" .camel_case.read + } .return + where + at x = xs.lookup (x.show_data).fromJust + at' x d = xs.lookup (x .show_data) .fromMaybe d diff --git a/src/Bamboo/Type/Extension.hs b/src/Bamboo/Type/Extension.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/Extension.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Type.Extension where + +import Bamboo.Helper.Env hiding (body) + +data Extension = + Comment + | Search + | Analytics + deriving (Show, Read, Eq) + + +read_data s = s.camel_case.read +read_data_list xs = xs.map read_data + diff --git a/src/Bamboo/Type/Pager.hs b/src/Bamboo/Type/Pager.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/Pager.hs @@ -0,0 +1,19 @@ +module Bamboo.Type.Pager where + +import Data.Default + +data Pager = Pager { + length :: Int, + current :: Int, + has_next :: Bool, + has_previous :: Bool, + next :: Int, + previous :: Int + } + deriving (Eq, Show) + +instance Default Bool where + def = False + +instance Default Pager where + def = Pager def def def def def def diff --git a/src/Bamboo/Type/Plugin.hs b/src/Bamboo/Type/Plugin.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/Plugin.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Type.Plugin where + +import Bamboo.Helper.Env hiding (body, name) +import qualified Bamboo.Model.Album as Album +import qualified Bamboo.Model.Video as V +import qualified Bamboo.View.Atom.Album as AlbumV +import qualified Bamboo.View.Atom.Video as VV + +data PluginType = PhotoAlbum | Video | None deriving (Show, Eq) + +data Plugin = Plugin + { plugin_type :: PluginType + , args :: [(String, String)] + } + deriving (Show, Eq) + +-- album-plugin +-- plugin is simple inline substitution, since markdown handles html natively +-- [[ +-- plugin: album, +-- name: first-album, +-- prefix: \d{2}-\d{2}-\d{2} +-- ]] + +plugin_expression = "\n\\[\\[((.|\n)*?)\\]\\]" +plugin_id = "plugin" + +infix_of = flip isInfixOf + +optimized_match x + | "[[".infix_of x = x.match plugin_expression + | otherwise = Nothing + + +parse_plugin x = x.gsub "\n" "".split "," .map (split ":") .inner_map strip .map tuple2.parse_it where + parse_it xs = Plugin { plugin_type = xs.at plugin_id, args = xs.reject (fst > (is plugin_id)) } + at x xs = case (xs.lookup x) >>= parse_plugin_type of + Nothing -> None + Just x -> x + plugin_types = [PhotoAlbum, Video] + parse_plugin_type x = plugin_types.label_by (show_data).lookup (x) + +match_result x = x.fromJust.snd.first.snd.b2u + +apply_plugin x = if r.isNothing then return x else r.sub_it where + r = x.optimized_match + plugin = r.match_result.parse_plugin + sub_it y = case plugin.plugin_type of + None -> return x + PhotoAlbum -> do + album <- plugin.args.Album.from_list ^ render_plugin + x.sub plugin_expression album .apply_plugin + Video -> do + video <- plugin.args.V.from_list ^ render_plugin + x.sub plugin_expression video .apply_plugin + +render_plugin x = "\n" ++ x.render_data.show diff --git a/src/Bamboo/Type/Reader.hs b/src/Bamboo/Type/Reader.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/Reader.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.Type.Reader where + +import Bamboo.Helper.PreludeEnv +import qualified Data.Map as Map +import Text.Pandoc + +import Text.XHtml.Strict +import Data.Default +import Bamboo.Helper.Html + +data Reader = Markdown | RST | HTML | Latex deriving (Show, Eq) + +instance Default Reader where + def = Markdown + +readers = + [ (Markdown, ["markdown", "md"]) + , (RST, ["rst"] ) + , (HTML, ["html", "htm"]) + , (Latex, ["tex", "latex"]) + ] .map_snd (map ("." ++)) + + +reader_map = readers.map gen_lookup.join'.to_h + where gen_lookup (r, xs) = xs.labeling (const r) + +guess_reader ext = reader_map.Map.lookup ext + +to_html r = r defaultParserState > writeHtml defaultWriterOptions + +-- this list can go on, as long as there is a library that does +-- the convertion. pretty extensible, isn't it. +rr :: Reader -> String -> Html +rr Markdown = to_html readMarkdown +rr RST = to_html readRST +rr HTML = escape_html_unicode > primHtml +rr Latex = to_html readLaTeX + +render_to_html = rr diff --git a/src/Bamboo/Type/State.hs b/src/Bamboo/Type/State.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/State.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Type.State where + +import qualified Bamboo.Type.Pager as Pager +import Bamboo.Model.Tag +import Random (randomRs, mkStdGen) +import System.Time + +import Bamboo.Helper.PreludeEnv +import Data.Default +import Bamboo.Model.Post + +data State = State + -- model state + { uid :: String -- current view resource + , pager :: Pager.Pager -- pager + + -- theme state + , tags :: [Tag] + , nav_location :: String + , resource_title :: String + , human_test_data :: HumanTestData + , latest_posts :: [Post] + } + deriving (Show) + +show_left = human_test_data > left > show +show_right = human_test_data > right > show +show_op = human_test_data > op > display_op + +read_op "+" = Plus +read_op "-" = Minus +read_op x = error ("can not read operator: " ++ x) + +display_op Plus = "+" +display_op Minus = "-" + +data HumanTestData = HumanTestData + { left :: Int + , right :: Int + , op :: Op + } deriving (Show) + +instance Default HumanTestData where + def = HumanTestData def def def + +data Op = Plus | Minus deriving (Show) + +instance Default Op where + def = Plus + +instance Default State where + def = State def def def def def def def + + +ops = [Plus, Minus] +nums = [0, 5, 10, 15, 20] +simple_eval a b Plus = a + b +simple_eval a b Minus = a - b + + +mk_human_test = do + seed <- (getClockTime >>= toCalendarTime) ^ ctPicosec ^ from_i + let (a,b,c) = randomRs (0,100) (mkStdGen seed) .in_group_of 3 .map make_sample .lb good_test .first + return $ HumanTestData a b c + + where + make_sample [a,b,c] = ((get_num a), (get_num b), (get_op c)) + make_sample _ = error "human test sample fail" + good_test = splash3 simple_eval > belongs_to nums + get_num n = nums.at (n `mod` (nums.length)) + get_op n = ops.at (n `mod` (ops.length)) diff --git a/src/Bamboo/Type/StaticWidget.hs b/src/Bamboo/Type/StaticWidget.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/StaticWidget.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Type.StaticWidget where + +import Bamboo.Helper.Env hiding (body) +import Bamboo.Type.Reader + +data StaticWidget = StaticWidget + { name :: String + , body :: String + , reader :: Reader + } + deriving (Show, Eq) + +instance Markable StaticWidget where + markup x = render_to_html (x.reader) (x.body) + +read_static_widget default_reader s = liftM2 (StaticWidget name) body (return reader) where + body = s.read_file + reader = s.take_extension.guess_reader.fromMaybe default_reader + name = s.takeFileName.drop_known_extension diff --git a/src/Bamboo/Type/Theme.hs b/src/Bamboo/Type/Theme.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/Type/Theme.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.Type.Theme where + +import Bamboo.Helper.Env hiding (name, header) + +data Theme = Theme + { name :: String + , container :: String + , header :: String + , navigation :: String + , main :: String + , sidebar :: String + , footer :: String + , css :: [String] + , js :: [String] + } deriving (Show, Read) + +data ThemeData = + Name + | Container + | Header + | Navigation + | Main + | Sidebar + | Footer + | Css + | Js + deriving (Eq, Show, Read) + +to_theme xs = Theme + { name = at Name + , container = at Container + , header = at Header + , navigation = at Navigation + , main = at Main + , sidebar = at Sidebar + , footer = at Footer + , css = at Css .css_list + , js = at Js .js_list + } + where + at s = xs.lookup (s.show_data) .fromJust + css_list s = s.parse_list.map (\x -> "/theme/" ++ at Name ++ "/css/" ++ x ++ ".css") + js_list s = s.parse_list.map (\x -> "/theme/" ++ at Name ++ "/js/" ++ x ++ ".js") + +instance Default Theme where + def = Theme def def def def def def def def def diff --git a/src/Bamboo/View/Atom/Album.hs b/src/Bamboo/View/Atom/Album.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Album.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Album where + +import Bamboo.Helper.Env hiding (name, id) +import Bamboo.Model.Album +import qualified Bamboo.Config.Global as G +import Bamboo.Helper.Html + +instance DataRenderer Album where + render_data = show_album + + +show_album x = case x.album_type of + Fade -> show_fade x + Galleria -> show_galleria x + SlideViewer -> show_slide_viewer x + Popeye -> show_popeye x + +show_popeye x = c "popeye" << ul << x.data_list.map picture_li where + picture_li (l, t, i) = li << + link l << img ! [src i, alt t] + +show_slide_viewer x = ul ! [id "slide-viewer", klass "svw"] << x.data_list.map picture_li where + picture_li (l, t, i) = li << + img ! [src i, alt t] + +show_galleria x = ul ! [klass "gallery"] << x.data_list.map picture_li where + picture_li (l, t, i) = li << + img ! [src i, alt t] + +show_fade x = ul ! [klass "fade-album"] << x.data_list.map picture_li where + picture_li (l, t, i) = li << + [ toHtml $ link l << img ! [src i, alt t] + , if x.show_description then p << t else empty_html + ] diff --git a/src/Bamboo/View/Atom/Comment.hs b/src/Bamboo/View/Atom/Comment.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Comment.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Comment where + +import Bamboo.Helper.Env hiding (title) +import qualified Bamboo.Config.Global as G +import Bamboo.Helper.StateHelper +import Bamboo.Type.State hiding (uid) + +-- model +import Bamboo.Model.Comment + +-- render +instance DataRenderer Comment where + render_data = entry + +entry x = toHtml + [ gravatar + , cite << a + , toHtml " says:" + , br + , p ! [theclass "small"] << comment_date x + , x.markup + ] + where + l = x.author_link + a = if l.null then x.author.toHtml else toHtml $ hotlink formatted_link << x.author + formatted_link = if l.starts_with "http://" then l else "http://" ++ l + gravatar = thediv ! [theclass "gravatar"] << image ! [src (gravatar_link x)] + +comment_date x = toHtml $ x.date.format_date "%b %e, %Y at %I:%M %p" + + +-- form +human_test_question state = ["What", "is", state.show_left, state.show_op, state.show_right, "?"] .join " " + +create state x = toHtml + [ h2 ! [id "respond"] << "Leave a Response" + , gui (G.root / "comment/create") ! [id "commentform"] << + [ field Author 22 1 "Name (required)" + , field AuthorEmail 22 2 "Email (hidden)" + , field AuthorLink 22 3 "Website" + , field HumanHack 22 4 (human_test_question state) + , empty_field + , hidden_field LeftNumber (state.show_left) + , hidden_field RightNumber (state.show_right) + , hidden_field Operator (state.show_op) + , p << hidden (show_data PostId) (x.uid.uid_to_post_id) + , p << textarea ! [name (show_data Body), id "comment", cols "10", rows "20", strAttr "tabindex" "5"] << "" + , p << submit "submit" "Submit Comment" ! [strAttr "tabindex" "6"] + ] + ] + +field_with_value v x' s t m = p << + [ label ! [thefor x] << small << m + , br + , textfield x ! [size (s.show), strAttr "tabindex" (t.show), value v] + ] + where x = x'.show_data + +field x s t m = field_with_value "" x s t m + +hidden_field x m = hidden_field_with_value m x m +hidden_field_with_value v x m = thespan ! [ thestyle "display: none;" ] << field_with_value v x 22 10 m + +empty_field = hidden_field_with_value "" EmptyField "Leave this field empty:" diff --git a/src/Bamboo/View/Atom/Post.hs b/src/Bamboo/View/Atom/Post.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Post.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Post where + +import Bamboo.Helper.Env hiding (name, title) +import Bamboo.Helper.StateHelper hiding (uri) + +-- view +import qualified Bamboo.View.Atom.Tag as Tag + +-- model +import Bamboo.Model.Post + +-- render +instance DataRenderer Post where + render_data = entry Full + +data RenderStyle = Summary | Full + +-- instance helpers +entry style x = div_class "post" << [entry_title, entry_mark, entry_body] where + entry_title = x.title_link + entry_body = div_class "entry" << show_content style x + entry_mark = p ! [theclass "small"] << [ post_date, post_tags, post_comments ].map (send_to x) + +show_content Summary x = x.markup_summary +show_content Full x = x.markup + +-- post could also be a summary +render_summary x = if x.is True then entry Summary else render_data + +title_link x = h2 << hotlink (x.uri) << x.title +post_date x = toHtml $ x.date.format_date "%b %e, %Y" + +post_tags x | x.tags.null = empty_html +post_tags x = " | " +++ "Published in " +++ x.tags.map Tag.tag_link .intersperse (", ".toHtml) + +post_comments x | x.comment_size.is 0 = empty_html +post_comments x = " | " +++ hotlink ( x.uri / "#comments") << (x.comment_size.show ++ " Comments") diff --git a/src/Bamboo/View/Atom/Static.hs b/src/Bamboo/View/Atom/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Static.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Static where + +import Bamboo.Helper.Env +import Bamboo.Model.Static + +instance DataRenderer Static where + render_data = markup diff --git a/src/Bamboo/View/Atom/Tag.hs b/src/Bamboo/View/Atom/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Tag.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Tag where + +import Bamboo.Helper.Env hiding (name) +import Bamboo.Model.Tag +import qualified Bamboo.Config.Global as G + +instance DataRenderer Tag where + render_data = name >>> tag_link + +tag_link s = toHtml $ hotlink (G.root / G.tag_id / s ) << s + diff --git a/src/Bamboo/View/Atom/Video.hs b/src/Bamboo/View/Atom/Video.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Atom/Video.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Atom.Video where + +import Bamboo.Helper.Env hiding (name, id) +import Bamboo.Model.Video +import qualified Bamboo.Config.Global as G +import Bamboo.Helper.Html + +instance DataRenderer Video where + render_data = show_video + +show_video x = case x.video_type of + MediaPlayer -> show_media_player x + +show_media_player x = + [ p ! [id l] << "The player will show in this paragraph" + , tag "script" ! [thetype "text/javascript"] << primHtml ( play (x.uid) (x.preview) (x.uid) ) + ] .toHtml + where l = x.uid + + +play i p x = + [ "var s1 = new SWFObject('/flash/player.swf','player','400','348','9');" + , "s1.addParam('allowfullscreen','true');" + , "s1.addParam('allowscriptaccess','always');" + , "s1.addParam('flashvars','file=" ++ x ++ "&image=" ++ p ++ "');" + , "s1.write('" ++ i ++ "');" + ] + .join "\n" + diff --git a/src/Bamboo/View/Control/Comment.hs b/src/Bamboo/View/Control/Comment.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Comment.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Control.Comment where + +import Bamboo.Helper.Env hiding (body, date) + +-- view +import Bamboo.View.Atom.Comment as Comment + +-- api +styled_entry alt x = li ! [theclass alt] << x.render_data + +list [] = [] +list xs = + [ h2 ! [id "comments"] << "Responses" + , olist ! [theclass "commentlist" ] << xs.zip (cycle ["comments-alt", ""]).map (splash styled_entry) + ] + +create = Comment.create diff --git a/src/Bamboo/View/Control/Helper.hs b/src/Bamboo/View/Control/Helper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Helper.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Control.Helper where + +import Bamboo.Helper.Env + +import Bamboo.Type.Pager as Pager + +nav p r = + [ div_class "alignleft" << nav_previous p r + , div_class "alignright" << nav_next p r + ] + +nav_previous p r = if p.Pager.has_previous + then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.previous.show ) << previous_sign + else spaceHtml + where r' = if isSuffixOf "&" r then r else r ++ "?" + +nav_next p r = if p.Pager.has_next + then toHtml $ hotlink ( r' ++ "page=" ++ p.Pager.next.show ) << next_sign + else spaceHtml + where r' = if isSuffixOf "&" r then r else r ++ "?" + +next_sign = "Next Entries »" +previous_sign = "« Previous Entries" diff --git a/src/Bamboo/View/Control/Post.hs b/src/Bamboo/View/Control/Post.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Post.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Control.Post where + +-- env +import Bamboo.Helper.Env + +import qualified Bamboo.Type.State as State +import qualified Bamboo.Config.Global as G + +import Bamboo.Type.Extension +import Bamboo.Helper.StateHelper + +-- model +import qualified Bamboo.Model.Comment as Comment +import Bamboo.View.Atom.Post +import Bamboo.Model.Post + +-- view +import Bamboo.View.Control.Helper +import qualified Bamboo.View.Control.Comment as CommentV +import Bamboo.View.Widget.Template + +-- entry view +view :: State.State -> [Comment.Comment] -> Post -> Html +view state xs x = (x.render_data +++ comment_view ).page state + where comment_view = only_for Comment $ CommentV.list xs +++ CommentV.create state (x.uid.Comment.from_post_id) + +-- list view +list state = for_current_page p > map render > p_eval' > (+++ nav p G.root) > page state where + p = state.State.pager + render = render_summary G.summary_for_root diff --git a/src/Bamboo/View/Control/Search.hs b/src/Bamboo/View/Control/Search.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Search.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Control.Search where + +import Bamboo.Helper.Env +import qualified Bamboo.Type.State as State +import qualified Bamboo.Config.Global as G + +-- view +import Bamboo.View.Control.Helper +import Bamboo.View.Widget.Template + +view state s = for_current_page p >>> map render_data >>> (+++ nav p ( (G.root / "search") ++ "?s=" ++ s ++ "&")) >>> page state + where p = state.State.pager + diff --git a/src/Bamboo/View/Control/Static.hs b/src/Bamboo/View/Control/Static.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Static.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.View.Control.Static where + +import Bamboo.Helper.Env +import Bamboo.View.Atom.Static () +import Bamboo.View.Widget.Template + +view state = render_data >>> page state diff --git a/src/Bamboo/View/Control/Tag.hs b/src/Bamboo/View/Control/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Control/Tag.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Bamboo.View.Control.Tag where + +import Bamboo.Helper.Env +import qualified Bamboo.Type.State as State +import qualified Bamboo.Config.Global as G + +-- view +import Bamboo.View.Atom.Post +import Bamboo.View.Control.Helper +import Bamboo.View.Widget.Template + + +view state = for_current_page p > map render > p_eval' > (+++ nav p ( G.root / tag_id)) >>> page state where + p = state.State.pager + tag_id = state.State.uid + render = render_summary G.summary_for_tag + diff --git a/src/Bamboo/View/Widget/Body.hs b/src/Bamboo/View/Widget/Body.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Body.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Body where + +-- env +import Bamboo.Helper.Env + +body_content x = div_id "maincontent" << + div_class "content" << x + diff --git a/src/Bamboo/View/Widget/Footer.hs b/src/Bamboo/View/Widget/Footer.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Footer.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Footer where + +import Bamboo.Helper.Env +import qualified Bamboo.Config.Global as G + + +static_footer = toHtml + [ toHtml $ copyright + , toHtml $ "2008 " + , toHtml $ G.blog_title + , toHtml $ br + , toHtml $ "Powered by " + , toHtml $ hotlink G.bamboo_url << "Bamboo" + , toHtml $ " using " + , toHtml $ hotlink "http://www.haskell.org/" << "Haskell" + ] + +custom_footer + | G.footer.isJust = G.footer.fromJust.markup + | otherwise = static_footer + +footer c = div_class_id c "footer" << custom_footer diff --git a/src/Bamboo/View/Widget/Head.hs b/src/Bamboo/View/Widget/Head.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Head.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Head where + +import Bamboo.Helper.Env +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Theme hiding (header) +import qualified Bamboo.Type.State as S +import Bamboo.View.Widget.Helper + +html_head state = header << ([meta_tag, title_tag state, favicon_tag, rss_tag state] ++ G.theme.css.map css_link ++ G.theme.js.map js_link ) + +title_tag state = thetitle << [G.blog_title ++ state.S.resource_title.format_title] +rss_tag state = rss_link $ rss_url_link_pair state .fst +favicon_tag = favicon_link G.favicon + +format_title [] = "" +format_title s = " / " ++ s diff --git a/src/Bamboo/View/Widget/Header.hs b/src/Bamboo/View/Widget/Header.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Header.hs @@ -0,0 +1,18 @@ +module Bamboo.View.Widget.Header where + +import Bamboo.Helper.Env hiding (header) +import Prelude hiding ((.), (/), (^), id, span) +import qualified Bamboo.Config.Global as G +import Bamboo.View.Widget.SearchBar + +header c = + div_class_id c "header" << + [ search_bar + , site_name + ] + +site_name = toHtml $ + [ toHtml $ hotlink G.root ! [theclass "logo"] << "" + , h1 << G.blog_title + , div_class "description" << G.blog_subtitle + ] diff --git a/src/Bamboo/View/Widget/Helper.hs b/src/Bamboo/View/Widget/Helper.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Helper.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Helper where + +import Bamboo.Helper.Env + +import qualified Bamboo.Config.Global as G +import qualified Bamboo.Type.State as State +import qualified Bamboo.Model.Tag as Tag + +rss_url_link_pair state = + if tagged + then + let tag_name = Tag.get_name uid in + link ( G.tag_id / tag_name) tag_name + else link "" "Home" + where + uid = State.uid state + tagged = uid.match "^tag/.+" .isJust + url r = G.root / r / "rss.xml" + link r s = (url r, hotlink (url r) ! [ theclass "feedlink" ] << s) diff --git a/src/Bamboo/View/Widget/Navigation.hs b/src/Bamboo/View/Widget/Navigation.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Navigation.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Navigation where + +import Bamboo.Helper.Env hiding (header) +import qualified Bamboo.Config.Global as G +import qualified Bamboo.Type.State as State + +navigation c state = + div_class_id c "nav" << + div_class "content" << + ulist << G.navigation.map (nav_item (state.State.nav_location)) + +nav_item nav s = li ! [theclass (home_tag ++ "page_item" ++ current)] << link s where + home_tag = if s == home_nav then "first " else "" + current = if s == nav then " current_page_item" else "" + link x = if x == home_nav then home_link else static_link x + +home_link = hotlink G.root << home_nav +static_link s = hotlink (G.root / "static" / s) << s.drop_known_extension diff --git a/src/Bamboo/View/Widget/RSS.hs b/src/Bamboo/View/Widget/RSS.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/RSS.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.RSS where + +-- env +import Bamboo.Helper.Env -- hiding (Language) +import qualified Bamboo.Config.Global as G +import Text.RSS +import qualified Text.RSS as RSS + +-- model +import Bamboo.Model.Post as Post + +-- RSS +channel_rss_template = [ RSS.Language "en-us" ] + +render_rss x | G.summary_for_rss.is True = x.markup_summary.show + | otherwise = x.markup.show + +item_rss_template x = + [ Title $ x.Post.title + , Description $ x.render_rss + , Author $ G.author_email + , Link $ x.item_uri + , PubDate $ x.date + ] + +instance Default URI where + def = nullURI + +item_uri x = def { uriScheme = "http://", uriPath = host_link (x.uri) } +rss_uri x = def { uriScheme = "http://", uriPath = host_link x } + +rss categary s xs = RSS title (rss_uri link) title channel_rss_template (xs.take 20 .map item_rss_template) + .rssToXML.showXML + where + link = categary / s + title = if s.empty then G.blog_title else G.blog_title ++ " / " ++ s + +host_link s = G.host_name ++ (G.root / s) diff --git a/src/Bamboo/View/Widget/SearchBar.hs b/src/Bamboo/View/Widget/SearchBar.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/SearchBar.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.SearchBar where + +import Bamboo.Helper.Env hiding (header) +import qualified Bamboo.Config.Global as G +import Bamboo.Type.Extension +import Bamboo.Helper.StateHelper + +search_bar = only_for Search $ div_id "search" << form ! [action (G.root / "search"), method "get"] << thediv << textfield "s" diff --git a/src/Bamboo/View/Widget/Sidebar.hs b/src/Bamboo/View/Widget/Sidebar.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Sidebar.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Sidebar where + +import Bamboo.Helper.Env hiding (rss_link) +import qualified Bamboo.Type.State as State + +import qualified Data.Set as Set +import qualified Bamboo.Config.Global as G +import qualified Bamboo.Type.StaticWidget as Sidebar +import Bamboo.View.Widget.Helper + +-- model +import qualified Bamboo.Model.Tag as Tag + +-- view + +sidebar c state = + div_class_id c "sidebar" << unordList formatted_list + where + stock_list = + [ feed state + , tag_list $ state.State.tags + ] + custom_list = G.sidebar.map (\x -> h2 << x.Sidebar.name +++ x.markup) + formatted_list = (stock_list ++ custom_list) .intersperse hr + +feed state = toHtml + [ h2 << "Subscribe" + , p ! [theclass "feed"] << rss_link state + ] + +rss_link = rss_url_link_pair >>> snd +tag_list tags = toHtml + [ h2 << "Tags" + , unordList $ tags.Tag.sorted.map tag_link] + +tag_link x = ( hotlink (G.root / x.Tag.uid) << x.Tag.name ) +++ ( " (" ++ x.Tag.resources.Set.size.show ++ ")" ) diff --git a/src/Bamboo/View/Widget/Template.hs b/src/Bamboo/View/Widget/Template.hs new file mode 100644 --- /dev/null +++ b/src/Bamboo/View/Widget/Template.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE NoMonomorphismRestriction#-} +{-# LANGUAGE NoImplicitPrelude #-} +module Bamboo.View.Widget.Template (page) where + +import Bamboo.View.Widget.Head +import Bamboo.View.Widget.Body +import Bamboo.View.Widget.Header +import Bamboo.View.Widget.Navigation +import Bamboo.View.Widget.Sidebar +import Bamboo.View.Widget.Footer +import qualified Text.XHtml.Strict as Html +import qualified Bamboo.Config.Global as G +import qualified Bamboo.Type.Theme as T + +import Bamboo.Helper.Env hiding (header, body) + +-- extension +import Bamboo.Type.Extension +import Bamboo.Helper.StateHelper +import HCheat + +body t state x = Html.body << + [ div_class (t.T.container) << + [ header (t.T.header) + , navigation (t.T.navigation) state + , div_id "page" << [ div_class (t.T.main) << body_content x, sidebar (t.T.sidebar) state ] + , footer (t.T.footer) + ] + , only_for Analytics $ primHtml (analytics G.analytics_account_id) + ] + +template t state x = [html_head state, body t state x] .toHtml + +page = template G.theme