ema (empty) → 0.1.0.0

raw patch · 19 files changed

+2237/−0 lines, 19 filesdep +aesondep +asyncdep +base

Dependencies added: aeson, async, base, blaze-html, blaze-markup, commonmark, commonmark-extensions, commonmark-pandoc, containers, data-default, directory, ema, filepath, filepattern, fsnotify, http-types, lvar, monad-logger, monad-logger-extras, neat-interpolation, optparse-applicative, pandoc-types, profunctors, relude, safe-exceptions, shower, stm, tagged, text, time, unliftio, wai, wai-middleware-static, wai-websockets, warp, websockets

Files

• CHANGELOG.md +5/−0
• LICENSE +661/−0
• README.md +19/−0
• docs/Main.hs +6/−0
• ema.cabal +133/−0
• src/Ema.hs +10/−0
• src/Ema/App.hs +115/−0
• src/Ema/CLI.hs +48/−0
• src/Ema/Class.hs +41/−0
• src/Ema/Example/Ex01_HelloWorld.hs +15/−0
• src/Ema/Example/Ex02_Clock.hs +72/−0
• src/Ema/Example/Ex03_Documentation.hs +471/−0
• src/Ema/Generate.hs +68/−0
• src/Ema/Helper/FileSystem.hs +86/−0
• src/Ema/Helper/Tailwind.hs +81/−0
• src/Ema/Route.hs +27/−0
• src/Ema/Route/Slug.hs +16/−0
• src/Ema/Route/UrlStrategy.hs +46/−0
• src/Ema/Server.hs +317/−0

@@ -0,0 +1,5 @@+# Revision history for ema++## 0.1.0.0 -- 2021-04-26++* First version. Released on an unsuspecting world.

@@ -0,0 +1,661 @@+                    GNU AFFERO GENERAL PUBLIC LICENSE+                       Version 3, 19 November 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU Affero General Public License is a free, copyleft license for+software and other kinds of works, specifically designed to ensure+cooperation with the community in the case of network server software.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+our General Public Licenses are 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.++  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.++  Developers that use our General Public Licenses protect your rights+with two steps: (1) assert copyright on the software, and (2) offer+you this License which gives you legal permission to copy, distribute+and/or modify the software.++  A secondary benefit of defending all users' freedom is that+improvements made in alternate versions of the program, if they+receive widespread use, become available for other developers to+incorporate.  Many developers of free software are heartened and+encouraged by the resulting cooperation.  However, in the case of+software used on network servers, this result may fail to come about.+The GNU General Public License permits making a modified version and+letting the public access it on a server without ever releasing its+source code to the public.++  The GNU Affero General Public License is designed specifically to+ensure that, in such cases, the modified source code becomes available+to the community.  It requires the operator of a network server to+provide the source code of the modified version running there to the+users of that server.  Therefore, public use of a modified version, on+a publicly accessible server, gives the public access to the source+code of the modified version.++  An older license, called the Affero General Public License and+published by Affero, was designed to accomplish similar goals.  This is+a different license, not a version of the Affero GPL, but Affero has+released a new version of the Affero GPL which permits relicensing under+this license.++  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 Affero 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. Remote Network Interaction; Use with the GNU General Public License.++  Notwithstanding any other provision of this License, if you modify the+Program, your modified version must prominently offer all users+interacting with it remotely through a computer network (if your version+supports such interaction) an opportunity to receive the Corresponding+Source of your version by providing access to the Corresponding Source+from a network server at no charge, through some standard or customary+means of facilitating copying of software.  This Corresponding Source+shall include the Corresponding Source for any work covered by version 3+of the GNU General Public License that is incorporated pursuant to the+following paragraph.++  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 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 work with which it is combined will remain governed by version+3 of the GNU General Public License.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU Affero 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 Affero 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 Affero 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 Affero General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU Affero 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 Affero General Public License for more details.++    You should have received a copy of the GNU Affero General Public License+    along with this program.  If not, see <https://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If your software can interact with users remotely through a computer+network, you should also make sure that it provides a way for users to+get its source.  For example, if your program is a web application, its+interface could display a "Source" link that leads users to an archive+of the code.  There are many ways you could offer source, and different+solutions will be better for different programs; see section 13 for the+specific requirements.++  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 AGPL, see+<https://www.gnu.org/licenses/>.

@@ -0,0 +1,19 @@+# ema++<img width="10%" src="./docs/ema.svg">++Ema is a next-gen **Haskell** library for building [jamstack-style](https://jamstack.org/) static sites, with fast hot reload. See [ema.srid.ca](https://ema.srid.ca/) for further information.++The simplest Ema app looks like this:++```haskell+main :: IO ()+main = do+  let name :: Text = "Ema"+  runEmaPure $ \_ ->+    encodeUtf8 $ "<b>Hello</b>, from " <> name+```++## Hacking++Run `bin/run` (or <kbd>Ctrl+Shift+B</kbd> in VSCode). This runs the documentation example; modify `./.ghcid` to run a different example, such as the clock example - which updates every second, demonstrating hot reload.

@@ -0,0 +1,6 @@+module Main where ++import qualified Ema.Example.Ex03_Documentation as Doc++main :: IO ()+main = Doc.main

@@ -0,0 +1,133 @@+cabal-version:      2.4+name:               ema+version:            0.1.0.0+license:            AGPL-3.0-only+copyright:          2021 Sridhar Ratnakumar+maintainer:         srid@srid.ca+author:             Sridhar Ratnakumar+category:           Web+synopsis:           Static site generator library with hot reload+bug-reports:        https://github.com/srid/ema/issues+homepage:           https://ema.srid.ca/+description:+  Ema is a next-gen Haskell library for building jamstack-style static sites.+  Ema sites are change-aware; in addition to good ol’ static site generation,+  it provides a live server supporting fast hot-reload in the browser on code+  or data change.++extra-source-files:+  CHANGELOG.md+  LICENSE+  README.md++flag with-examples+  description: Include examples and their dependencies+  default:     True++flag with-helpers+  description: Include helper modules based on blaze-html+  default:     True++library+  -- Modules included in this executable, other than Main.+  -- other-modules:++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:+  build-depends:+    , aeson+    , async+    , base                   >=4.13.0.0 && <=4.17.0.0+    , containers+    , data-default+    , directory+    , filepath+    , http-types+    , lvar+    , monad-logger+    , monad-logger-extras+    , neat-interpolation+    , optparse-applicative+    , relude+    , safe-exceptions+    , stm+    , text+    , unliftio+    , wai+    , wai-middleware-static+    , wai-websockets+    , warp+    , websockets++  if (flag(with-helpers) || flag(with-examples))+    build-depends:+      , blaze-html+      , blaze-markup+      , filepattern+      , fsnotify++    if flag(with-examples)+      build-depends:+        , commonmark+        , commonmark-extensions+        , commonmark-pandoc+        , pandoc-types+        , profunctors+        , shower+        , tagged+        , time++  mixins:+    base hiding (Prelude),+    relude (Relude as Prelude, Relude.Container.One),+    relude++  ghc-options:+    -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns++  default-extensions:+    FlexibleContexts+    FlexibleInstances+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    MultiWayIf+    OverloadedStrings+    ScopedTypeVariables+    TupleSections+    ViewPatterns++  exposed-modules:+    Ema+    Ema.CLI++  if (flag(with-helpers) || flag(with-examples))+    exposed-modules:+      Ema.Helper.FileSystem+      Ema.Helper.Tailwind++  other-modules:+    Ema.App+    Ema.Class+    Ema.Generate+    Ema.Route+    Ema.Route.Slug+    Ema.Route.UrlStrategy+    Ema.Server++  if flag(with-examples)+    exposed-modules:+      Ema.Example.Ex01_HelloWorld+      Ema.Example.Ex02_Clock+      Ema.Example.Ex03_Documentation++  hs-source-dirs:     src+  default-language:   Haskell2010++executable ema-docs+  hs-source-dirs:   docs+  default-language: Haskell2010+  main-is:          Main.hs+  build-depends:+    , base+    , ema

@@ -0,0 +1,10 @@+{-# LANGUAGE TypeApplications #-}++module Ema+  ( module X,+  )+where++import Ema.App as X+import Ema.Class as X+import Ema.Route as X

@@ -0,0 +1,115 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Ema.App+  ( runEma,+    runEmaPure,+    runEmaWithCli,+    MonadEma,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (race_)+import Control.Monad.Logger+import Control.Monad.Logger.Extras+import Data.LVar (LVar)+import qualified Data.LVar as LVar+import Ema.CLI (Action (..), Cli)+import qualified Ema.CLI as CLI+import Ema.Class (Ema (..), MonadEma)+import qualified Ema.Generate as Generate+import qualified Ema.Server as Server+import System.Directory (getCurrentDirectory, withCurrentDirectory)+import System.Environment (lookupEnv)++-- | Pure version of @runEmaWith@ (i.e with no model).+--+-- Due to purity, there is no impure state, and thus no time-varying model.+-- Neither is there a concept of route, as only a single route (index.html) is+-- expected, whose HTML contents is specified as the only argument to this+-- function.+runEmaPure ::+  -- | How to render a route+  (CLI.Action -> LByteString) ->+  IO ()+runEmaPure render = do+  runEma (\act () () -> render act) $ \model -> do+    LVar.set model ()+    liftIO $ threadDelay maxBound++-- | Convenient version of @runEmaWith@ that takes initial model and an update+-- function. You typically want to use this.+--+-- It uses @race_@ to properly clean up the update action when the ema thread+-- exits, and vice-versa.+runEma ::+  forall model route.+  (Ema model route, Show route) =>+  -- | How to render a route, given the model+  (CLI.Action -> model -> route -> LByteString) ->+  -- | A long-running IO action that will update the @model@ @LVar@ over time.+  -- This IO action must set the initial model value in the very beginning.+  (forall m. MonadEma m => LVar model -> m ()) ->+  IO ()+runEma render runModel = do+  cli <- CLI.cliAction+  runEmaWithCli cli render runModel++-- | Like @runEma@ but takes the CLI action+--+-- Useful if you are handling CLI arguments yourself.+runEmaWithCli ::+  forall model route.+  (Ema model route, Show route) =>+  Cli ->+  -- | How to render a route, given the model+  (CLI.Action -> model -> route -> LByteString) ->+  -- | A long-running IO action that will update the @model@ @LVar@ over time.+  -- This IO action must set the initial model value in the very beginning.+  (forall m. MonadEma m => LVar model -> m ()) ->+  IO ()+runEmaWithCli cli render runModel = do+  model <- LVar.empty+  -- TODO: Allow library users to control logging levels+  let logger = colorize logToStdout+  withCurrentDirectory (CLI.workingDir cli) $ do+    cwd <- getCurrentDirectory+    flip runLoggerLoggingT logger $ do+      logInfoN $ "Running Ema under: " <> toText cwd+      logInfoN "Waiting for initial site model ..."+      logInfoN "  stuck here? set a model value using `LVar.set`"+    race_+      (flip runLoggerLoggingT logger $ runModel model)+      (flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model render)++-- | Run Ema live dev server+runEmaWithCliInCwd ::+  forall model route m.+  (MonadEma m, Ema model route, Show route) =>+  -- | CLI arguments+  CLI.Action ->+  -- | Your site model type, as a @LVar@ in order to support modifications over+  -- time (for hot-reload).+  --+  -- Use @Data.LVar.new@ to create it, and then -- over time -- @Data.LVar.set@+  -- or @Data.LVar.modify@ to modify it. Ema will automatically hot-reload your+  -- site as this model data changes.+  LVar model ->+  -- | Your site render function. Takes the current @model@ value, and the page+  -- @route@ type as arguments. It must return the raw HTML to render to browser+  -- or generate on disk.+  (Action -> model -> route -> LByteString) ->+  m ()+runEmaWithCliInCwd cliAction model render = do+  case cliAction of+    Generate dest -> do+      val <- LVar.get model+      Generate.generate dest val (render cliAction)+    Run -> do+      void $ LVar.get model+      port <- liftIO $ fromMaybe 8000 . (readMaybe @Int =<<) <$> lookupEnv "PORT"+      Server.runServerWithWebSocketHotReload port model (render cliAction)

@@ -0,0 +1,48 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Ema.CLI where++import Options.Applicative hiding (action)++data Cli = Cli+  { workingDir :: FilePath,+    action :: Action+  }+  deriving (Eq, Show)++data Action+  = Generate FilePath+  | Run+  deriving (Eq, Show)++cliParser :: Parser Cli+cliParser = do+  workingDir <-+    option+      str+      ( short 'C' <> metavar "PATH" <> value "."+          <> help "Run as if ema was started in PATH instead of the current working directory."+      )+  action <-+    subparser+      (command "gen" (info generate (progDesc "Generate static HTML files")))+      <|> pure Run+  pure Cli {..}+  where+    generate :: Parser Action+    generate =+      Generate <$> argument str (metavar "DEST...")++cliAction :: IO Cli+cliAction = do+  execParser opts+  where+    opts =+      info+        (cliParser <**> helper)+        ( fullDesc+            <> progDesc "Ema - static site generator"+            <> header "Ema"+        )

@@ -0,0 +1,41 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Ema.Class where++import Control.Monad.Logger (MonadLoggerIO)+import Ema.Route.Slug (Slug)+import UnliftIO (MonadUnliftIO)++type MonadEma m =+  ( MonadIO m,+    MonadUnliftIO m,+    MonadLoggerIO m+  )++-- | Enrich a model to work with Ema+class Ema model route | route -> model where+  -- How to convert URLs to/from routes+  encodeRoute :: route -> [Slug]+  decodeRoute :: [Slug] -> Maybe route++  -- | Routes to use when generating the static site+  --+  -- This is never used by the dev server.+  staticRoutes :: model -> [route]++  -- | List of (top-level) filepaths to serve as static assets+  --+  -- These will be copied over as-is during static site generation+  staticAssets :: Proxy route -> [FilePath]+  staticAssets Proxy = mempty++-- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only.+instance Ema () () where+  encodeRoute () = []+  decodeRoute = \case+    [] -> Just ()+    _ -> Nothing+  staticRoutes () = one ()

@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++-- | The simplest Ema site possible.+--+-- A site with one route (index) that displays content generated from pure+-- values.+module Ema.Example.Ex01_HelloWorld where++import Ema (runEmaPure)++main :: IO ()+main = do+  let speaker :: Text = "Ema"+  runEmaPure $ \_ ->+    encodeUtf8 $ "<b>Hello</b>, from " <> speaker

@@ -0,0 +1,72 @@+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | A very simple site with routes, but based on dynamically changing values+--+-- The current time is computed in the server every second, and the resultant+-- generated HTML is automatically updated on the browser. This is only a demo;+-- usually we render HTML based on files on disk or something accessible outside+-- of the browser. More advanced examples will demonstrate that.+module Ema.Example.Ex02_Clock where++import Control.Concurrent (threadDelay)+import qualified Data.LVar as LVar+import Data.List ((!!))+import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)+import Ema (Ema (..), routeUrl, runEma)+import qualified Ema.CLI+import qualified Ema.Helper.Tailwind as Tailwind+import Text.Blaze.Html5 ((!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++data Route+  = Index+  | OnlyTime+  deriving (Show, Enum, Bounded)++instance Ema UTCTime Route where+  encodeRoute = \case+    Index -> mempty+    OnlyTime -> one "time"+  decodeRoute = \case+    [] -> Just Index+    ["time"] -> Just OnlyTime+    _ -> Nothing+  staticRoutes _ =+    [minBound .. maxBound]++main :: IO ()+main = do+  runEma render $ \model ->+    forever $ do+      LVar.set model =<< liftIO getCurrentTime+      liftIO $ threadDelay $ 1 * 1000000++render :: Ema.CLI.Action -> UTCTime -> Route -> LByteString+render emaAction now r =+  Tailwind.layout emaAction (H.title "Clock") $+    H.div ! A.class_ "container mx-auto" $ do+      H.div ! A.class_ "border-t-1 p-2 tex{-# OPTIONS_GHC -fno-warn-orphans #-}t-center" $ do+        "The current time is: "+        H.pre ! A.class_ "text-6xl font-bold mt-2" $ do+          H.span ! A.class_ ("text-" <> randomColor now <> "-500") $ do+            let fmt = case r of+                  Index -> "%Y/%m/%d %H:%M:%S"+                  OnlyTime -> "%H:%M:%S"+            H.toMarkup $ formatTime defaultTimeLocale fmt now+      H.div ! A.class_ "mt-4 text-center" $ do+        case r of+          Index -> do+            routeElem OnlyTime "Hide day?"+          OnlyTime -> do+            routeElem Index "Show day?"+  where+    routeElem r' w =+      H.a ! A.class_ "text-xl text-purple-500 hover:underline" ! routeHref r' $ w+    routeHref r' =+      A.href (fromString . toString $ routeUrl r')+    randomColor t =+      let epochSecs = fromMaybe 0 . readMaybe @Int $ formatTime defaultTimeLocale "%s" t+          colors = ["green", "gray", "purple", "red", "blue", "yellow", "black", "pink"]+       in colors !! mod epochSecs (length colors)

@@ -0,0 +1,471 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | An advanced example demonstrating how to build documentation sites.+--+-- This "example" is actually used to build Ema's documentation site itself. It+-- is a work in progress currently.+module Ema.Example.Ex03_Documentation where++import qualified Commonmark as CM+import qualified Commonmark.Extensions as CE+import qualified Commonmark.Pandoc as CP+import Control.Exception (throw)+import Control.Monad.Logger+import qualified Data.LVar as LVar+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import Data.Profunctor (dimap)+import Data.Tagged (Tagged (Tagged), untag)+import qualified Data.Text as T+import Ema (Ema (..), Slug (unSlug), routeUrl, runEma)+import qualified Ema.CLI+import qualified Ema.Helper.FileSystem as FileSystem+import qualified Ema.Helper.Tailwind as Tailwind+import NeatInterpolation (text)+import System.FilePath (splitExtension, splitPath)+import Text.Blaze.Html5 ((!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import qualified Text.Pandoc.Builder as B+import Text.Pandoc.Definition (Pandoc (..))+import qualified Text.Pandoc.Walk as W++-- | Represents the relative path to a source (.md) file under some directory.+type MarkdownPath = Tagged "MarkdownPath" (NonEmpty Text)++indexMarkdownPath :: MarkdownPath+indexMarkdownPath = Tagged $ "index" :| []++mkMarkdownPath :: FilePath -> Maybe MarkdownPath+mkMarkdownPath = \case+  (splitExtension -> (fp, ".md")) ->+    let slugs = T.dropWhileEnd (== '/') . toText <$> splitPath fp+     in Tagged <$> nonEmpty slugs+  _ ->+    Nothing++markdownPathFileBase :: MarkdownPath -> Text+markdownPathFileBase (Tagged slugs) =+  head $ NE.reverse slugs++markdownPathInits :: MarkdownPath -> NonEmpty MarkdownPath+markdownPathInits (Tagged ("index" :| [])) =+  one indexMarkdownPath+markdownPathInits (Tagged (slug :| rest')) =+  indexMarkdownPath :| case nonEmpty rest' of+    Nothing ->+      one $ Tagged (one slug)+    Just rest ->+      Tagged (one slug) : go (one slug) rest+  where+    go :: NonEmpty Text -> NonEmpty Text -> [MarkdownPath]+    go x (y :| ys') =+      let this = Tagged (x <> one y)+       in case nonEmpty ys' of+            Nothing ->+              one this+            Just ys ->+              this : go (untag this) ys++type MarkdownSources = Tagged "MarkdownSources" (Map MarkdownPath Pandoc)++instance Ema MarkdownSources MarkdownPath where+  encodeRoute = \case+    Tagged ("index" :| []) -> mempty+    Tagged paths -> toList . fmap (fromString . toString) $ paths+  decodeRoute = \case+    (nonEmpty -> Nothing) ->+      pure $ Tagged $ one "index"+    (nonEmpty -> Just slugs) -> do+      let parts = toText . unSlug <$> slugs+      -- Heuristic to let requests to static files (eg: favicon.ico) to pass through+      guard $ not (any (T.isInfixOf ".") parts)+      pure $ Tagged parts+  staticRoutes (Map.keys . untag -> spaths) =+    spaths+  staticAssets _ =+    ["manifest.json", "ema.svg"]++log :: MonadLogger m => Text -> m ()+log = logInfoNS "Ex03_Documentation"++main :: IO ()+main =+  runEma render $ \model -> do+    LVar.set model =<< do+      mdFiles <- FileSystem.filesMatching "." ["**/*.md"]+      forM mdFiles readSource+        <&> Tagged . Map.fromList . catMaybes+    FileSystem.onChange "." $ \fp -> \case+      FileSystem.Update ->+        whenJustM (readSource fp) $ \(spath, s) -> do+          log $ "Update: " <> show spath+          LVar.modify model $ Tagged . Map.insert spath s . untag+      FileSystem.Delete ->+        whenJust (mkMarkdownPath fp) $ \spath -> do+          log $ "Delete: " <> show spath+          LVar.modify model $ Tagged . Map.delete spath . untag+  where+    readSource :: (MonadIO m, MonadLogger m) => FilePath -> m (Maybe (MarkdownPath, Pandoc))+    readSource fp =+      runMaybeT $ do+        spath :: MarkdownPath <- MaybeT $ pure $ mkMarkdownPath fp+        log $ "Reading " <> toText fp+        s <- readFileText fp+        pure (spath, parseMarkdown s)++newtype BadRoute = BadRoute MarkdownPath+  deriving (Show, Exception)++render :: Ema.CLI.Action -> MarkdownSources -> MarkdownPath -> LByteString+render emaAction srcs spath = do+  case Map.lookup spath (untag srcs) of+    Nothing -> throw $ BadRoute spath+    Just doc -> do+      Tailwind.layout emaAction (headHtml spath doc) (bodyHtml srcs spath doc)++headHtml :: MarkdownPath -> Pandoc -> H.Html+headHtml spath doc = do+  let siteTitle = "Ema"+      routeTitle = maybe (last $ untag spath) plainify $ getPandocH1 doc+  H.title $+    H.text $+      if routeTitle == siteTitle then siteTitle else routeTitle <> " – " <> siteTitle+  H.meta ! A.name "description" ! A.content "Ema static site generator (Jamstack) in Haskell"+  favIcon+  -- Make this a PWA and w/ https://web.dev/themed-omnibox/+  H.link ! A.rel "manifest" ! A.href "/manifest.json"+  H.meta ! A.name "theme-color" ! A.content "#d53f8c"+  unless (spath == indexMarkdownPath) prismJs+  where+    prismJs = do+      H.unsafeByteString . encodeUtf8 $+        [text|+        <link href="https://cdn.jsdelivr.net/npm/prismjs@1.23.0/themes/prism-tomorrow.css" rel="stylesheet" />+        <script src="https://cdn.jsdelivr.net/combine/npm/prismjs@1.23.0/prism.min.js,npm/prismjs@1.23.0/plugins/autoloader/prism-autoloader.min.js"></script>+        |]+    favIcon = do+      H.unsafeByteString . encodeUtf8 $+        [text|+        <link href="/ema.svg" rel="icon" />+        |]++bodyHtml :: MarkdownSources -> MarkdownPath -> Pandoc -> H.Html+bodyHtml srcs spath doc = do+  H.div ! A.class_ "flex justify-center p-4 bg-red-500 text-gray-100 font-bold text-2xl" $ do+    H.div $ do+      H.b "WIP: "+      "Documentation is still being written"+  H.div ! A.class_ "container mx-auto xl:max-w-screen-lg" $ do+    H.div ! A.class_ "px-2" $ do+      renderBreadcrumbs srcs spath+      renderPandoc $+        doc+          & applyClassLibrary (\c -> fromMaybe c $ Map.lookup c emaMarkdownStyleLibrary)+          & rewriteLinks+            -- Rewrite .md links to @MarkdownPath@+            ( \url -> fromMaybe url $ do+                guard $ not $ "://" `T.isInfixOf` url+                target <- mkMarkdownPath $ toString url+                -- Check that .md links are not broken+                if Map.member target (untag srcs)+                  then pure $ routeUrl target+                  else throw $ BadRoute target+            )+    H.footer ! A.class_ "mt-8 text-center text-gray-500" $ do+      "Powered by "+      H.a ! A.class_ "font-bold" ! A.target "blank" ! A.href "https://github.com/srid/ema" $ "Ema"+  where+    emaMarkdownStyleLibrary =+      Map.fromList+        [ ("feature", "flex justify-center items-center text-center shadow-lg p-2 m-2 w-32 h-16 lg:w-auto rounded border-2 border-gray-400 bg-pink-100 text-base font-bold hover:bg-pink-200 hover:border-black"),+          ("avatar", "float-right w-32 h-32"),+          -- List item specifc styles+          ("item-intro", "text-gray-500"),+          -- Styling the last line in series posts+          ("last", "mt-8 border-t-2 border-pink-500 pb-1 pl-1 bg-gray-50 rounded"),+          ("next", "py-2 text-xl italic font-bold")+        ]++lookupTitleForgiving :: MarkdownSources -> MarkdownPath -> Text+lookupTitleForgiving srcs spath =+  fromMaybe (markdownPathFileBase spath) $ do+    doc <- Map.lookup spath $ untag srcs+    is <- getPandocH1 doc+    pure $ plainify is++renderBreadcrumbs :: MarkdownSources -> MarkdownPath -> H.Html+renderBreadcrumbs srcs spath = do+  whenNotNull (init $ markdownPathInits spath) $ \(toList -> crumbs) ->+    H.div ! A.class_ "w-full text-gray-600 mt-4" $ do+      H.div ! A.class_ "flex justify-center" $ do+        H.div ! A.class_ "w-full bg-white py-2 rounded" $ do+          H.ul ! A.class_ "flex text-gray-500 text-sm lg:text-base" $ do+            forM_ crumbs $ \crumb ->+              H.li ! A.class_ "inline-flex items-center" $ do+                H.a ! A.class_ "px-1 font-bold bg-pink-500 text-gray-50 rounded"+                  ! routeHref crumb+                  $ H.text $ lookupTitleForgiving srcs crumb+                rightArrow+            H.li ! A.class_ "inline-flex items-center text-gray-600" $ do+              H.a $ H.text $ lookupTitleForgiving srcs spath+  where+    rightArrow =+      H.unsafeByteString $+        encodeUtf8+          [text|+          <svg fill="currentColor" viewBox="0 0 20 20" class="h-5 w-auto text-gray-400"><path fill-rule="evenodd" d="M7.293 14.707a1 1 0 010-1.414L10.586 10 7.293 6.707a1 1 0 011.414-1.414l4 4a1 1 0 010 1.414l-4 4a1 1 0 01-1.414 0z" clip-rule="evenodd"></path></svg>+          |]++routeHref :: Ema a r => r -> H.Attribute+routeHref r' =+  A.href (fromString . toString $ routeUrl r')++-- Pandoc transformer++rewriteLinks :: (Text -> Text) -> Pandoc -> Pandoc+rewriteLinks f =+  W.walk $ \case+    B.Link attr is (url, title) ->+      B.Link attr is (f url, title)+    x -> x++applyClassLibrary :: (Text -> Text) -> Pandoc -> Pandoc+applyClassLibrary f =+  walkBlocks . walkInlines+  where+    walkBlocks = W.walk $ \case+      B.Div attr bs ->+        B.Div (g attr) bs+      x -> x+    walkInlines = W.walk $ \case+      B.Span attr is ->+        B.Span (g attr) is+      x -> x+    g (id', cls, attr) =+      (id', withPackedClass f cls, attr)+    withPackedClass :: (Text -> Text) -> [Text] -> [Text]+    withPackedClass =+      dimap (T.intercalate " ") (T.splitOn " ")++-- Pandoc renderer+--+-- Note that we hardcode tailwind classes, because pandoc AST is not flexible+-- enough to provide attrs for all inlines/blocks. So we can't rely on Walk to+-- transform it.++renderPandoc :: Pandoc -> H.Html+renderPandoc (Pandoc _meta blocks) =+  mapM_ rpBlock blocks++rpBlock :: B.Block -> H.Html+rpBlock = \case+  B.Plain is ->+    mapM_ rpInline is+  B.Para is ->+    H.p ! A.class_ "my-2" $ mapM_ rpInline is+  B.LineBlock iss ->+    forM_ iss $ \is ->+      mapM_ rpInline is >> "\n"+  B.CodeBlock (id', classes, attrs) s ->+    -- Prism friendly classes+    let classes' = flip concatMap classes $ \cls -> [cls, "language-" <> cls]+     in H.pre ! rpAttr (id', classes', attrs) $ H.code ! rpAttr ("", classes', []) $ H.text s+  B.RawBlock _ _ ->+    pure ()+  B.BlockQuote bs ->+    H.blockquote $ mapM_ rpBlock bs+  B.OrderedList _ bss ->+    H.ol ! A.class_ listStyle $+      forM_ bss $ \bs ->+        H.li ! A.class_ listItemStyle $ mapM_ rpBlock bs+  B.BulletList bss ->+    H.ul ! A.class_ (listStyle <> " list-disc") $+      forM_ bss $ \bs ->+        H.li ! A.class_ listItemStyle $ mapM_ rpBlock bs+  B.DefinitionList defs ->+    H.dl $+      forM_ defs $ \(term, descList) -> do+        mapM_ rpInline term+        forM_ descList $ \desc ->+          H.dd $ mapM_ rpBlock desc+  B.Header level attr is ->+    headerElem level ! rpAttr attr $ mapM_ rpInline is+  B.HorizontalRule ->+    H.hr+  B.Table {} ->+    throw Unsupported+  B.Div attr bs ->+    H.div ! rpAttr attr $ mapM_ rpBlock bs+  B.Null ->+    pure ()+  where+    listStyle = "list-inside ml-2"+    listItemStyle = "text-xl py-1.5 lg:py-0 lg:text-base"++headerElem :: Int -> H.Html -> H.Html+headerElem = \case+  1 -> H.h1 ! A.class_ ("text-6xl " <> my <> " text-center py-2")+  2 -> H.h2 ! A.class_ ("text-5xl " <> my)+  3 -> H.h3 ! A.class_ ("text-4xl " <> my)+  4 -> H.h4 ! A.class_ ("text-3xl " <> my)+  5 -> H.h5 ! A.class_ ("text-2xl " <> my)+  6 -> H.h6 ! A.class_ ("text-xl " <> my)+  _ -> error "Invalid pandoc header level"+  where+    my = "my-2"++rpInline :: B.Inline -> H.Html+rpInline = \case+  B.Str s -> H.toHtml s+  B.Emph is ->+    H.em $ mapM_ rpInline is+  B.Strong is ->+    H.strong $ mapM_ rpInline is+  B.Underline is ->+    H.u $ mapM_ rpInline is+  B.Strikeout is ->+    -- FIXME: Should use <s>, but blaze doesn't have it.+    H.del $ mapM_ rpInline is+  B.Superscript is ->+    H.sup $ mapM_ rpInline is+  B.Subscript is ->+    H.sub $ mapM_ rpInline is+  B.Quoted qt is ->+    flip inQuotes qt $ mapM_ rpInline is+  B.Code attr s ->+    H.code ! rpAttr attr $ H.toHtml s+  B.Space -> " "+  B.SoftBreak -> " "+  B.LineBreak -> H.br+  B.RawInline _fmt s ->+    H.pre $ H.toHtml s+  B.Math _ _ ->+    throw Unsupported+  B.Link attr is (url, title) -> do+    let (cls, target) =+          if "://" `T.isInfixOf` url+            then ("text-pink-600 hover:underline", A.target "_blank")+            else ("text-pink-600 font-bold hover:bg-pink-50", mempty)+    H.a+      ! A.class_ cls+      ! A.href (H.textValue url)+      ! A.title (H.textValue title)+      ! target+      ! rpAttr attr+      $ mapM_ rpInline is+  B.Image attr is (url, title) ->+    H.img ! A.src (H.textValue url) ! A.title (H.textValue title) ! A.alt (H.textValue $ plainify is) ! rpAttr attr+  B.Note _ ->+    throw Unsupported+  B.Span attr is ->+    H.span ! rpAttr attr $ mapM_ rpInline is+  x ->+    H.pre $ H.toHtml $ show @Text x+  where+    inQuotes :: H.Html -> B.QuoteType -> H.Html+    inQuotes w = \case+      B.SingleQuote -> "‘" >> w <* "’"+      B.DoubleQuote -> "“" >> w <* "”"++rpAttr :: B.Attr -> H.Attribute+rpAttr (id', classes, attrs) =+  let cls = T.intercalate " " classes+   in unlessNull id' (A.id (fromString . toString $ id'))+        <> unlessNull cls (A.class_ (fromString . toString $ cls))+        <> mconcat (fmap (\(k, v) -> H.dataAttribute (fromString . toString $ k) (fromString . toString $ v)) attrs)+  where+    unlessNull x f =+      if T.null x then mempty else f++data Unsupported = Unsupported+  deriving (Show, Exception)++-- Pandoc helpers++getPandocH1 :: Pandoc -> Maybe [B.Inline]+getPandocH1 = listToMaybe . W.query go+  where+    go :: B.Block -> [[B.Inline]]+    go = \case+      B.Header 1 _ inlines ->+        [inlines]+      _ ->+        []++-- | Convert Pandoc AST inlines to raw text.+plainify :: [B.Inline] -> Text+plainify = W.query $ \case+  B.Str x -> x+  B.Code _attr x -> x+  B.Space -> " "+  B.SoftBreak -> " "+  B.LineBreak -> " "+  B.RawInline _fmt s -> s+  B.Math _mathTyp s -> s+  -- Ignore the rest of AST nodes, as they are recursively defined in terms of+  -- `Inline` which `W.query` will traverse again.+  _ -> ""++-- ------------------------+-- Markdown parsing helpers+-- ------------------------++newtype BadMarkdown = BadMarkdown Text+  deriving (Show, Exception)++parseMarkdown :: Text -> Pandoc+parseMarkdown s =+  Pandoc mempty $+    B.toList $+      CP.unCm @() @B.Blocks $+        either (throw . BadMarkdown . show) id $+          join $ CM.commonmarkWith @(Either CM.ParseError) markdownSpec "x" s++type SyntaxSpec' m il bl =+  ( Monad m,+    CM.IsBlock il bl,+    CM.IsInline il,+    Typeable m,+    Typeable il,+    Typeable bl,+    CE.HasEmoji il,+    CE.HasStrikethrough il,+    CE.HasPipeTable il bl,+    CE.HasTaskList il bl,+    CM.ToPlainText il,+    CE.HasFootnote il bl,+    CE.HasMath il,+    CE.HasDefinitionList il bl,+    CE.HasDiv bl,+    CE.HasQuoted il,+    CE.HasSpan il+  )++markdownSpec ::+  SyntaxSpec' m il bl =>+  CM.SyntaxSpec m il bl+markdownSpec =+  mconcat+    [ CE.gfmExtensions,+      CE.fancyListSpec,+      CE.footnoteSpec,+      CE.mathSpec,+      CE.smartPunctuationSpec,+      CE.definitionListSpec,+      CE.attributesSpec,+      CE.rawAttributeSpec,+      CE.fencedDivSpec,+      CE.bracketedSpanSpec,+      CE.autolinkSpec,+      CM.defaultSyntaxSpec,+      -- as the commonmark documentation states, pipeTableSpec should be placed after+      -- fancyListSpec and defaultSyntaxSpec to avoid bad results when non-table lines+      CE.pipeTableSpec+    ]

@@ -0,0 +1,68 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE TypeApplications #-}++module Ema.Generate where++import Control.Exception (throw)+import Control.Monad.Logger+import Ema.Class+import Ema.Route (routeFile)+import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)+import System.FilePath (takeDirectory, (</>))+import System.FilePattern.Directory (getDirectoryFiles)++log :: MonadLogger m => LogLevel -> Text -> m ()+log = logWithoutLoc "Generate"++generate ::+  forall model route m.+  (MonadEma m, Ema model route) =>+  FilePath ->+  model ->+  (model -> route -> LByteString) ->+  m ()+generate dest model render = do+  unlessM (liftIO $ doesDirectoryExist dest) $ do+    error "Destination does not exist"+  let routes = staticRoutes model+  log LevelInfo $ "Writing " <> show (length routes) <> " routes"+  forM_ routes $ \r -> do+    let fp = dest </> routeFile @model r+    log LevelInfo $ toText $ "W " <> fp+    let !s = render model r+    liftIO $ do+      createDirectoryIfMissing True (takeDirectory fp)+      writeFileLBS fp s+  forM_ (staticAssets $ Proxy @route) $ \staticPath -> do+    copyDirRecursively staticPath dest++newtype StaticAssetMissing = StaticAssetMissing FilePath+  deriving (Show, Exception)++copyDirRecursively ::+  MonadEma m =>+  -- | Source file or directory relative to CWD that will be copied+  FilePath ->+  -- | Directory *under* which the source file/dir will be copied+  FilePath ->+  m ()+copyDirRecursively srcRel destParent =+  liftIO (doesFileExist srcRel) >>= \case+    True -> do+      let b = destParent </> srcRel+      log LevelInfo $ toText $ "C " <> b+      liftIO $ copyFile srcRel b+    False ->+      liftIO (doesDirectoryExist srcRel) >>= \case+        False ->+          throw $ StaticAssetMissing srcRel+        True -> do+          fs <- liftIO $ getDirectoryFiles srcRel ["**"]+          forM_ fs $ \fp -> do+            let a = srcRel </> fp+                b = destParent </> srcRel </> fp+            log LevelInfo $ toText $ "C " <> b+            liftIO $ do+              createDirectoryIfMissing True (takeDirectory b)+              copyFile a b

@@ -0,0 +1,86 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++-- | Helper to read a directory of files, and observe it for changes.+--+-- Use @new@ in conjunction with @observe@ in your @runEma@ function call.+module Ema.Helper.FileSystem+  ( filesMatching,+    onChange,+    FileAction (..),+  )+where++import Control.Concurrent (threadDelay)+import Control.Exception (finally)+import Control.Monad.Logger+import System.Directory (canonicalizePath)+import System.FSNotify+  ( ActionPredicate,+    Event (..),+    StopListening,+    WatchManager,+    watchTree,+    withManager,+  )+import System.FilePath (makeRelative)+import System.FilePattern (FilePattern)+import System.FilePattern.Directory (getDirectoryFiles)+import UnliftIO (MonadUnliftIO, withRunInIO)++type FolderPath = FilePath++log :: MonadLogger m => LogLevel -> Text -> m ()+log = logWithoutLoc "Helper.FileSystem"++filesMatching :: (MonadIO m, MonadLogger m) => FolderPath -> [FilePattern] -> m [FilePath]+filesMatching parent' pats = do+  parent <- liftIO $ canonicalizePath parent'+  log LevelInfo $ toText $ "Traversing " <> parent <> " for files matching " <> show pats+  liftIO $ getDirectoryFiles parent pats++data FileAction = Update | Delete+  deriving (Eq, Show)++onChange ::+  forall m.+  (MonadIO m, MonadLogger m, MonadUnliftIO m) =>+  FolderPath ->+  (FilePath -> FileAction -> m ()) ->+  m ()+onChange parent' f = do+  -- NOTE: It is important to use canonical path, because this will allow us to+  -- transform fsnotify event's (absolute) path into one that is relative to+  -- @parent'@ (as passed by user), which is what @f@ will expect.+  parent <- liftIO $ canonicalizePath parent'+  withManagerM $ \mgr -> do+    log LevelInfo $ toText $ "Monitoring " <> parent <> " for changes"+    stop <- watchTreeM mgr parent (const True) $ \event -> do+      log LevelDebug $ show event+      let rel = makeRelative parent+      case event of+        Added (rel -> fp) _ _ -> f fp Update+        Modified (rel -> fp) _ _ -> f fp Update+        Removed (rel -> fp) _ _ -> f fp Delete+        Unknown (rel -> fp) _ _ -> f fp Delete+    liftIO $ threadDelay maxBound `finally` stop++withManagerM ::+  (MonadIO m, MonadUnliftIO m) =>+  (WatchManager -> m a) ->+  m a+withManagerM f = do+  withRunInIO $ \run ->+    withManager $ \mgr -> run (f mgr)++watchTreeM ::+  forall m.+  (MonadIO m, MonadUnliftIO m) =>+  WatchManager ->+  FilePath ->+  ActionPredicate ->+  (Event -> m ()) ->+  m StopListening+watchTreeM wm fp pr f =+  withRunInIO $ \run ->+    watchTree wm fp pr $ \evt -> run (f evt)

@@ -0,0 +1,81 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}++-- | Use Tailwind CSS with blaze-html? Try this module for rapid prototyping of+-- websites in Ema.+module Ema.Helper.Tailwind+  ( -- * Main functions+    layout,+    layoutWith,++    -- * Tailwind shims+    twindShimCdn,+    twindShimOfficial,+    twindShimUnofficial,+  )+where++import qualified Ema.CLI+import NeatInterpolation (text)+import qualified Text.Blaze.Html.Renderer.Utf8 as RU+import Text.Blaze.Html5 ((!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++-- | A simple and off-the-shelf layout using Tailwind CSS+layout :: Ema.CLI.Action -> H.Html -> H.Html -> LByteString+layout action =+  layoutWith "en" "UTF-8" $ case action of+    Ema.CLI.Generate _ ->+      twindShimUnofficial+    _ ->+      -- Twind shim doesn't reliably work in dev server mode. Let's just use the+      -- tailwind CDN.+      twindShimCdn++-- | Like @layout@, but pick your own language, encoding and tailwind shim.+layoutWith :: H.AttributeValue -> H.AttributeValue -> H.Html -> H.Html -> H.Html -> LByteString+layoutWith lang encoding twindShim appHead appBody = RU.renderHtml $ do+  H.docType+  H.html ! A.lang lang $ do+    H.head $ do+      H.meta ! A.charset encoding+      -- This makes the site mobile friendly by default.+      H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1"+      appHead+      twindShim+    H.body $ do+      appBody++-- | Loads full tailwind CSS from CDN (not good for production)+twindShimCdn :: H.Html+twindShimCdn =+  H.unsafeByteString . encodeUtf8 $+    [text|+    <link href="https://unpkg.com/tailwindcss@2.1.1/dist/tailwind.min.css" rel="stylesheet" type="text/css">+    |]++-- | This shim may not work with hot reload.+twindShimOfficial :: H.Html+twindShimOfficial =+  H.unsafeByteString . encodeUtf8 $+    [text|+    <script type="module" src="https://cdn.skypack.dev/twind/shim"></script>+    |]++-- | This shim does work with hot reload, but it spams console with warnings.+twindShimUnofficial :: H.Html+twindShimUnofficial = do+  H.script+    ! A.type_ "text/javascript"+    ! A.src "https://cdn.jsdelivr.net/combine/npm/twind/twind.umd.min.js,npm/twind/observe/observe.umd.min.js"+    $ ""+  H.script ! A.type_ "text/javascript" $ twindShimUnofficialEval+  where+    twindShimUnofficialEval :: H.Html+    twindShimUnofficialEval =+      H.unsafeByteString . encodeUtf8 $+        [text|+        twind.setup({})+        twindObserve.observe(document.documentElement)+        |]

@@ -0,0 +1,27 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}++module Ema.Route+  ( routeUrl,+    routeFile,+    Slug (unSlug),+    UrlStrategy (..),+  )+where++import Data.Default (def)+import Ema.Class+import Ema.Route.Slug (Slug (unSlug))+import Ema.Route.UrlStrategy+  ( UrlStrategy (..),+    slugFileWithStrategy,+    slugUrlWithStrategy,+  )++routeUrl :: forall a r. Ema a r => r -> Text+routeUrl r =+  slugUrlWithStrategy def (encodeRoute @a r)++routeFile :: forall a r. Ema a r => r -> FilePath+routeFile r =+  slugFileWithStrategy def (encodeRoute @a r)

@@ -0,0 +1,16 @@+{-# LANGUAGE InstanceSigs #-}++module Ema.Route.Slug where++import qualified Data.Text as T++-- | An URL path is made of multiple slugs, separated by '/'+newtype Slug = Slug {unSlug :: Text}+  deriving (Eq, Show)++instance IsString Slug where+  fromString :: HasCallStack => String -> Slug+  fromString (toText -> s) =+    if "/" `T.isInfixOf` s+      then error ("Slug cannot contain a slash: " <> s)+      else Slug s

@@ -0,0 +1,46 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE QuasiQuotes #-}++module Ema.Route.UrlStrategy where++import Data.Default (Default, def)+import qualified Data.Text as T+import Ema.Route.Slug (Slug (unSlug))+import System.FilePath (joinPath)++data UrlStrategy+  = -- | URLs always end with a slash, and correspond to index.html in that folder+    UrlStrategy_FolderOnly+  | -- | Pretty URLs without ugly .html ext or slash-suffix+    UrlStrategy_HtmlOnlySansExt+  deriving (Eq, Show, Ord)++instance Default UrlStrategy where+  def = UrlStrategy_HtmlOnlySansExt++slugUrlWithStrategy :: UrlStrategy -> [Slug] -> Text+slugUrlWithStrategy strat slugs =+  case strat of+    UrlStrategy_FolderOnly ->+      "/" <> T.replace "index.html" "" (toText $ slugFileWithStrategy strat slugs)+    UrlStrategy_HtmlOnlySansExt ->+      -- FIXME: This should replace only at the end, not middle+      let fp = toText (slugFileWithStrategy strat slugs)+       in if+              | "index.html" == fp ->+                "/"+              | "/index.html" `T.isSuffixOf` fp ->+                "/" <> T.take (T.length fp - T.length "/index.html") fp+              | ".html" `T.isSuffixOf` fp ->+                "/" <> T.take (T.length fp - T.length ".html") fp+              | otherwise ->+                "/" <> fp++slugFileWithStrategy :: UrlStrategy -> [Slug] -> FilePath+slugFileWithStrategy strat slugs =+  case strat of+    UrlStrategy_FolderOnly ->+      joinPath $ fmap (toString . unSlug) slugs <> ["index.html"]+    UrlStrategy_HtmlOnlySansExt ->+      let (term :| (reverse -> parts)) = fromMaybe ("index" :| []) $ nonEmpty (reverse $ fmap unSlug slugs)+       in joinPath $ fmap toString parts <> [toString term <> ".html"]

@@ -0,0 +1,317 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeApplications #-}++-- | TODO: Refactor this module+module Ema.Server where++import Control.Concurrent.Async (race)+import Control.Exception (catch, try)+import Control.Monad.Logger+import Data.LVar (LVar)+import qualified Data.LVar as LVar+import qualified Data.Text as T+import Ema.Class (Ema (decodeRoute, staticAssets), MonadEma)+import GHC.IO.Unsafe (unsafePerformIO)+import NeatInterpolation (text)+import qualified Network.HTTP.Types as H+import qualified Network.Wai as Wai+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai.Handler.WebSockets as WaiWs+import qualified Network.Wai.Middleware.Static as Static+import Network.WebSockets (ConnectionException)+import qualified Network.WebSockets as WS+import Relude.Extra.Foldable1 (foldl1')+import Text.Printf (printf)++runServerWithWebSocketHotReload ::+  forall model route m.+  (Ema model route, Show route, MonadEma m) =>+  Int ->+  LVar model ->+  (model -> route -> LByteString) ->+  m ()+runServerWithWebSocketHotReload port model render = do+  let settings = Warp.setPort port Warp.defaultSettings+  logger <- askLoggerIO++  logInfoN $ "Launching Ema at http://localhost:" <> show port+  liftIO $+    Warp.runSettings settings $+      assetsMiddleware $+        WaiWs.websocketsOr+          WS.defaultConnectionOptions+          (flip runLoggingT logger . wsApp)+          (httpApp logger)+  where+    wsApp pendingConn = do+      conn :: WS.Connection <- lift $ WS.acceptRequest pendingConn+      logger <- askLoggerIO+      lift $+        WS.withPingThread conn 30 (pure ()) $+          flip runLoggingT logger $ do+            subId <- LVar.addListener model+            let log lvl (s :: Text) =+                  logWithoutLoc (toText @String $ printf "WS.Client.%.2d" subId) lvl s+            log LevelInfo "Connected"+            let askClientForRoute = do+                  msg :: Text <- liftIO $ WS.receiveData conn+                  let r =+                        msg+                          & pathInfoFromWsMsg+                          & routeFromPathInfo+                          & fromMaybe (error "invalid route from ws")+                  log LevelDebug $ "<~~ " <> show r+                  pure r+                sendRouteHtmlToClient r s = do+                  liftIO $ WS.sendTextData conn $ renderWithEmaHtmlShims logger s r+                  log LevelDebug $ " ~~> " <> show r+                loop = flip runLoggingT logger $ do+                  -- Notice that we @askClientForRoute@ in succession twice here.+                  -- The first route will be the route the client intends to observe+                  -- for changes on. The second route, *if* it is sent, indicates+                  -- that the client wants to *switch* to that route. This proecess+                  -- repeats ad infinitum: i.e., the third route is for observing+                  -- changes, the fourth route is for switching to, and so on.+                  watchingRoute <- askClientForRoute+                  -- Listen *until* either we get a new value, or the client requests+                  -- to switch to a new route.+                  liftIO $ do+                    race (LVar.listenNext model subId) (runLoggingT askClientForRoute logger) >>= \res -> flip runLoggingT logger $ case res of+                      Left newHtml -> do+                        -- The page the user is currently viewing has changed. Send+                        -- the new HTML to them.+                        sendRouteHtmlToClient watchingRoute newHtml+                        lift loop+                      Right nextRoute -> do+                        -- The user clicked on a route link; send them the HTML for+                        -- that route this time, ignoring what we are watching+                        -- currently (we expect the user to initiate a watch route+                        -- request immediately following this).+                        sendRouteHtmlToClient nextRoute =<< LVar.get model+                        lift loop+            liftIO (try loop) >>= \case+              Right () -> pure ()+              Left (err :: ConnectionException) -> do+                log LevelError $ "Websocket error: " <> show err+                LVar.removeListener model subId+    assetsMiddleware = do+      case nonEmpty (staticAssets $ Proxy @route) of+        Nothing -> id+        Just topLevelPaths ->+          let assetPolicy :: Static.Policy =+                foldl1' (Static.<|>) $ Static.hasPrefix <$> topLevelPaths+           in Static.staticPolicy assetPolicy+    httpApp logger req f = do+      flip runLoggingT logger $ do+        let path = Wai.pathInfo req+            mr = routeFromPathInfo path+        logInfoNS "HTTP" $ show path <> " as " <> show mr+        (status, v) <- case mr of+          Nothing ->+            pure (H.status404, "No route")+          Just r -> do+            val <- LVar.get model+            let html = renderCatchingErrors logger val r+            pure (H.status200, html <> emaStatusHtml <> wsClientShim)+        liftIO $ f $ Wai.responseLBS status [(H.hContentType, "text/html")] v+    renderWithEmaHtmlShims logger m r =+      renderCatchingErrors logger m r <> emaStatusHtml+    renderCatchingErrors logger m r =+      unsafeCatch (render m r) $ \(err :: SomeException) ->+        unsafePerformIO $ do+          -- Log the error first.+          flip runLoggingT logger $ logErrorNS "App" $ show @Text err+          pure $+            encodeUtf8 $+              "<html><head><meta charset=\"UTF-8\"></head><body><h1>Ema App threw an exception</h1><pre style=\"border: 1px solid; padding: 1em 1em 1em 1em;\">"+                <> show @Text err+                <> "</pre><p>Once you fix your code this page will automatically update.</body>"+    routeFromPathInfo =+      decodeRoute @model . fmap (fromString . toString)+    -- TODO: It would be good have this also get us the stack trace.+    unsafeCatch :: Exception e => a -> (e -> a) -> a+    unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f)++-- | Return the equivalent of WAI's @pathInfo@, from the raw path string+-- (`document.location.pathname`) the browser sends us.+pathInfoFromWsMsg :: Text -> [Text]+pathInfoFromWsMsg =+  filter (/= "") . T.splitOn "/" . T.drop 1++-- Browser-side JavaScript code for interacting with the Haskell server+wsClientShim :: LByteString+wsClientShim =+  encodeUtf8+    [text|+        <script type="module" src="https://cdn.jsdelivr.net/npm/morphdom@2.6.1/dist/morphdom-umd.min.js"></script>++        <script type="module">++        function htmlToElem(html) {+          let temp = document.createElement('template');+          html = html.trim(); // Never return a space text node as a result+          temp.innerHTML = html;+          return temp.content.firstChild;+        };++        // Unlike setInnerHtml, this patches the Dom in place+        function setHtml(elm, html) {+          var htmlElem = htmlToElem(html);+          morphdom(elm, html);+        };++        // FIXME: Can't make this work with tailwind shim+        function reloadScripts(elm) {+          Array.from(elm.querySelectorAll("script")).forEach(oldScript => {+            const newScript = document.createElement("script");+            Array.from(oldScript.attributes)+              .forEach(attr => newScript.setAttribute(attr.name, attr.value));+            newScript.appendChild(document.createTextNode(oldScript.innerHTML));+            oldScript.parentNode.replaceChild(newScript, oldScript);+          });+        };++        // Ema Status indicator+        const messages = {+          connected: "Connected",+          reloading: "Reloading",+          connecting: "Connecting to the server",+          disconnected: "Disconnected - try reloading the window"+        };+        function setIndicators(connected, reloading, connecting, disconnected) {+          const is = { connected, reloading, connecting, disconnected }++          for (const i in is) {+            document.getElementById(`ema-$${i}`).style.display =+              is[i] ? "block" : "none"+            if(is[i])+              document.getElementById('ema-message').innerText = messages[i]+          };+          document.getElementById("ema-indicator").style.display = "block";+        };+        window.connected    = () => setIndicators(true,  false, false, false)+        window.reloading    = () => setIndicators(false, true,  false, false)+        window.connecting   = () => setIndicators(false, false, true,  false)+        window.disconnected = () => setIndicators(false, false, false, true)+        window.hideIndicator = () => {+          document.getElementById("ema-indicator").style.display = "none";+        };++        // WebSocket logic: watching for server changes & route switching+        function init() {+          console.log("ema: Opening ws conn");+          window.connecting();+          var ws = new WebSocket("ws://" + window.location.host);++          // Call this, then the server will send update *once*. Call again for+          // continous monitoring.+          function watchCurrentRoute() {+            console.log(`ema: ⏿ Observing changes to $${document.location.pathname}`);+            ws.send(document.location.pathname);+          };++          function switchRoute(path) {+             console.log(`ema: → Switching to $${path}`);+             ws.send(path);+          }++          function handleRouteClicks(e) {+              const origin = e.target.closest("a");+              if (origin) {+                if (window.location.host === origin.host) {+                  window.history.pushState({}, "", origin.pathname);+                  switchRoute(origin.pathname);+                  e.preventDefault();+                };+              }+            };+          // Intercept route click events, and ask server for its HTML whilst+          // managing history state.+          window.addEventListener(`click`, handleRouteClicks);++          ws.onopen = () => {+            // window.connected();+            window.hideIndicator();+            watchCurrentRoute();+          };++          ws.onclose = () => {+            console.log("ema: reconnecting ..");+            window.removeEventListener(`click`, handleRouteClicks);+            window.reloading();+            // Reconnect after as small a time is possible, then retry again. +            // ghcid can take 1s or more to reboot. So ideally we need an+            // exponential retry logic.+            // +            // Note that a slow delay (200ms) may often cause websocket+            // connection error (ghcid hasn't rebooted yet), which cannot be+            // avoided as it is impossible to trap this error and handle it.+            // You'll see a big ugly error in the console.+            setTimeout(init, 400);+          };++          ws.onmessage = evt => {+            console.log("ema: ✍ Patching DOM")+            setHtml(document.documentElement, evt.data);+            // reloadScripts(document.documentElement);+            watchCurrentRoute();+          };+          window.onbeforeunload = evt => { ws.close(); };+          window.onpagehide = evt => { ws.close(); };++          // When the user clicks the back button, resume watching the URL in+          // the addressback, which has the effect of loading it immediately.+          window.onpopstate = function(e) {+            watchCurrentRoute();+          };+        };+        +        window.onpageshow = init;+        </script>+    |]++emaStatusHtml :: LByteString+emaStatusHtml =+  encodeUtf8+    [text|+      <div class="absolute top-0 left-0 p-2" style="display: none;" id="ema-indicator">+        <div+          class="+            flex overflow-hidden items-center p-2 text-xs gap-2+            h-8 border-2 border-gray-200 bg-white rounded-full shadow-lg+            transition-[width,height] duration-500 ease-in-out w-8 hover:w-full+          "+          id="ema-status"+          title="Ema Status"+        >+          <div+            hidden+            class="bg-green-600 w-3 h-3 rounded-full flex-none"+            id="ema-connected"+          ></div>+          <div+            hidden+            class="+              animate-spin bg-gradient-to-r from-blue-300 to-blue-600+              w-3 h-3 rounded-full flex-none+            "+            id="ema-reloading"+          ></div>+          <div+            hidden+            class="bg-yellow-500 w-3 h-3 rounded-full flex-none"+            id="ema-connecting"+          >+            <div+              class="animate-ping bg-yellow-500 w-3 h-3 rounded-full flex-none"+            ></div>+          </div>+          <div+            hidden+            class="bg-red-500 w-3 h-3 rounded-full flex-none"+            id="ema-disconnected"+          ></div>+          <p class="whitespace-nowrap" id="ema-message"></p>+        </div>+      </div>+  |]