darcswatch (empty) → 0.1
raw patch · 22 files changed
+3052/−0 lines, 22 filesdep +Cryptodep +HTTPdep +basesetup-changedbinary-added
Dependencies added: Crypto, HTTP, base, bytestring, containers, directory, filepath, nano-md5, network, old-time, parsec, unix, xhtml, zlib
Files
- LICENSE +339/−0
- README +43/−0
- Setup.hs +3/−0
- darcswatch.cabal +74/−0
- documentation.html +67/−0
- example/config +11/−0
- example/keyring binary
- example/mails/patchBEbWYh +156/−0
- example/mails/patchInvTest +147/−0
- example/mails/patchOKsIKA +79/−0
- example/mails/patch_1f03d40fbe9d0593a9eb7fbefc3bfa85 +332/−0
- example/mails/patch_a963212153b4f5e3f1777daa562dd989 +35/−0
- example/mails/patchsmaJcF +130/−0
- mailfilter.sh +131/−0
- src/CachedGet.hs +126/−0
- src/Darcs.hs +292/−0
- src/HTML.hs +314/−0
- src/LockRestart.hs +107/−0
- src/Main.hs +196/−0
- src/MultiMap.hs +58/−0
- src/OldDate.lhs +347/−0
- src/StringCrypto.hs +65/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) 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+this service 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 make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. 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.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+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+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the 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 a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE 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.++ 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+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 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, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision 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, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This 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.
+ README view
@@ -0,0 +1,43 @@+darcswatch++© 2008 Joachim Breitner <mail@joachim-breitner.de>++This program tracks darcs patches and repositories, giving+an overview over their state (applied or not applied).++The patches are expected to come in via the mailfilter.sh+program, which stores the patches in the appropriate place.++The main program then downloads the repository inventories+and compares the mailed patches against the repository. It+summaries their status per submitter and per repository.++The program expects a directory as a parameter and will read+the config file therein for configuration. An example+configuration is included.++darcsweb uses modules from these non-standard packages:+ * xhtml+ * network+ * HTTP+ * Crypto+ * parsec+ * nano-md5+ * zlib++There are a lot of open issues, and help is very+appreciated. A non exclusive list of TODO items is:++ * Nicer output (CSS magic!)+ * (Maybe) Add repositories per GnuPG signed command++When committing patches, please make sure that they work with+the version of GHC in the latest Debian stable release, at+the moment ghc6.6, and compatible libraries.++BTW, the simple darcs repository parsing code might be useful for+other projects as well. I try to keep the patches for the Darcs.hs+related stuff separate from the rest, so you can select them when+"darcs pull"ing. If you also follow this procedure, we can share the+Darcs.hs code between projects, by making sure our patches to these+files can be shared without dragging in the rest of the project.
+ Setup.hs view
@@ -0,0 +1,3 @@+module Main where+import Distribution.Simple+main = defaultMain
+ darcswatch.cabal view
@@ -0,0 +1,74 @@+Name: darcswatch+version: 0.1+Category: Distribution+name: darcswatch+author: Joachim Breitner+maintainer: Joachim Breitner <mail@joachim-breitner.de>+Synopsis: Track application of Darcs patches+Description: DarcsWatch is a tool to track the state of darcs patches+ that have been submitted to some project, usually by+ using the "darcs send" command. It allows both submitters+ and project maintainers to get an overview of patches that+ have been submitted but not yet applied. Some notable features are:+ .+ * Reads both darcs1 and darcs2.0 (hashed) format repositories.+ .+ * Displays patch summaries per user and per repository.+ .+ * Patch diff can be reviewed directly.+ .+ * Download link for each patch, to apply without searching for the email.+ .+ * Knows about inverse and amend-recorded patches and uses them to consider+ patches obsolete.+Homepage: http://darcswatch.nomeata.de/+Cabal-Version: >= 1.6+License: GPL+License-File: LICENSE+extra-source-files: mailfilter.sh+data-files: documentation.html,+ README, + example/config+ example/keyring,+ example/mails/patchInvTest,+ example/mails/patch_1f03d40fbe9d0593a9eb7fbefc3bfa85,+ example/mails/patchsmaJcF,+ example/mails/patchBEbWYh,+ example/mails/patchOKsIKA,+ example/mails/patch_a963212153b4f5e3f1777daa562dd989+Build-Type: Simple++Executable darcswatch+ Executable: darcswatch+ Main-Is: Main.hs+ hs-source-dirs: src+ Other-modules: HTML+ , MultiMap+ , Darcs+ , OldDate+ , StringCrypto+ , CachedGet+ , LockRestart+ Build-Depends: base > 3 && < 4+ , network+ , HTTP >= 4000+ , old-time+ , Crypto+ , parsec+ , containers+ , xhtml+ , unix+ , directory+ , nano-md5+ , zlib+ , filepath+ , bytestring++source-repository head+ type: darcs+ location: http://darcs.nomeata.de/darcswatch/++source-repository this+ type: darcs+ location: http://darcs.nomeata.de/darcswatch/+ tag: v0.1
+ documentation.html view
@@ -0,0 +1,67 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html>+<head>+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>+<title>DarcsWatch documentation</title>+</head>+<body>+<h1>DarcsWatch documentation</h1>++<p>DarcsWatch can be found at <a href="http://darcswatch.nomeata.de/">http://darcswatch.nomeata.de/</a>.</p>++<h2>What is DarcsWatch</h2>++<p>DarcsWatch is a tool to track the state of darcs patches that have been submitted to some project, usually by using the <tt>darcs send</tt> command. It allows both submitters and project maintainers to get an overview of patches that have been submitted but not yet applied. Some notable features are:</p>++<ul>+<li>Reads both darcs1 and darcs2.0 (hashed) format repositories.</li>+<li>Displays patch summaries per user and per repositoy.</li>+<li>Patch diff can be reviewed directly.</li>+<li>Download link for each patch, to apply without searching for the email.</li>+<li>Link to the submitting mail on gmane.org, if Message-ID is known.</li>+<li>Knows about inverse and amend-recorded patches and uses them to consider patches obsolete.</li>+<li>Knows about tagged repositories and reads the old patches as well.</li>+</ul>++<h2>How can i use DarcsWatch?</h2>++<h3>...as a interested user</h3>+<p>You can check the DarcsWatch website for new, unapplied patches to your favorite projects and directly download them to try them out.</p>+<p>The easiest way to apply a patch from DarcsWatch is to copy the URL from the download link and paste it into a terminal, to run this command: <tt>GET http://darcswatch.nomeata.de/...dpatch | darcs apply -i</tt></p>++<h3>...as a patch submitter?</h3>+<p>To have your patch submissions tracked, you have to send them to <tt>darcswatch@nomeata.de</tt>. The easiest way to achieve this is by adding the line <tt>send cc darcswatch@nomeata.de</tt> to <tt>~/.darcs/defaults</tt>.</p>+<p>If the repositories you are submitting to are not yet tracked, you have to drop a note to <a href="mailto:mail@joachim-breitner.de">Joachim Breitner</a> with the repository URL, and it will be added.</p>+++<h3>...as a project maintainer with a mailing list?</h3>+<p>If you receive patches on a mailing list and want to have them tracked by DarcsWatch, just subscribe <tt>darcswatch@nomeata.de</tt> to the list, and drop <a href="mailto:mail@joachim-breitner.de">Joachim Breitner</a> a note with the darcs repository URL.</p>++<h3>...as a project maintainer without a mailing list?</h3>+<p>If you receive patches directly, but want them tracked by DarcsWatch, you should set up an email address somewhere that forwards all mails to both yourself and <tt>darcswatch@nomeata.de</tt>. If you can not do that. get in touch with <a href="mailto:mail@joachim-breitner.de">Joachim Breitner</a>, he might be able to set something up for you.</p>++<h2>Other questions.</h2>++<h3>What happens if the same mail reaches darcsweb multiple times, e.g. directly and via a mailing list?</h3>+<p>Not much. Patch bundles are stored by their MD5 sum, so if the same hash bundle arrives again, it will just override the old one.</p>++<h3>I submitted a patch but it should not be used. Can I mark it as obsolete or rejected?</h3>+<p>Yes, but only for whole patch bundles. There are two ways, the latter just for reference, as the first one is easier: </p>++<p> <strong>Via tagged mails</strong> DarcsWatch remembers the message-ids of the mails that submitted a particular patch bundle, so if it sees a direct reply to such a mail, it looks in the subject for the text <tt>[OBSOLETE]</tt> or <tt>[REJECTED]</tt> and marks a patch as such. If the bundle (or parts of it) are later re-submitted, these flags are removed again.</p>++<p>If you don’t have the original message around to reply to it, you can also attach the patch bundle to the mail with the tag in the subject – just download it from the DarcsWatch site. Also, when patch bundles are added to DarcsWatch manually, there might not be a message-id attached and this will be the only way. The probably fastest way of doing that is using the command line <tt>GET http://darcswatch.nomeata.de/....dpatch | mail -s '[REJECTED]' darcswatch@nomeata.de</tt>.+</p>++<p> <strong>Via inverse patches.</strong> Make sure DarcsWatch has seen the inverse of the patch. You can do so by first running <tt>darcs rollback</tt> and select your patch, and then send it to DarcsWatch using <tt>darcs send --to=darcswatch@nomeata.de</tt>. If the project is using a mailing list that is being tracked by DarcsWatch, you can send this mail to the list, thus notifying your fellow developers that you consider your patch obsolete. Of course you can do this also to patches other than your own.</p>++<p> <strong>Via updated patches.</strong> Additionally, if the same author submits a patch with the same name and description as a previous patch, but with a later date, DarcsWatch assumes that <tt>darcs amend-record</tt> was used and that the earlier patch is obsolete.</p>++<h2>Developing DarcsWatch</h2>++<p>You can find DarcsWatch’s own darcs repository on <a href="http://darcs.nomeata.de/darcswatch">http://darcs.nomeata.de/darcswatch</a>.</p>++<p style="font-size:80%">darcswatch © Joachim Breitner <<a href="mailto:mail@joachim-breitner.de">mail@joachim-breitner.de</a>></p>++</body>+</html>
+ example/config view
@@ -0,0 +1,11 @@+DarcsWatchConfig+ { cRepositories =+ [ "http://happs.org/repos/HAppS-HTTP/"+ , "http://code.haskell.org/xmonad"+ , "http://code.haskell.org/XMonadContrib"+ , "http://code.haskell.org/lambdabot"+ , "http://darcs.nomeata.de/darcswatch/"+ ]+ , cOutput = "/home/jojo/projekte/programming/haskell/darcswatch/example/output"+ , cMails = "/home/jojo/projekte/programming/haskell/darcswatch/example/mails"+ }
+ example/keyring view
binary file changed (absent → 76620 bytes)
+ example/mails/patchBEbWYh view
@@ -0,0 +1,156 @@+-----BEGIN PGP SIGNED MESSAGE-----+Hash: SHA1+++New patches:++[Fix window order in EWMH+Joachim Breitner <mail@joachim-breitner.de>**20080411134411+ For pagers to draw the stacking order correctly, the focused window has to+ be the last in the list. Thus put an appropriate implementation of allWindows+ into the Module.+ This does not work perfectly with floating windows.+] {+hunk ./XMonad/Hooks/EwmhDesktops.hs 62+- - let wins = W.allWindows s+hunk ./XMonad/Hooks/EwmhDesktops.hs 76++ -- all windows, with focused windows last++ let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws+}++Context:++[remove myself as maintainer of CopyWindow.+David Roundy <droundy@darcs.net>**20080409144333+ I'm not sure who's maintaining this, but it's not me.+] +[XMonad.Util.WindowProperties: add WM_WINDOW_ROLE as Role+Roman Cheplyaka <roma@ro-che.info>**20080409174935] +[Generalize copyWindow, minor style change+Spencer Janssen <sjanssen@cse.unl.edu>**20080408210050] +[XMonad.Actions.CopyWindow: added copyToAll and killAllOtherCopies functions+Ivan N. Veselov <veselov@gmail.com>**20080408195111] +[XMonad.Actions.UpdatePointer: doc fix+Lukas Mai <l.mai@web.de>**20080407152741] +[XMonad.Util.Font: minor reformatting+Lukas Mai <l.mai@web.de>**20080406020935] +[DynamicLog: resolve merge conflict+Lukas Mai <l.mai@web.de>**20080406020527] +[Encode the entire DynamicLog output, instead of just window title.+lithis <xmonad@selg.hethrael.org>**20080329031537] +[DynamicLog: add support for UTF-8 locales when compiled with XFT or UFT-8 support+Andrea Rossato <andrea.rossato@unibz.it>**20080313102643] +[XMonad.Util.Font: don't call setlocale; core does it for us+Lukas Mai <l.mai@web.de>**20080406013123] +[XMonad.Util.NamedWindows: fix imports+Lukas Mai <l.mai@web.de>**20080326172745] +[Changed getName to use locale-aware functions+Mats Jansborg <mats@jansb.org>**20070819132104+ Rewrote getName using getTextProperty and wcTextPropertyToTextList.+] +[Added next-window versions of the raise* functions.+Ian Zerny <ian@zerny.dk>**20080405182900] +[XMonad.Layout.Master: initial import+Lukas Mai <l.mai@web.de>**20080404220734] +[update contrib for applySizeHints changes+Lukas Mai <l.mai@web.de>**20080404220558] +[XMonad.Hooks.ManageDocks: haddock fix+Lukas Mai <l.mai@web.de>**20080404220532] +[MultiToggle/Instances: ghc 6.6 can't parse LANGUAGE pragma+Brent Yorgey <byorgey@gmail.com>**20080404200157] +[onstart=lower, solves floating dzen issue+Don Stewart <dons@galois.com>**20080403203425] +[some bang patterns+Don Stewart <dons@galois.com>**20080403172246] +[have 'dzen' use autoStruts to detect the gaps+Don Stewart <dons@galois.com>**20080403003130] +[Actions/Search.hs: add dictionary.com search+Brent Yorgey <byorgey@gmail.com>**20080402150521] +[HintedGrid: guesstimate window flexibility and layout rigid windows first+Lukas Mai <l.mai@web.de>**20080402042846] +[HintedGrid: try both bottom-up/top-down window placement to minimize unused space+Lukas Mai <l.mai@web.de>**20080402012538] +[Grid/HintedGrid: use an ncolumns formula inspired by dwm's "optimal" mode+Lukas Mai <l.mai@web.de>**20080402012126] +[XMonad.Layout.Gaps: new contrib module for manual gap support, in the few cases where ManageDocks is not appropriate (dock apps that don't set STRUTS properly, adjusting for a display that is cut off on one edge, etc.)+Brent Yorgey <byorgey@gmail.com>**20080402003742] +[improve WindowGo.hs Haddock formatting+gwern0@gmail.com**20080401023130] +[forgot a haddock for getEditor in Shell.hs+gwern0@gmail.com**20080401022012] +[WindowGo.hs: +raiseBrowser, raiseEditor+gwern0@gmail.com**20080401021740+ Specialize runOrRaise in the same way as with Actions.Search, for one's browser and one's editors.+] +[RunOrRaise.hs: FF 3 doesn't use the "Firefox-bin" classname+gwern0@gmail.com**20080401015049] +[Search.hs: remove an argument from selectSearch and promptSearch+gwern0@gmail.com**20080401013947+ The new getBrowser function allows us to mv the old selectSearch and promptSearch aside as too-general functions, and replace them with new versions, which employ getBrowser to supply one more argument. This allows us to replace the tedious 'selectSearch google "firefox"; selectSearch yahoo "firefox"...' with shorter 'selectSearch google' and so on. One less argument.+ + Also, update the docs.+] +[Shell.hs: +getBrowser, getEditor, helper function+gwern0@gmail.com**20080401013447+ The helper function asks the shell for the value of a variable, else returns the second argument.+ getBrowser and getEditor obviously specialize it for two particular possibly queries+] +[XMonad.Layout.HintedGrid: initial import+Lukas Mai <l.mai@web.de>**20080401231722] +[Documentation improvement.+Roman Cheplyaka <roma@ro-che.info>**20080401134305] +[Remove broken link to screenshot.+Roman Cheplyaka <roma@ro-che.info>**20080331210854] +[MultiToggle: add new XMonad.Layout.MultiToggle.Instances module for common instances of Transformer, update MultiToggle docs accordingly+Brent Yorgey <byorgey@gmail.com>**20080331201739] +[XMonad.Actions.CycleRecentWS: initial import+Michal Janeczek <janeczek@gmail.com>**20080331111906] +[XMonad.Hooks.ManageDocks: export checkDoc+Lukas Mai <l.mai@web.de>**20080331012911] +[XMonad.Layout.Grid: fix indentation+Lukas Mai <l.mai@web.de>**20080330004859] +[move Direction type from WindowNavigation to ManageDocks (ManageDocks will move into the core, taking Direction with it)+Brent Yorgey <byorgey@gmail.com>**20080331010127] +[ManageDocks: clean up + add more documentation+Brent Yorgey <byorgey@gmail.com>**20080331002929] +[Util.Run, Hooks.DynamicLog: re-export hPutStrLn and hPutStr from Util.Run for convenience, and update DynamicLog documentation to show proper imports+Brent Yorgey <byorgey@gmail.com>**20080328205446] +[ManageDocks: add avoidStrutsOn, for covering some docks and not others by default.+Brent Yorgey <byorgey@gmail.com>**20080327203940] +[ManageDocks: add ability to toggle individual gaps independently+Brent Yorgey <byorgey@gmail.com>**20080327111722] +[PerWorkspace: add modWorkspace(s) combinators, for selectively applying layout modifiers to certain workspaces but not others+Brent Yorgey <byorgey@gmail.com>**20080326214351] +[Haddock fix+Roman Cheplyaka <roma@ro-che.info>**20080330134435] +[Remove stale status gaps code+Spencer Janssen <sjanssen@cse.unl.edu>**20080329230737] +[Document _NET_ACTIVE_WINDOW behaviour more exactly+Joachim Breitner <mail@joachim-breitner.de>**20080404072944] +[_NET_ACTIVE_WINDOW moves windows if necessary+Joachim Breitner <mail@joachim-breitner.de>*-20080402143811+ This makes EWMH behave a bit more like metacity: If _NET_ACTIVE_WINDOW is+ received and the window is not on the current worspace, it is brought here + (instead of the workspace switched to the other one). So for example, if you+ click on the pidgin icon in the panel and the buddy list is already open some+ where it is moved here.+] +[_NET_ACTIVE_WINDOW moves windows if necessary+Joachim Breitner <mail@joachim-breitner.de>**20080402143811+ This makes EWMH behave a bit more like metacity: If _NET_ACTIVE_WINDOW is+ received and the window is not on the current worspace, it is brought here + (instead of the workspace switched to the other one). So for example, if you+ click on the pidgin icon in the panel and the buddy list is already open some+ where it is moved here.+] +[TAG 0.7+Spencer Janssen <sjanssen@cse.unl.edu>**20080329202416] +Patch bundle hash:+ab26456486b1f248e095142caf4024e933dc010a+-----BEGIN PGP SIGNATURE-----+Version: GnuPG v1.4.6 (GNU/Linux)++iD8DBQFH/2vF9ijrk0dDIGwRAptwAJ9n0lgCRYVBsC99ADebFthaUf8wXwCgwD/++UvLM4JSNTaZgd6MhA+Y7BYk=+=2Nz3+-----END PGP SIGNATURE-----
+ example/mails/patchInvTest view
@@ -0,0 +1,147 @@+-----BEGIN PGP SIGNED MESSAGE-----+Hash: SHA1+++New patches:++[Dummy commit+Joachim Breitner <mail@joachim-breitner.de>**20080416213715] {+hunk ./README 50++Dummy commit+++}++[Dummy commit+Joachim Breitner <mail@joachim-breitner.de>*-20080416213715] {+hunk ./README 50+- -Dummy commit+- -+}++Context:++[MultiMap.fromList+Joachim Breitner <mail@joachim-breitner.de>**20080416213440] +[Multimap lookup with default+Joachim Breitner <mail@joachim-breitner.de>**20080416200945] +[TODO: Documentation+mail@joachim-breitner.de**20080416193846] +[unTODO Cabal and Caching+mail@joachim-breitner.de**20080416193826] +[add License-File header+Joachim Breitner <mail@joachim-breitner.de>**20080416193135] +[basic cabal support - please check that you like the contents+marco-oweber@gmx.de**20080416191953] +[strict reading of tagFile+Joachim Breitner <mail@joachim-breitner.de>**20080416191500] +[Force an update from the mail script+Joachim Breitner <mail@joachim-breitner.de>**20080416150644] +[Only regenerate pages if there is something new.+Joachim Breitner <mail@joachim-breitner.de>**20080416150525] +[pass up-to-dateness to caller in getInventory+Joachim Breitner <mail@joachim-breitner.de>**20080416144419] +[Add UserAgent Header to requests+Joachim Breitner <mail@joachim-breitner.de>**20080416143833] +[Pass cache directory to getInventory+Joachim Breitner <mail@joachim-breitner.de>**20080416143402] +[Use CachedGet in Darcs.hs+Joachim Breitner <mail@joachim-breitner.de>**20080416142626] +[CachedGet module for Cached HTTP+Joachim Breitner <mail@joachim-breitner.de>**20080416142301] +[Enable receiving mails from the darcs list+Joachim Breitner <mail@joachim-breitner.de>**20080416135921] +[Use MultiMap+Joachim Breitner <mail@joachim-breitner.de>**20080416135024] +[Some helpers for Map k [v] or Map k (Set v)+Joachim Breitner <mail@joachim-breitner.de>**20080416135006] +[Describe Darcs.hs separation+Joachim Breitner <mail@joachim-breitner.de>**20080415225608] +[Put the rest under the GPL+Joachim Breitner <mail@joachim-breitner.de>**20080415225151] +[Put Darcs.hs and StringCrypto.hs under the GPL+Joachim Breitner <mail@joachim-breitner.de>**20080415225137] +[Add GPL licence+Joachim Breitner <mail@joachim-breitner.de>**20080415225118] +[unTODO diff view+Joachim Breitner <mail@joachim-breitner.de>**20080415222355] +[Add toggle button for diffs+Joachim Breitner <mail@joachim-breitner.de>**20080415222114] +[Liberal inventory parsing, also works with hashed+Joachim Breitner <mail@joachim-breitner.de>**20080415215043] +[Add darcs.net to example file+Joachim Breitner <mail@joachim-breitner.de>**20080415213149] +[Use getInventory from Darcs.hs+Joachim Breitner <mail@joachim-breitner.de>**20080415213128] +[Move getInventory to darcs.hs, stub for hashed+Joachim Breitner <mail@joachim-breitner.de>**20080415212944] +[Use pure parseInventory+Joachim Breitner <mail@joachim-breitner.de>**20080415212126] +[Make parseInventory pure+Joachim Breitner <mail@joachim-breitner.de>**20080415212101] +[Make Darcs.hs accept darcs2.0 submissions without '{'+Joachim Breitner <mail@joachim-breitner.de>**20080415211235] +[Improve bash code quality slightly+Joachim Breitner <mail@joachim-breitner.de>**20080415210005] +[Use the md5sum for the patch file to avoid duplicates+Joachim Breitner <mail@joachim-breitner.de>**20080415202850] +[unTODO download link+Joachim Breitner <mail@joachim-breitner.de>**20080415201447] +[Document dependencies+Joachim Breitner <mail@joachim-breitner.de>**20080415201439] +[Factor out common page footer+Joachim Breitner <mail@joachim-breitner.de>**20080415200819] +[Refactor patchlists, add crosslinks and links to dpatch files+Joachim Breitner <mail@joachim-breitner.de>**20080415200401] +[Create symlinks to the dpatch files+Joachim Breitner <mail@joachim-breitner.de>**20080415194550] +[patchBasename function for Darcs.hs+Joachim Breitner <mail@joachim-breitner.de>**20080415193016] +[HTML.hs uses StringCrypto+Joachim Breitner <mail@joachim-breitner.de>**20080415192014] +[OldDate module stolen from darcs+Joachim Breitner <mail@joachim-breitner.de>**20080415191533] +[Use the crypto library, create wrapper module for md5,sha1+Joachim Breitner <mail@joachim-breitner.de>**20080415191246] +[typo+Joachim Breitner <mail@joachim-breitner.de>**20080415100920] +[Add footer with current date+Joachim Breitner <mail@joachim-breitner.de>**20080415100517] +[Factor out repo/user statistics+Joachim Breitner <mail@joachim-breitner.de>**20080415095612] +[Add lambdabot to example (large repository)+Joachim Breitner <mail@joachim-breitner.de>**20080414225332] +[Newest patches first+Joachim Breitner <mail@joachim-breitner.de>**20080414225311] +[Also work on untagged repositories (lambdabot)+Joachim Breitner <mail@joachim-breitner.de>**20080414225251] +[List unmatched patches separately+Joachim Breitner <mail@joachim-breitner.de>**20080414224435] +[Split patches in the per-user view+Joachim Breitner <mail@joachim-breitner.de>**20080414214504] +[Added README+Joachim Breitner <mail@joachim-breitner.de>**20080414213958] +[Adding the rest of the files for the very alpha release+Joachim Breitner <mail@joachim-breitner.de>**20080414213500] +[Actually add Igloos MD5.lhs file+Joachim Breitner <mail@joachim-breitner.de>**20080414212717] +[Mailfilter helper script+Joachim Breitner <mail@joachim-breitner.de>**20080414212622] +[More examples+Joachim Breitner <mail@joachim-breitner.de>**20080414212513] +[Darcs glue code: Parsing mails and inventories+Joachim Breitner <mail@joachim-breitner.de>**20080414201515] +[Igloos MD5 script, with glue+Joachim Breitner <mail@joachim-breitner.de>**20080414191343+ Changes made so that it runs without cpp.+] +[Example files+Joachim Breitner <mail@joachim-breitner.de>**20080414105511] +Patch bundle hash:+36530b7ca0867608c190be96207c3589c20a73c0+-----BEGIN PGP SIGNATURE-----+Version: GnuPG v1.4.6 (GNU/Linux)++iD8DBQFIBnG59ijrk0dDIGwRAl0mAJ9B71aQ/8YqM1DPiOPgij5y2WZ0ugCdGDsq+Zd1DG512xTXedFmTwKYrQFw=+=VF6v+-----END PGP SIGNATURE-----
+ example/mails/patchOKsIKA view
@@ -0,0 +1,79 @@+-----BEGIN PGP SIGNED MESSAGE-----+Hash: SHA1+++New patches:++[Add rqUri field to Record+Joachim Breitner <mail@joachim-breitner.de>**20080403110245+ This makes sure the exact Uri is not lost (otherwise a trailing slash would be+ lost to the rest of the HAppS code). This makes it possible to write a handler+ like this:+ + addSlash :: Monad m => ServerPartT m Response+ addSlash = ServerPartT $ \rq -> do+ case last (rqUri rq) of+ '/' -> noHandle+ _ -> seeOther (rqUri rq ++ "/" ++ rqQuery rq) $+ toResponse "Missing trainling slash"+ + which ensures that all paths end with a trailing slash, or of course a similar+ removeSlash handler, to make relative paths in HTML links behave nicely.+ More on this issue at http://groups.google.com/group/HAppS/browse_frm/thread/4065c842b1cfe7c7+] {+hunk ./src/HAppS/Server/HTTP/Handler.hs 69+- - rqTmp = Request m (pathEls (path u)) (query u) ++ rqTmp = Request m (pathEls (path u)) (path u) (query u) +hunk ./src/HAppS/Server/HTTP/Types.hs 94++ rqUri :: String,+}++Context:++[Fix typo in runTests.sh+lemmih <lemmih@vo.com>**20080314160613] +[Fix haddock annotation and bump version.+Lemmih <lemmih@vo.com>**20080229152550] +[Cabal wibble.+Lemmih <lemmih@vo.com>**20080222232935] +[Cabal wibble.+Lemmih <lemmih@vo.com>**20080222232730] +[TAG 0.9.2+Lemmih <lemmih@vo.com>**20080222225514] +[Bump version to 0.9.2+Lemmih <lemmih@vo.com>**20080222225151] +[Update snippet in package-info.xml+Lemmih <lemmih@vo.com>**20080222223603] +[Don't rely on Xml for serialization.+Lemmih <lemmih@vo.com>**20080222223302] +[Match changes in HAppS-State.+Lemmih <lemmih@vo.com>**20080218201437] +[fix conflicts+alex@happs.org**20080216004432] +[Match development in HAppS-State.+Lemmih <lemmih@vo.com>**20080215010026] +[Match changes in HAppS-State.+Lemmih <lemmih@vo.com>**20080215004016] +[Comment for AllIn.hs+Lemmih <lemmih@vo.com>**20080214234424] +[Don't use Xml for serialization.+Lemmih <lemmih@vo.com>**20080214233742] +[Don't export Cron from SimpleHTTP.+Lemmih <lemmih@vo.com>**20080212154505] +[Remove ServerPart.hs+Lemmih <lemmih@vo.com>**20080212154312] +[Update examples to match development in HAppS-State.+Lemmih <lemmih@vo.com>**20080212142058] +[Show usage of componentInit in AllIn.hs+Lemmih <lemmih@vo.com>**20080212011338] +[TAG 0.9.1.5+Lemmih <lemmih@vo.com>**20080209112439] +Patch bundle hash:+2cfe23050f9e12a183d2bdf2a397e838784bfe47+-----BEGIN PGP SIGNATURE-----+Version: GnuPG v1.4.6 (GNU/Linux)++iD8DBQFH9Ll99ijrk0dDIGwRAocCAKC+7c5MEvlsUVPGNe5y3S8qitrHcgCcCzZ9+Fw7xAlKqKaaml0NAiSkTO7E=+=vZHQ+-----END PGP SIGNATURE-----
+ example/mails/patch_1f03d40fbe9d0593a9eb7fbefc3bfa85 view
@@ -0,0 +1,332 @@+New patches:++[Little style change (avoid a bind+return).+Nicolas Pouillard <nicolas.pouillard@gmail.com>**20080413142318] hunk ./src/Darcs/Commands/MarkConflicts.lhs 76+ markconflicts_cmd opts [] = withRepoLock opts $- \repository -> do+ pend <- get_unrecorded_unsorted repository+ Sealed r <- read_repo repository+- Sealed res <- return $ patchset_conflict_resolutions r++ let (Sealed res) = patchset_conflict_resolutions r+ case res of NilFL -> do putStrLn "No conflicts to mark."+ exitWith ExitSuccess+ _ -> return ()+[Extend a little color printing, and prettify hunks with mangenta and cyan.+nicolas.pouillard@gmail.com**20080414214559] hunk ./src/Darcs/ColourPrinter.lhs 9+ import System.IO ( stderr )+ import Darcs.External (getTermNColors)+ import Printer (Printer, Printers, Printers'(..), Printable(..), Color(..),+- invisiblePrinter, (<>), Doc(..), unDoc, unsafeBoth, simplePrinter, hcat,+- unsafeText, unsafeChar, space, unsafePackedString,+- renderStringWith )++ invisiblePrinter, (<>), Doc(Doc,unDoc), unsafeBoth, unsafeBothStr,++ simplePrinter, hcat, unsafeText, unsafeChar, space,++ unsafePackedString, renderStringWith )+ import Data.Char ( isAscii, isPrint, isSpace, isControl, ord, chr, intToDigit )+ import Data.Bits ( bit, xor )+ import System ( getEnv )+hunk ./src/Darcs/ColourPrinter.lhs 99+ -- printers+ + fancyPrinters :: Printers+-fancyPrinters h = Printers { colorP = colorPrinter (getPolicy h),++fancyPrinters h = Printers { colorP = color (getPolicy h),+ invisibleP = invisiblePrinter,+ hiddenP = colorPrinter (getPolicy h) Green,+ userchunkP = userchunkPrinter (getPolicy h),+hunk ./src/Darcs/ColourPrinter.lhs 197+ in ['\\', intToDigit q, intToDigit r]+ + +--- make colours and highlightings++-- make colors and highlightings+ + mark_escape :: Policy -> Doc -> Doc+ mark_escape po | poAltColor po = make_invert+hunk ./src/Darcs/ColourPrinter.lhs 209+ | otherwise = make_color+ + make_color :: Color -> Doc -> Doc+-make_color Blue = make_blue+-make_color Red = make_red+-make_color Green = make_green++make_color Blue = make_blue++make_color Red = make_red++make_color Green = make_green++make_color Cyan = make_cyan++make_color Magenta = make_magenta+ + make_asciiart :: Doc -> Doc+hunk ./src/Darcs/ColourPrinter.lhs 216+-make_asciiart x = unsafeBoth "[_" (packString "[_")+- <> x+- <> unsafeBoth "_]" (packString "_]")++make_asciiart x = unsafeBothStr "[_" <> x <> unsafeBothStr "_]"+ +hunk ./src/Darcs/ColourPrinter.lhs 218+-make_bold :: Doc -> Doc+-make_bold x = unsafeBoth "\x1B[01m" (packString "\x1B[01m")+- <> x+- <> reset_colour++set_bold, set_invert, set_blue, set_red, set_green, set_magenta, set_cyan, reset_color :: Doc++set_bold = unsafeBothStr "\x1B[01m"++set_invert = unsafeBothStr "\x1B[07m"++set_blue = unsafeBothStr "\x1B[01;34m" -- bold blue++set_red = unsafeBothStr "\x1B[01;31m" -- bold red++set_green = unsafeBothStr "\x1B[01;32m" -- bold green++set_magenta = unsafeBothStr "\x1B[35m" -- light magenta++set_cyan = unsafeBothStr "\x1B[36m" -- light cyan++reset_color = unsafeBothStr "\x1B[00m"+ +hunk ./src/Darcs/ColourPrinter.lhs 228+-make_invert :: Doc -> Doc+-make_invert x = unsafeBoth "\x1B[07m" (packString "\x1B[07m")+- <> x+- <> reset_colour++set_color :: Doc -> Doc -> Doc++set_color set_some_color = \x -> set_some_color <> x <> reset_color+ +hunk ./src/Darcs/ColourPrinter.lhs 231+-make_blue :: Doc -> Doc+-make_blue x = unsafeBoth "\x1B[01;34m" (packString "\x1B[01;34m")+- <> x+- <> reset_colour+-+-make_red :: Doc -> Doc+-make_red x = unsafeBoth "\x1B[01;31m" (packString "\x1B[01;31m")+- <> x+- <> reset_colour+-+-make_green :: Doc -> Doc+-make_green x = unsafeBoth "\x1B[01;32m" (packString "\x1B[01;32m")+- <> x+- <> reset_colour+-+-reset_colour :: Doc+-reset_colour = unsafeBoth "\x1B[00m" (packString "\x1B[00m")++make_bold, make_invert, make_blue, make_red, make_green, make_magenta, make_cyan :: Doc -> Doc++make_bold = set_color set_bold++make_invert = set_color set_invert++make_blue = set_color set_blue++make_red = set_color set_red++make_green = set_color set_green++make_cyan = set_color set_cyan++make_magenta = set_color set_magenta+ + \end{code}+hunk ./src/Darcs/Patch/Prim.lhs 66+ import Darcs.Utils ( nubsort )+ import Lcs ( getChanges )+ import RegChars ( regChars )+-import Printer ( Doc, vcat, packedString,++import Printer ( Doc, vcat, packedString, Color(Cyan,Magenta), colorDoc,+ text, userchunk, invisibleText, invisiblePS, blueText,+ ($$), (<+>), (<>), prefix, userchunkPS,+ )+hunk ./src/Darcs/Patch/Prim.lhs 400+ showHunk :: FileNameFormat -> FileName -> Int -> [PackedString] -> [PackedString] -> Doc+ showHunk x f line old new =+ blueText "hunk" <+> formatFileName x f <+> text (show line)+- $$ prefix "-" (vcat $ map userchunkPS old)+- $$ prefix "+" (vcat $ map userchunkPS new)++ $$ colorDoc Magenta (prefix "-" (vcat $ map userchunkPS old))++ $$ colorDoc Cyan (prefix "+" (vcat $ map userchunkPS new))+ \end{code}+ + \paragraph{Token replace}+hunk ./src/Darcs/Patch/Viewing.lhs 32+ import FastPackedString ( nullPS, linesPS )+ import FileName ( FileName, fp2fn, fn2fp )+ import Printer ( Doc, empty, vcat,+- text, blueText,++ text, blueText, Color(Cyan,Magenta), colorDoc,+ minus, plus, ($$), (<+>), (<>),+ prefix, renderString,+ userchunkPS,+hunk ./src/Darcs/Patch/Viewing.lhs 130+ post = take numpost $ drop (max 0 $ l+length o-1) cleanedls+ in blueText "hunk" <+> formatFileName OldFormat f <+> text (show l)+ $$ prefix " " (vcat $ map userchunkPS pre)+- $$ prefix "-" (vcat $ map userchunkPS o)+- $$ prefix "+" (vcat $ map userchunkPS n)++ $$ colorDoc Magenta (prefix "-" $ vcat $ map userchunkPS o)++ $$ colorDoc Cyan (prefix "+" $ vcat $ map userchunkPS n)+ $$ prefix " " (vcat $ map userchunkPS post)+ coolContextHunk _ _ _ _ = impossible+ \end{code}+hunk ./src/Printer.lhs 41+ + This code was made generic in the element type by Juliusz Chroboczek.+ \begin{code}+-module Printer (Printable(..), Doc(..), unDoc, Printers, Printers'(..), Printer, Color(..),++module Printer (Printable(..), Doc(Doc,unDoc), Printers, Printers'(..), Printer, Color(..),+ hPutDoc, hPutDocLn, putDoc, putDocLn,+ hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith,+ renderString, renderStringWith, renderPS, renderPSWith,+hunk ./src/Printer.lhs 47+ renderPSs, renderPSsWith,+ prefix, colorText, invisibleText, hiddenText, hiddenPrefix, userchunk, text,+- printable, wrap_text,+- blueText, redText, greenText,+- unsafeText, unsafeBoth, unsafeChar,++ printable, wrap_text, colorDoc,++ blueText, redText, greenText, magentaText, cyanText,++ unsafeText, unsafeBoth, unsafeBothStr, unsafeChar,+ invisiblePS, packedString, unsafePackedString, userchunkPS,+ simplePrinters, invisiblePrinter, simplePrinter,+ doc, empty, (<>), (<+>), ($$), vcat, vsep, hcat,+hunk ./src/Printer.lhs 112+ hPrintPrintable h (PS ps) = hPutPS h ps+ hPrintPrintable h (Both _ ps) = hPutPS h ps+ +-newtype Doc = Doc (Reader St Document)+-unDoc :: Doc -> Reader St Document+-unDoc (Doc d) = d++newtype Doc = Doc { unDoc :: Reader St Document }+ + data St = St { printers :: !Printers', current_prefix :: !DocumentInternals }+ type Printers = Handle -> Printers'+hunk ./src/Printer.lhs 116+-data Printers' = Printers {colorP :: !(Color -> Printer),++data Printers' = Printers {colorP :: !(Color -> Doc -> Doc),+ invisibleP :: !Printer,+ hiddenP :: !Printer,+ userchunkP :: !Printer,+hunk ./src/Printer.lhs 124+ }+ type Printer = Printable -> Reader St Document+ +-data Color = Blue | Red | Green++data Color = Blue | Red | Green | Cyan | Magenta+ + type DocumentInternals = [Printable] -> [Printable]+ data Document = Document DocumentInternals+hunk ./src/Printer.lhs 184+ unsafeBoth :: String -> PackedString -> Doc+ unsafeBoth s ps = Doc $ simplePrinter (Both s ps)+ ++unsafeBothStr :: String -> Doc++unsafeBothStr s = Doc $ simplePrinter (Both s (packString s))+++ packedString, unsafePackedString, invisiblePS, userchunkPS :: PackedString -> Doc+ packedString = printable . PS+ unsafePackedString = Doc . simplePrinter . PS+hunk ./src/Printer.lhs 196+ unsafeChar :: Char -> Doc+ unsafeChar = unsafeText . return+ +-text, unsafeText, invisibleText, hiddenText, userchunk, blueText, redText, greenText :: String -> Doc++text, unsafeText, invisibleText, hiddenText, userchunk, blueText, redText, greenText, magentaText, cyanText :: String -> Doc+ text = printable . S+ unsafeText = Doc . simplePrinter . S+ invisibleText = invisiblePrintable . S+hunk ./src/Printer.lhs 205+ blueText = colorText Blue+ redText = colorText Red+ greenText = colorText Green++magentaText = colorText Magenta++cyanText = colorText Cyan+ + colorText :: Color -> String -> Doc+hunk ./src/Printer.lhs 209+-colorText c = mkColorPrintable c . S++colorText c = colorDoc c . printable . S++++colorDoc :: Color -> Doc -> Doc++colorDoc c d = Doc $ do st <- ask++ unDoc $ colorP (printers st) c d+ + wrap_text :: Int -> String -> Doc+ wrap_text n s =+hunk ./src/Printer.lhs 226+ printable, invisiblePrintable, hiddenPrintable, userchunkPrintable :: Printable -> Doc+ printable x = Doc $ do st <- ask+ defP (printers st) x+-mkColorPrintable :: Color -> Printable -> Doc+-mkColorPrintable c x = Doc $ do st <- ask+- colorP (printers st) c x+ invisiblePrintable x = Doc $ do st <- ask+ invisibleP (printers st) x+ hiddenPrintable x = Doc $ do st <- ask+hunk ./src/Printer.lhs 237+ simplePrinters _ = simplePrinters'+ + simplePrinters' :: Printers'+-simplePrinters' = Printers { colorP = \_ -> simplePrinter,++simplePrinters' = Printers { colorP = const id,+ invisibleP = simplePrinter,+ hiddenP = invisiblePrinter,+ userchunkP = simplePrinter,++Context:++[roll back implementation of joke oops command.+David Roundy <droundy@darcs.net>**20080414133342+ Apparently it didn't actually work...+ + rolling back:+ + Tue Apr 8 07:58:56 PDT 2008 David Roundy <droundy@darcs.net>+ * resolve issue786: implement oops command.+ + M ./src/Darcs/Commands/Tag.lhs -5 +47+ M ./src/Darcs/TheCommands.lhs -1 +2+] +[just remove concatLenPS+David Roundy <droundy@darcs.net>**20080411205303+ It is never used in a performance-critical situation, so I'm voting to just+ trash it. I'd rather have fewer unsafe operations.+] +[FastPackedString.hs: simplify concatLenPS, although this removes its strictness properties+**20080411035327] +[FastPackedString.hs: remove wfindPS+**20080411035046+ With better imports from bytestring, I believe it to be superfluous, and dangerous to leave around.+] +[FastPackedString.hs: grmmr/sp+**20080411034730] +[FastPackedString.hs: rw linesPS using ByteString split+**20080411032229] +[doc updates+gwern0@gmail.com**20080409170824+ Convert all uses of 'http://darcs.net/repos/stable' to just darcs.net, since unstable and stable were merged together, and the old URL is a 404 for darcs getting. This is a real problem, see for example <http://reddit.com/info/6ewbq/comments/c03o6d5>.+] +[fix typo in show_bug_help+Matyas Janos <mjanos5@gmail.com>**20080408232600] +[Raise a configure error when no Text.Regex module can be found.+nicolas.pouillard@gmail.com**20080409085522] +[update README url links+gwern0@gmail.com**20080407201333] +[add a bit more debugging info to repository identification.+David Roundy <droundy@darcs.net>**20080408151912] +[resolve issue385: don't worry if we can't get local changes.+David Roundy <droundy@darcs.net>**20080408151823] +[add test for issue385.+David Roundy <droundy@darcs.net>**20080408151808] +[resolve issue786: implement oops command.+David Roundy <droundy@darcs.net>**20080408145856] +[fix URL in network test.+David Roundy <droundy@darcs.net>**20080408145407] +[fix manual bug.+David Roundy <droundy@darcs.net>**20080407191736] +[add new show bug command (hidden) to see what darcs will report if we encounter a bug.+David Roundy <droundy@darcs.net>**20080407175410] +[automatically work out the version of the stable release.+David Roundy <droundy@darcs.net>**20080407171850] +[set prefs again (they got lost on convert).+David Roundy <droundy@darcs.net>**20080407171559] +[update darcs repository URL.+David Roundy <droundy@darcs.net>**20080407164601] +[fix up website for new release.+David Roundy <droundy@darcs.net>**20080407164010] +[simplify determine_release_state.pl.+David Roundy <droundy@darcs.net>**20080407153000] +[make determine_release_state.pl use changes --count.+David Roundy <droundy@darcs.net>**20080407152347] +[add --count output option to changes.+David Roundy <droundy@darcs.net>**20080407151825] +[TAG 2.0.0+David Roundy <droundy@darcs.net>**20080407150638] +Patch bundle hash:+45247877729e0cfc5f1be0417f1d8c7deb8e740f++--=_
+ example/mails/patch_a963212153b4f5e3f1777daa562dd989 view
@@ -0,0 +1,35 @@+-----BEGIN PGP SIGNED MESSAGE-----+Hash: SHA1+++New patches:++[_NET_ACTIVE_WINDOW moves windows if necessary+Joachim Breitner <mail@joachim-breitner.de>**20080402143811+ This makes EWMH behave a bit more like metacity: If _NET_ACTIVE_WINDOW is+ received and the window is not on the current worspace, it is brought here + (instead of the workspace switched to the other one). So for example, if you+ click on the pidgin icon in the panel and the buddy list is already open some+ where it is moved here.+] {+hunk ./XMonad/Hooks/EwmhDesktops.hs 103+- --- * _NET_ACTIVE_WINDOW (activate another window)++-- * _NET_ACTIVE_WINDOW (activate another window, possibly moving to the current desktop)+hunk ./XMonad/Hooks/EwmhDesktops.hs 136+- - windows $ W.focusWindow w++ windows $ W.focusWindow w . W.shiftWin (W.tag (W.workspace (W.current s))) w+}++Context:++[TAG 0.7+Spencer Janssen <sjanssen@cse.unl.edu>**20080329202416] +Patch bundle hash:+f36c5831faf5b9da4034c203bd52fd22d1ba67bb+-----BEGIN PGP SIGNATURE-----+Version: GnuPG v1.4.6 (GNU/Linux)++iD8DBQFH85t89ijrk0dDIGwRAvt7AJ0UMm4M/tISQqG6zXn1kLqt28becACggtU6+fjpKiTWI0EyGvJJYmY1bmZQ=+=Orgm+-----END PGP SIGNATURE-----
+ example/mails/patchsmaJcF view
@@ -0,0 +1,130 @@+-----BEGIN PGP SIGNED MESSAGE-----+Hash: SHA1+++New patches:++[instance MonadError e m => MonadError e (WebT m)+Joachim Breitner <mail@joachim-breitner.de>**20080411224837+ This makes it easier to use throwError inside a ErrorT inside WebT,+ maybe together with errorHandlerSP+] {+hunk ./src/HAppS/Server/SimpleHTTP.hs 106++import Control.Monad.Error+hunk ./src/HAppS/Server/SimpleHTTP.hs 169++instance MonadError e m => MonadError e (WebT m) where++ throwError err = WebT $ throwError err++ catchError action handler = WebT $ catchError (unWebT action) (unWebT . handler)+++}++[errorHandling functions+Joachim Breitner <mail@joachim-breitner.de>**20080411230330+ Adds errorHanderSP and simpleErrorHander, which allows the use of the+ ErrorT transformer in WebT.+] {+hunk ./src/HAppS/Server/SimpleHTTP.hs 90++ -- * Error Handlng++ , errorHandlerSP++ , simpleErrorHandler+hunk ./src/HAppS/Server/SimpleHTTP.hs 606++--------------------------------------------------------------++-- Error Handling++--------------------------------------------------------------++++-- | This ServerPart modifier enables the use of throwError and catchError inside the++-- WebT actions, by adding the ErrorT monad transformer to the stack.++--++-- You can wrap the complete second argument to 'simpleHTTP' in this function.++--++-- See 'simpleErrorHandler' for an example error handler.++errorHandlerSP :: (Monad m, Error e) => (Request -> e -> WebT m a) -> [ServerPartT (ErrorT e m) a] -> [ServerPartT m a] ++errorHandlerSP handler sps = [ ServerPartT $ \req -> WebT $ do++ eer <- runErrorT $ unWebT $ unServerPartT (multi sps) req++ case eer of++ Left err -> unWebT (handler req err)++ Right res -> return res++ ]++++-- | An example error Handler to be used with 'errorHandlerSP', which returns the++-- error message as a plain text message to the browser.++--++-- Another possibility is to store the error message, e.g. as a FlashMsg, and++-- then redirect the user somewhere.++simpleErrorHandler :: (Monad m) => Request -> String -> WebT m Response++simpleErrorHandler _ err = ok $ toResponse $ ("An error occured: " ++ err)+++}++Context:++[Add rqUri field to Record+Joachim Breitner <mail@joachim-breitner.de>**20080403110245+ This makes sure the exact Uri is not lost (otherwise a trailing slash would be+ lost to the rest of the HAppS code). This makes it possible to write a handler+ like this:+ + addSlash :: Monad m => ServerPartT m Response+ addSlash = ServerPartT $ \rq -> do+ case last (rqUri rq) of+ '/' -> noHandle+ _ -> seeOther (rqUri rq ++ "/" ++ rqQuery rq) $+ toResponse "Missing trainling slash"+ + which ensures that all paths end with a trailing slash, or of course a similar+ removeSlash handler, to make relative paths in HTML links behave nicely.+ More on this issue at http://groups.google.com/group/HAppS/browse_frm/thread/4065c842b1cfe7c7+] +[Distributed chat example.+lemmih <lemmih@vo.com>**20080318144925] +[Add a signature to 'debugFilter'. Haddock doesn't show it otherwise.+lemmih <lemmih@vo.com>**20080314162252] +[Multimaster example.+lemmih <lemmih@vo.com>**20080314162014] +[Fix typo in runTests.sh+lemmih <lemmih@vo.com>**20080314160613] +[Fix haddock annotation and bump version.+Lemmih <lemmih@vo.com>**20080229152550] +[Cabal wibble.+Lemmih <lemmih@vo.com>**20080222232935] +[Cabal wibble.+Lemmih <lemmih@vo.com>**20080222232730] +[TAG 0.9.2+Lemmih <lemmih@vo.com>**20080222225514] +[Bump version to 0.9.2+Lemmih <lemmih@vo.com>**20080222225151] +[Update snippet in package-info.xml+Lemmih <lemmih@vo.com>**20080222223603] +[Don't rely on Xml for serialization.+Lemmih <lemmih@vo.com>**20080222223302] +[Match changes in HAppS-State.+Lemmih <lemmih@vo.com>**20080218201437] +[fix conflicts+alex@happs.org**20080216004432] +[Match development in HAppS-State.+Lemmih <lemmih@vo.com>**20080215010026] +[Match changes in HAppS-State.+Lemmih <lemmih@vo.com>**20080215004016] +[Comment for AllIn.hs+Lemmih <lemmih@vo.com>**20080214234424] +[Don't use Xml for serialization.+Lemmih <lemmih@vo.com>**20080214233742] +[Don't export Cron from SimpleHTTP.+Lemmih <lemmih@vo.com>**20080212154505] +[Remove ServerPart.hs+Lemmih <lemmih@vo.com>**20080212154312] +[Update examples to match development in HAppS-State.+Lemmih <lemmih@vo.com>**20080212142058] +[Show usage of componentInit in AllIn.hs+Lemmih <lemmih@vo.com>**20080212011338] +[TAG 0.9.1.5+Lemmih <lemmih@vo.com>**20080209112439] +Patch bundle hash:+6579a6aeca01a58d2845d04ea5fe1c1d4b26f8f2+-----BEGIN PGP SIGNATURE-----+Version: GnuPG v1.4.6 (GNU/Linux)++iD8DBQFH/+8c9ijrk0dDIGwRAuK7AJ9oCvypMMyHlNmyGq9YKja18EykXQCePZC1+eg+57CyqIz4VNbwrS3BKx9Q=+=qqvc+-----END PGP SIGNATURE-----
+ mailfilter.sh view
@@ -0,0 +1,131 @@+#!/bin/bash++# Example usage in a alias file:+# darcswatch: |/opt/darcswatch/mailfilter.sh /opt/darcswatch/real/mails/ /opt/darcswatch/real/keyring /opt/darcswatch/darcswatch /opt/darcswatch/real/+# +# Note that $HOME has to be set, otherwise gpg will complain.++DIR=$1+KEYRING=$2+DARCSWATCH=$3+CONFIG=$4+++test -n "$DIR" || { echo "Missing directory parameter"; exit 1; }+test -d "$DIR" || { echo "Not a directory: $DIRMissing"; exit 1; }+test -n "$KEYRING" || { echo "Missing keyring parameter"; exit 1; }+test -n "$DARCSWATCH" || { echo "Missing darcswatch parameter"; exit 1; }+test -n "$CONFIG" || { echo "Missing config parameter"; exit 1; }++function grep_dpatch { perl -n -e 'print if (/^New patches:/.../^--=_/)'; }+function grep_gpg {+ perl -n -e 'print if (/^-----BEGIN PGP SIGNED MESSAGE-----/.../^-----END PGP SIGNATURE-----/)';+ }+function md5 { md5sum - |cut -c-32 ; }+function update {+ echo "Updateing darcswatch web view"+ $DARCSWATCH $CONFIG new ;+ }++FILE=$(tempfile --prefix patch)+mimedecode > "$FILE"++echo "Looking for a state"++STATE=none+if formail -z -x "Subject:" < "$FILE" | fgrep -q '[OBSOLETE]'+then+ STATE=obsolete+fi+if formail -z -x "Subject:" < "$FILE" | fgrep -q '[REJECTED]'+then+ STATE=rejected+fi+# More polite style, for xmonad :-)+if fgrep -q -i 'DarcsWatch: rejected' < "$FILE"+then+ STATE=rejected+fi+if fgrep -q -i 'DarcsWatch: obsolete' < "$FILE"+then+ STATE=obsolete+fi+echo "Found state $STATE"++echo "Looking for the sender"+FROM=$(formail -z -x "From:" < "$FILE")+++MSGID="$(formail -z -x "Message-ID:" < "$FILE")"++echo "Looking for a patch"++if fgrep -q 'Content-Type: text/x-darcs-patch;' "$FILE" ||+ fgrep -q 'Content-Type: text/x-patch;' "$FILE" ||+ fgrep -q 'New patches:' "$FILE" +then++ echo "Patch ok, adding to patch directory"++ if fgrep -q -- '-----BEGIN PGP SIGNED MESSAGE-----' "$FILE"+ then++ MD5SUM=$(grep_gpg < "$FILE" | md5)+ grep_gpg < "$FILE" > "$DIR/patch_$MD5SUM"++ else+ MD5SUM=$(grep_dpatch < "$FILE" | md5)+ grep_dpatch < "$FILE" > "$DIR/patch_$MD5SUM"+ fi++ if [ -n "$MSGID" ]+ then+ if test -e "$DIR/mid-mapping" && fgrep -q "$MSGID" "$DIR/mid-mapping"+ then+ echo "Seen this mail before"+ else+ echo "$MSGID $MD5SUM" >> "$DIR/mid-mapping"+ fi+ fi++ if [ "STATE" = "none" ]+ then+ STATE=add+ fi++else+ echo "No patch contained, it seems"+fi++if [ -n "$MSGID" -a "$STATE" != "none" ]+then+ if [ -z "$MD5SUM" ]+ then+ # No referred bundle yet+ REPLY=$(formail -z -x "In-Reply-To:" < "$FILE") + if [ -n "$REPLY" ] && test -e "$DIR/mid-mapping"+ then+ MD5SUM=$(fgrep "$REPLY" "$DIR/mid-mapping" | cut -f2 -d\ )+ fi+ fi++ if [ -n "$MD5SUM" ]+ then+ # Got something to mark+ if test -e "$DIR/states" && fgrep -q "$MSGID" "$DIR/states"+ then+ echo "Seen this mail before"+ else+ echo "Marking patch $MD5SUM as $STATE"+ echo "$MD5SUM $STATE $MSGID $FROM" >> "$DIR/states"+ fi+ fi+fi++if [ -n "$MD5SUM" ]+then+ update+fi++rm "$FILE"+exit 0
+ src/CachedGet.hs view
@@ -0,0 +1,126 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}++module CachedGet+ ( get+ ) where++import StringCrypto+import Network.URI+import Network.HTTP+import Network.HTTP.Headers+import System.Directory+import Control.Monad++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Char8 (ByteString)++-- | Given a directory to be used for caching the result, and+-- an URL to download, it will return the content of the URL.+-- The boolean return value is true when the file was updated,+-- and False if it is the same as in the cache.+get :: FilePath -> String -> IO (Maybe (ByteString, Bool))+get dir' uri = flip catch (\e -> putStrLn ("Error downloading uri: " ++ show e) >> return Nothing) $ do+ putStr $ "Getting URL " ++ uri ++ " ... "+ e_cache <- doesFileExist cacheFile+ e_tag <- doesFileExist tagFile+ let update = do+ newFile <- get' uri+ case newFile of+ Nothing -> do+ putStrLn "not found."+ return Nothing+ Just (newFile, Nothing) -> do+ putStrLn "downloaded."+ return $ Just (newFile, True)+ Just (newFile, Just newTag) -> do+ putStrLn "downloaded."+ B.writeFile cacheFile newFile+ writeFile tagFile newTag+ return $ Just (newFile, True)++ if False -- Debugging+ then do+ oldFile <- B.readFile cacheFile+ return $ Just (oldFile, False)+ else if e_cache && e_tag+ then do+ oldTag <- slurpFile tagFile+ mbNewTag <- head' uri+ maybe'' mbNewTag (return Nothing) $ \newTag -> do+ if oldTag == newTag+ then do+ putStrLn "cached."+ oldFile <- B.readFile cacheFile+ return $ Just (oldFile, False)+ else do+ update+ else do+ update+ + where hash = md5 uri+ cacheFile = dir ++ hash ++ ".cache"+ tagFile = dir ++ hash ++ ".tag"+ dir = addSlash dir'+ maybe'' m d f = maybe d f m+++head' uri' = do+ let Just uri = parseURI uri'+ let req = Request+ { rqURI = uri+ , rqMethod = HEAD+ , rqHeaders =+ [ uaHeader+ ]+ , rqBody = ""+ }+ result <- simpleHTTP req+ return $ case result of+ Left err -> Nothing+ Right response -> case rspCode response of+ (2,_,_) -> lookupHeader HdrLastModified . rspHeaders $ response+ _ -> Nothing++get' uri' = do+ let Just uri = parseURI uri'+ let req = Request+ { rqURI = uri+ , rqMethod = GET+ , rqHeaders =+ [ uaHeader+ ]+ , rqBody = B.empty+ }+ result <- simpleHTTP req+ return $ case result of+ Left err -> Nothing+ Right response -> case rspCode response of+ (2,_,_) -> Just $ (rspBody response, lookupHeader HdrLastModified (rspHeaders response))+ _ -> Nothing++uaHeader = Header HdrUserAgent "DarcsWatch http://darcswatch.nomeata.de/"++slurpFile file = do+ c <- readFile file+ if (c == c) then return c else error "This should not happen"+ ++addSlash filename | last filename == '/' = filename+ | otherwise = filename ++ "/"
+ src/Darcs.hs view
@@ -0,0 +1,292 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}++module Darcs+ ( PatchInfo(..)+ , getInventory+ , parseMail+ , patchBasename+ , inversePatch+ ) where++import OldDate+import StringCrypto++import System.Time+import CachedGet+import Zip++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Char8 (ByteString)+import Data.List++-- | The defining informtion of a Darcs patch.+data PatchInfo = PatchInfo+ { piDate :: ByteString+ , piName :: ByteString+ , piAuthor :: ByteString+ , piLog :: [ByteString]+ , piInverted :: Bool+ } deriving (Eq,Ord,Show)+++-- | Toggles the 'piInverted' flag of a 'PatchInfo'+inversePatch :: PatchInfo -> PatchInfo+inversePatch p@(PatchInfo {piInverted = i}) = p {piInverted = not i}++-- | Given a directory used for caching, and an URL of a Darcs repository,+-- it will return the list of patches in the repository, and whether the+-- repository as changed since the last run.+getInventory :: FilePath -> String -> IO ([PatchInfo], Bool)+getInventory cDir repo = do+ format <- get cDir formatUrl+ case format of+ Nothing -> getInventory1 cDir repo+ Just (f,_) | f == B.pack "hashed\ndarcs-2\n" -> getInventory2 cDir repo+ | f == B.pack "darcs-1.0\n" -> getInventory1 cDir repo+ | otherwise -> error $ "Unkown repository format: " ++ B.unpack f+ where formatUrl = addSlash repo ++ "_darcs/format"++-- | Gets called when old style format was detected+getInventory1 :: FilePath -> String -> IO ([PatchInfo],Bool)+getInventory1 cDir repo = getInventoryFile (addSlash repo ++ "_darcs/inventory")+ where maybe' m f d = maybe d f m+ getInventoryFile url = do+ inv <- get cDir url+ maybe' inv parseBody $ do+ putStrLn $ "Repository " ++ repo ++ " not found."+ return ([],False)+ parseBody (body, updated) = do+ let unzipped = maybeUnzipB body+ let patches = readPatchInfos unzipped+ case breakOn '\n' unzipped of+ (l1,r) | l1 == B.pack "Starting with tag:" -> do+ let p = head patches+ let filename = addSlash repo ++ "_darcs/inventories/" ++ patchBasename p ++ ".gz"+ (prev_p,prev_u) <- getInventoryFile filename+ return (prev_p ++ patches, prev_u || updated)+ _ -> return (patches, updated)++-- | Gets called when new style format was detected+getInventory2 :: FilePath -> String -> IO ([PatchInfo],Bool)+getInventory2 cDir repo = getInventoryFile (addSlash repo ++ "_darcs/hashed_inventory")+ where maybe' m f d = maybe d f m+ getInventoryFile url = do+ inv <- get cDir url+ maybe' inv parseBody $ do+ putStrLn $ "Repository " ++ repo ++ " not found."+ return ([],False)+ skip_pristine s = case breakOn '\n' s of+ (l1,r) | B.pack "pristine" `B.isPrefixOf` l1 -> B.tail r+ _ -> s+ parseStart body = do + case breakOn '\n' (skip_pristine body) of+ (l,r) | l == B.pack "Starting with inventory:" -> do+ case breakOn '\n' $ B.tail r of+ (h,r'') -> do prev <- getInventoryFile (addSlash repo ++ "_darcs/inventories/" ++ B.unpack h)+ return (prev,B.tail r'')+ --_ -> putStrLn "Broken inventory start line" >> return (([],False),body)+ _ -> return (([],False),body)+ parseBody (body, updated) = do+ let unzipped = maybeUnzipB body+ ((prev_patches, prev_updated),body') <- parseStart unzipped+ return (prev_patches ++ readPatchInfos unzipped, prev_updated || updated)+ +++readPatchInfos :: ByteString -> [PatchInfo]+readPatchInfos inv | B.null inv = []+readPatchInfos inv = case breakOn '[' inv of+ (_,r) -> case readPatchInfo r of+ Just (pinfo,r) -> pinfo : readPatchInfos r+ Nothing -> []++readPatchInfo :: ByteString -> Maybe (PatchInfo, ByteString)+readPatchInfo s | B.null (dropWhite s) = Nothing+readPatchInfo s =+ if B.head (dropWhite s) /= '[' -- ]+ then Nothing+ else case breakOn '\n' $ B.tail $ dropWhite s of+ (name,s') | B.null s' -> error $ "Broken file (1) " ++ show (B.unpack s)+ (name,s') | otherwise -> + case breakOn '*' $ B.tail s' of+ (author,s2) | B.null s2 -> error "Broken file (2)"+ | otherwise -> + case B.break (\c->c==']'||c=='\n') $ B.drop 2 s2 of+ (ct,s''') ->+ do (log, s4) <- lines_starting_with_ending_with ' ' ']' $ dn s'''+ let not_star = B.index s2 1 /= '*'+ return $ (PatchInfo { piDate = ct+ , piName = name+ , piAuthor = author+ , piLog = log+ , piInverted = not_star+ }, s4)+ where dn x = if B.null x || B.head x /= '\n' then x else B.tail x++lines_starting_with_ending_with :: Char -> Char -> ByteString -> Maybe ([ByteString],ByteString)+lines_starting_with_ending_with st en s = lswew s+ where+ lswew x | B.null x = Nothing+ lswew x =+ if B.head x == en+ then Just ([], B.tail x)+ else if B.head x /= st+ then Nothing+ else case breakOn '\n' $ B.tail x of+ (l,r) -> case lswew $ B.tail r of+ Just (ls,r') -> Just (l:ls,r')+ Nothing ->+ case breakLast en l of+ Just (l2,_) ->+ Just ([l2], B.drop (B.length l2+2) x)+ Nothing -> Nothing+++dropWhite = B.dropWhile (`elem` " \n\t\r")+breakOn c = B.break (c ==)++breakLast c p = case B.elemIndexEnd c p of+ Nothing -> Nothing+ Just n -> Just (B.take n p, B.drop (n+1) p)+++-- | Given the content of a patch bundle, it returns a list of submitted patches with+-- their diff, and the list of patches in the context.+parseMail :: ByteString -> ([(PatchInfo,ByteString)],[PatchInfo])+parseMail content = do case eesc of + Left err -> ([],[]) -- putStrLn $ "Parse error: "++ err+ Right res -> if res == res then res else res+ where demime = readMail content+ eesc = scan_bundle demime+ ++readMail :: ByteString -> ByteString+readMail s = s+-- We already strip the relevant part in the mail filter+--+-- case betweenLines+-- ("Content-Description: A darcs patch for your repository!")+-- ("--=_--") s of+-- Nothing -> s -- if it wasn't an email in the first place, just pass along.+-- Just s' -> qpdecode s'+--+--qpdecode :: String -> String+--qpdecode s = s -- FIXME+--+--betweenLines :: String -> String -> String -> Maybe (String)+--betweenLines start end s+-- = case break (start ==) (lines s) of+-- (_, _:rest) ->+-- case break (end ==) (reverse rest) of+-- (_,_:rres) -> Just (unlines (reverse rres))+-- _ -> Nothing+-- _ -> Nothing++scan_bundle :: ByteString -> Either String ([(PatchInfo,ByteString)],[PatchInfo])+scan_bundle ps+ | B.null ps = Left "Bad patch bundle!"+ | otherwise =+ case silly_lex ps of+ ("New patches:",rest) ->+ case get_patches rest of+ (submitted, rest') ->+ case silly_lex rest' of+ ("Context:", rest'') ->+ case get_context rest'' of+ (context,maybe_hash) -> -- FIXME verify patch bundle hash+ Right (submitted, context)+ (a,r) -> Left $ "Malformed patch bundle: '"++a++"' is not 'Context:'"+ ++ "\n" ++ B.unpack r+ ("Context:",rest) ->+ case get_context rest of+ (context, rest') ->+ case silly_lex rest' of+ ("New patches:", rest'') ->+ case get_patches rest'' of+ (submitted,_) -> Right (submitted, context)+ (a,_) -> Left $ "Malformed patch bundle: '" ++ a ++ "' is not 'New patches:'"+ ("-----BEGIN PGP SIGNED MESSAGE-----",rest) ->+ scan_bundle $ filter_gpg_dashes rest+ (_,rest) -> scan_bundle rest++get_patches :: ByteString -> ([(PatchInfo,ByteString)], ByteString)+get_patches ps = + case readPatchInfo ps of+ Nothing -> ([], ps)+ Just (pinfo,ps) ->+ case readDiff ps of+ Nothing -> ([], ps)+ Just (diff, r) -> (pinfo, diff) -:- get_patches r+++silly_lex :: ByteString -> (String, ByteString)+silly_lex ps = (B.unpack $ B.takeWhile (/='\n') $ dropWhite ps,+ B.dropWhile (/='\n') $ dropWhite ps)++get_context :: ByteString -> ([PatchInfo],ByteString)+get_context ps =+ case readPatchInfo ps of+ Just (pinfo,r') -> pinfo -:- get_context r'+ Nothing -> ([],ps)++filter_gpg_dashes :: ByteString -> ByteString+filter_gpg_dashes ps =+ B.unlines $ map drop_dashes $+ takeWhile (/= B.pack "-----END PGP SIGNED MESSAGE-----") $+ dropWhile not_context_or_newpatches $ B.lines ps+ where drop_dashes x = if B.length x < 2 then x+ else if B.take 2 x == B.pack "- "+ then B.drop 2 x+ else x+ not_context_or_newpatches s = (s /= B.pack "Context:") &&+ (s /= B.pack "New patches:")++readDiff :: ByteString -> Maybe (ByteString, ByteString)+readDiff s | B.null (dropWhite s) = Nothing+readDiff s = find (\(p,r) -> B.pack "\n\n" `B.isPrefixOf` r || B.pack "\n[" `B.isPrefixOf` r)+ (zip (B.inits s) (B.tails s))++patchFilename :: PatchInfo -> String+patchFilename pi = patchBasename pi ++ ".gz"++-- | Given a patch, it calculates the name of the file that darcs usually+-- stores it in, without the ".gz" suffix.+patchBasename :: PatchInfo -> String+patchBasename pi = showIsoDateTime d++"-"++sha1_a++"-"++sha1 (B.unpack sha1_me)+ where b2ps True = B.pack "t"+ b2ps False = B.pack "f"+ sha1_me = B.concat [piName pi,+ piAuthor pi,+ piDate pi,+ B.concat $ piLog pi,+ b2ps $ piInverted pi]+ d = readPatchDate $ B.unpack $ piDate pi+ sha1_a = take 5 $ sha1 $ B.unpack $ piAuthor pi++readPatchDate :: String -> CalendarTime+readPatchDate = ignoreTz . readUTCDate+ where ignoreTz ct = ct { ctTZ = 0 }+++(-:-) :: a -> ([a],b) -> ([a],b)+a -:- (as,r) = (a:as,r)++addSlash filename | last filename == '/' = filename+ | otherwise = filename ++ "/"
+ src/HTML.hs view
@@ -0,0 +1,314 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}++module HTML + ( ResultData(ResultData)+ , PatchExtras(..)+ , mainPage+ , userPage+ , repoPage+ , unmatchedPage+ , userFile+ , repoFile+ , normalizeAuthor+ , PatchState(..)+ ) where++import Text.XHtml hiding ((!))+import qualified Text.XHtml ((!))+import Text.Printf+import qualified Data.Map as M+import qualified Data.Set as S+import Data.Map ((!))+import qualified MultiMap as MM+import MultiMap ((!!!!))+import Data.List+import Data.Ord+import Data.Char+import System.Time++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Char8 (ByteString)++import Darcs+++-- not in ghc6.6+infixl 0 `on`+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c+(*) `on` f = \x y -> f x * f y++data ResultData = ResultData+ { p2r :: M.Map PatchInfo (S.Set String)+ , r2p :: M.Map String (S.Set PatchInfo)+ , u2p :: M.Map ByteString (S.Set PatchInfo)+ , p2pe:: M.Map PatchInfo PatchExtras+ , p2pr :: M.Map PatchInfo (S.Set String)+ , r2mp :: M.Map String (S.Set PatchInfo)+ , p2s :: M.Map PatchInfo (PatchState)+ , p2mid:: M.Map PatchInfo (String)+ , unmatched :: (S.Set PatchInfo)+ , date :: CalendarTime+ , u2rn :: M.Map ByteString ByteString+ } deriving (Show)++data PatchExtras = PatchExtras+ { peDiff :: ByteString+ , peContext :: [PatchInfo]+ , peMailFile :: String+ } deriving (Show)+++users d = M.keys (u2p d)+repos d = M.keys (r2p d)++mainPage d = showHtml $+ header << thetitle << "DarcsWatch overview" ++++ body << (+ h1 << "DarcsWatch overview" ++++ p << ( "Welcome to DarcsWatch. If you want to know more, please read the " ++++ hotlink "http://darcs.nomeata.de/darcswatch/documentation.html" << "Documentation" ++++ "."+ ) ++++ h2 << "Statistics" ++++ p << stringToHtml (+ printf "Tracking %d repositories and %d patches submitted by %d users"+ (M.size (r2p d)) (M.size (p2pe d)) (M.size (u2p d))+ ) ++++ h2 << "Listing by user" +++ + unordList (map (\u -> hotlink (userFile u) << u2rn d ! u +++ userStats u d) (users d)) ++++ h2 << "Listing by repository" +++ + unordList ( map (\r -> hotlink (repoFile r) << r +++ repoStats r d) (repos d)+ ++ [hotlink "unmatched.html" << "Unmatched patches"+ +++ " "+++ show (S.size (unmatched d)) +++ " patches" ]+ ) ++++ footer d+ )++footer d = + p !!! [thestyle "font-size:80%"] << (+ "darcswatch © Joachim Breitner <" ++++ hotlink "mailto:mail@joachim-breitner.de" << "mail@joachim-breitner.de" ++++ ">. Source code at " ++++ hotlink "http://darcs.nomeata.de/darcswatch/" << "http://darcs.nomeata.de/darcswatch/"++++ ". Last update " ++++ calendarTimeToString (date d) ++++ "."+ )+myHeader d = script !!! [thetype "text/javascript"] << (+ " function toggle_diff(id) { "+++ " elem = document.getElementById(id); "+++ " if (elem) {if (elem.style.display == 'none') {elem.style.display = 'block';} else {elem.style.display = 'none'} }"++ + " }"+ )+++userPage d u = showHtml $+ header << (+ thetitle << ("DarcsWatch overview for " +++ u2rn d ! u) ++++ myHeader d+ ) ++++ body << (+ h1 << ("DarcsWatch overview for " +++ u2rn d ! u) ++++ p << hotlink "." << "Return to main page" ++++ patchList d (sps !!!! NotApplied) "Unapplied patches" True ++++ patchList d (sps !!!! Unmatched) "Unmatched patches" True ++++ patchList d (sps !!!! Rejected) "Rejected patches" True ++++ patchList d (sps !!!! Obsolete) "Obsolete patches" True ++++ patchList d (sps !!!! Applied) "Applied patches" True ++++ footer d+ )+ where (ps, sps) = userData u d++repoPage d r = showHtml $+ header << (+ thetitle << ("DarcsWatch overview for " +++ r) ++++ myHeader d+ ) ++++ body << (+ h1 << ("DarcsWatch overview for " +++ r) ++++ p << hotlink "." << "Return to main page" ++++ patchList d (sps !!!! NotApplied) "Unapplied patches" False ++++ patchList d (sps !!!! Applied) "Applied patches" False ++++ patchList d (sps !!!! Obsolete) "Obsolete patches" False ++++ patchList d (sps !!!! Rejected) "Rejected patches" True ++++ footer d+ )+ where (ps, sps) = repoData r d+ +unmatchedPage d = showHtml $+ header << (+ thetitle << ("DarcsWatch overview, unmatched patches") ++++ myHeader d+ ) ++++ body << (+ h1 << ("DarcsWatch overview, unmatched Patches") ++++ p << hotlink "." << "Return to main page" ++++ patchList d (S.toList (unmatched d)) "Unmatched patches" False ++++ footer d+ )++patchList d [] title userCentric = h5 << ("No "++title)+patchList d ps title userCentric = + h2 << title +++ (unordList $ map (patchView d userCentric) ps)++patchView d userCentric p =+ piDate p +++ ": " +++ strong << (+ (if piInverted p then stringToHtml "UNDO: " else noHtml) ++++ piName p+ ) ++++ (if userCentric+ then noHtml+ else ( " " +++ small << (+ " by " +++ hotlink (userFile (piAuthor p)) << piAuthor p+ )+ )+ ) ++++ pre << B.unlines (piLog p) ++++ (if userCentric+ then (unordList $ flip map (S.toList (p2pr d !!!! p)) $ \r ->+ hotlink (repoFile r) << r +++ ": "+++ viewState d p r+ )+ else noHtml+ ) ++++ thediv !!! [identifier diffId, thestyle "display:none"] << (+ actions ++++ pre << peDiff (p2pe d ! p)+ ) ++++ actions+ where pid = patchBasename p+ diffId = "diff_"++pid+ actions = paragraph << (+ strong << "Actions: " ++++ hotlink (pid ++ ".dpatch") << "Download .dpatch" ++++ " "+++ + anchor !!! [href $ "javascript:toggle_diff('"++diffId++"')"]+ << "Show/Hide diff" ++++ case p `M.lookup` p2mid d of+ Nothing -> noHtml+ Just mid -> " " ++++ anchor !!! [href $ "http://mid.gmane.org/" ++ mid ]+ << "Search submitting mail"+ )+ +-- The order defines what state a patch should be considered if it is+-- in sevaral repositories+data PatchState = Unmatched | Applied | NotApplied | Rejected | Obsolete | Obsoleting deriving (Eq, Ord)++state d p r | p `S.member` ps = Applied+ | ip `S.member` ps = explicit_state+ | amend_obsoleted = Obsolete+ | ip `S.member` subs && not (piInverted p) = Obsolete+ | ip `S.member` subs && piInverted p = Obsoleting+ | otherwise = explicit_state+ where context = peContext (p2pe d ! p)+ ps = r2p d ! r+ ip = inversePatch p+ subs = M.keysSet (p2pe d)+ explicit_state = max NotApplied (M.findWithDefault Unmatched p (p2s d))+ amend_obsoleted = any (`laterThan` p) $ S.toList (u2p d ! (normalizeAuthor (piAuthor p)))++p1 `laterThan` p2 = piAuthor p1 == piAuthor p2+ && piName p1 == piName p2+ && piLog p1 == piLog p2+ && piInverted p1 == piInverted p2+ && piDate p1 > piDate p2++instance Show PatchState where+ show Unmatched = "Unmatched"+ show Applied = "Applied"+ show NotApplied = "Not yet applied"+ show Rejected = "Marked rejected"+ show Obsolete = "Marked obsolete"+ show Obsoleting = "Marking patch as obsolete"++stateColor Applied = "green"+stateColor NotApplied = "red"+stateColor Obsolete = "gray"+stateColor Rejected = "brown"+stateColor Obsoleting = "gray"+stateColor Unmatched = "black"++inColor c = thespan !!! [thestyle ("color:"++c)]++viewState d p r = inColor (stateColor s) << (show s)+ where s = state d p r++(!!!) = (Text.XHtml.!) +++userStats u d = " " ++++ show (length ps) +++ + " tracked patches, "++++ count NotApplied "unapplied" ++++ count Obsolete "obsolete" ++++ count Rejected "rejected"+ where (ps, sps) = userData u d+ count s t = case sps !!!! s of+ [] -> noHtml+ _ -> inColor (stateColor s) << (show (length ps) +++ " " +++ t) +++ " "+ where ps = (sps !!!! s)++repoStats r d = " " ++++ show (S.size (r2p d !!!! r)) +++ + " patches in inventory "++++ count Applied "tracked" ++++ count NotApplied "applicable" ++++ count Obsolete "obsolete" ++++ count Rejected "rejected"+ where (ps, sps) = repoData r d+ count s t = case sps !!!! s of+ [] -> noHtml+ _ -> inColor (stateColor s) << (show (length ps) +++ " " +++ t) +++ " "+ where ps = (sps !!!! s)++repoData r d = (ps, sorted) + where ps = s2List $ r2mp d !!!! r+ sorted = MM.fromList $ map (\p -> (state d p r, p)) ps++userData u d = (ps, sorted)+ where ps = patchSort $ S.toList $ u2p d !!!! u+ sorted = MM.fromList $ map (\p -> (state' p, p)) ps+ state' p | S.null repos = Unmatched+ | otherwise = S.findMax (S.map (state d p) repos)+ where repos = p2pr d !!!! p++userFile u = "user_" ++ B.unpack (normalizeAuthor u) ++ ".html"+repoFile r = "repo_" ++ safeName r ++ ".html"++normalizeAuthor name | not (B.null r') && valid = email+ | otherwise = safeNameB name+ where r' = B.dropWhile (/='<') name+ (email,r'') = B.span (/='>') (B.tail r')+ valid = not (B.null email) && not (B.null r'') && B.all (isSafeFileChar) email++safeNameB n = B.map s n+ where s c = if isSafeFileChar c then c else '_'++safeName n = map s n+ where s c = if isSafeFileChar c then c else '_'++isSafeFileChar c = isAlpha c || isDigit c || c `elem` "-_.@:"+++s2List = patchSort . S.toList+patchSort = sortBy (flip (compare `on` piDate))++instance HTML ByteString where+ toHtml = toHtml . B.unpack
+ src/LockRestart.hs view
@@ -0,0 +1,107 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}+module LockRestart+ ( lockOrMark+ , releaseLock+ , lockRestart+ ) where++import System.FilePath+import System.Directory+import System.IO+import System.IO.Error+import System.Posix.Temp+import Control.Monad+import GHC.IOBase++-- | tries to get the lock. If it fails, notifies the running process+-- to re-start itself afterwards, with the given information+-- returns True if the lock was aquired+lockOrMark :: Show a => FilePath -> a -> IO Bool+lockOrMark dir msg = do + (createDirectory lockDir >> return True) `catch` \err -> do+ if isAlreadyExistsError err then markOrLock dir msg+ else ioError err+ where lockDir = dir </> ".lock"++markOrLock :: Show a => FilePath -> a -> IO Bool+markOrLock dir msg = do + (file, fh) <- openTempFile dir "lock.tmp"+ hPutStr fh (show msg)+ hClose fh+ (renameFile file (replaceDirectory file lockDir) >> return False) `catch` \err -> do+ if isDoesNotExistError err then do removeFile file+ markOrLock dir msg+ else ioError err+ where lockDir = dir </> ".lock"++-- | release the lock. If new events have come in, they are returned+-- in the list, and the lock is still kept. If the list is empty,+-- the lock was successfully released.+releaseLock :: Read a => FilePath -> IO [a]+releaseLock dir = do+ files <- pickFiles `liftM` getDirectoryContents lockDir+ if (null files) then (removeDirectory lockDir >> return []) `catch` \err ->+ if ioe_type err == UnsatisfiedConstraints then releaseLock dir else ioError err+ else do+ mapM (\f -> do+ c <- readFile f+ when (c==c) $ removeFile f+ return (read c)+ ) files+ where interesting "." = False+ interesting ".." = False+ interesting _ = True+ pickFiles = map (lockDir </>) . filter interesting+ lockDir = dir </> ".lock"+++-- | Convenience function combining the two functions above.+--+-- Runs the fifth argument repeatedly, locked using the directory in the +-- first argument, passed the current event the first time, and using the+-- combination function the other times.+--+-- If the forth argument is true, this function will tell the user whats+-- happening (using putStrLn)+lockRestart :: (Show a, Read a) =>+ FilePath+ -> a+ -> ([a] -> a)+ -> Bool+ -> (a -> IO ())+ -> IO ()+lockRestart dir event combine verbose action = do+ when verbose $ putStrLn "Trying to get lock..."+ l <- lockOrMark dir event+ if l then do+ when verbose $ putStrLn "Got the lock, going to work..."+ workAndCheck event+ else+ when verbose $ putStrLn "Could not get locked, signaled restart"+ where workAndCheck event = do+ action event+ when verbose $ putStrLn "Trying to release the lock..."+ msgs <- releaseLock dir+ if null msgs then do+ when verbose $ putStrLn "Successfully released lock."+ else do+ when verbose $ putStrLn "New work to do..."+ workAndCheck (combine msgs)+
+ src/Main.hs view
@@ -0,0 +1,196 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}+++import Control.Monad+import Control.Concurrent+import System.Environment (getArgs)+import System.Directory+import System.Posix.Files+import System.Time+import System.IO++import qualified Data.Map as M+import qualified Data.Set as S+import qualified MultiMap as MM+import MultiMap ((!!!!))+import Data.Char+import Data.List++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Char8 (ByteString)++-- Darcs stuff+import Darcs+-- Web ouput+import HTML+import LockRestart++import Data.Digest.OpenSSL.MD5 (md5sum)++data DarcsWatchConfig = DarcsWatchConfig {+ cRepositories :: [String],+ cOutput :: String,+ cMails :: String+ } deriving (Show, Read)+++main = do+ hSetBuffering stdout NoBuffering+ args <- getArgs+ let (confdir, patchNew) = case args of+ [confdir] -> (addSlash confdir, False)+ [confdir, "new"] -> (addSlash confdir, True)+ _ -> error "Use darcswatch confdir/"+ putStrLn "Reading configuration..."+ config <- read `fmap` readFile (confdir ++ "config")++ lockRestart (cOutput config) patchNew or True (do_work config)++do_work config patchNew = do+ putStrLn "Reading repositories..."+ let loadInv rep = do+ putStrLn $ "Reading " ++ rep ++ ":"+ (ps,thisNew) <- getInventory (cOutput config ++ "/cache/") rep+ putStrLn (if thisNew then "Repostory is new." else "Repository is cached.")+ return (rep, ps, thisNew)+ readInv (p2r,r2p,new) (rep, ps,thisNew) = do+ let p2r' = foldr (\p -> MM.append p rep) p2r ps+ r2p' = MM.extend rep ps r2p :: M.Map String (S.Set PatchInfo)+ return (p2r', r2p', new || thisNew)+ (p2r,r2p, new) <- foldM readInv (MM.empty, MM.empty, patchNew) =<<+ forkSequence (map loadInv (cRepositories config))++ if not new then putStrLn "Nothing new, exiting" else do++ putStrLn "Reading emails..."+ mailFiles' <- getDirectoryFiles (cMails config)+ let mailFiles = filter ((addSlash (cMails config) ++ "patch") `isPrefixOf`) mailFiles'++ let readMail (u2p, u2rn, p2pe, md2p) mailFile = do+ putStrLn $ "Reading mail " ++ mailFile ++ " ..."+ mail <- B.readFile mailFile+ let checksum = md5sum mail+ let (new,context) = parseMail mail+ let u2p' = foldr (\(p,_) -> MM.append (normalizeAuthor (piAuthor p)) p) u2p new+ let u2rn' = foldr (\(p,_) ->+ M.insertWith (maxBy B.length) (normalizeAuthor (piAuthor p)) (piAuthor p)+ ) u2rn new+ let p2pe' = foldr (\(p,d) ->+ let pe = PatchExtras d context mailFile+ -- The patch with the smaller context is the more useful+ in M.insertWith (minBy (length.peContext)) p pe+ ) p2pe new+ let md2p' = MM.extend checksum (map fst new) md2p+ return (u2p', u2rn', p2pe', md2p')+ (u2p, u2rn, p2pe, md2p) <- foldM readMail (MM.empty, M.empty, M.empty, MM.empty) mailFiles++ putStrLn "Reading bundle states..."+ states <- readFile (addSlash (cMails config) ++ "states")+ let readStateLine string =+ let (checksum: stateString : _ : rest) = words string+ sender = unwords rest+ state = case stateString of+ "add" -> Unmatched+ "obsolete" -> Obsolete+ "rejected" -> Rejected+ unknown -> error $ "Unknown state " ++ show unknown+ in flip (foldr (\p -> M.insert p state)) (md2p !!!! checksum)+ p2s = foldl (flip readStateLine) M.empty (lines states)++ putStrLn "Reading mid to patch mapping..."+ midmappings <- readFile (addSlash (cMails config) ++ "mid-mapping")+ let readMidLine string =+ let [mid,checksum] = words string+ in flip (foldr (\p -> M.insert p mid)) (md2p !!!! checksum)+ p2mid = foldl (flip readMidLine) M.empty (lines midmappings)++ let patches = M.keys p2pe -- Submitted patches+ let repos = M.keys r2p -- Repos with patches+ let users = M.keys u2p -- Known users++ let addables = do -- List modad+ patch <- patches+ repo <- repos+ pe <- M.lookup patch p2pe+ present <- M.lookup repo r2p+ guard $ all (`S.member` present) (peContext pe)+ return (patch, repo)+ -- Patch to possible repos+ -- Repo to possible patch+ let p2pr = foldr (\(p,r) -> MM.append p r) MM.empty addables+ let r2mp = foldr (\(p,r) -> MM.append r p) MM.empty addables++ -- Unmatched patches+ let unmatched = S.fromList $ filter (\p -> not (M.member p p2pr)) patches++ now <- getClockTime >>= toCalendarTime+ let resultData = ResultData p2r r2p u2p p2pe p2pr r2mp p2s p2mid unmatched now u2rn+ + {-+ putStrLn "Evalutating data"+ putStrLn (show (length (show (resultData))))+ -}++ putStrLn "Writing output..."+ writeFile (cOutput config ++ "/index.html") (mainPage resultData)++ forM_ users $ \u ->+ writeFile (cOutput config ++ "/" ++ userFile u) (userPage resultData u)++ forM_ repos $ \r ->+ writeFile (cOutput config ++ "/" ++ repoFile r) (repoPage resultData r)++ writeFile (cOutput config ++ "/" ++ "unmatched.html") (unmatchedPage resultData)++ putStrLn "Linking patches"+ let patchLink (p,pe) = do+ let link = cOutput config ++ "/" ++ patchBasename p ++ ".dpatch"+ ex <- fileExist link+ unless ex $ do+ -- There might be a broken symlink here:+ catch (removeFile link) (const (return ()))+ createSymbolicLink (peMailFile pe) link+ mapM_ patchLink $ M.toList p2pe++ return ()++getDirectoryFiles dir' = getDirectoryContents dir >>=+ return . (map (dir++)) >>=+ return . filter ((/= '.') . head) >>=+ filterM doesFileExist >>=+ filterM ((readable `fmap`) . getPermissions)+ where dir = addSlash dir'++maxBy f v1 v2 = if f v1 >= f v2 then v1 else v2+minBy f v1 v2 = if f v1 <= f v2 then v1 else v2+++addSlash filename | last filename == '/' = filename+ | otherwise = filename ++ "/"++-- not in ghc6.6+infixl 0 `on`+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c+(*) `on` f = \x y -> f x * f y++forkSequence = sequence+{- Enable for parallel downloads+forkSequence acts = mapM (\act -> newEmptyMVar >>= \mvar -> forkIO (act >>= putMVar mvar) >> return mvar) acts >>= mapM takeMVar+-}
+ src/MultiMap.hs view
@@ -0,0 +1,58 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}++{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module MultiMap+ ( Singleton+ , empty+ , extend+ , append+ , (!!!!)+ , fromList+ ) where++import qualified Data.Map as M+import qualified Data.Set as S+import Data.Monoid+import Data.Foldable+import Prelude hiding (foldr)++class Monoid (c a) => Singleton c a where+ singleton :: a -> c a++instance Singleton [] a where+ singleton = (:[])+instance Ord a => Singleton S.Set a where+ singleton = S.singleton++empty :: (Ord k, Singleton c a) => M.Map k (c a) +empty = M.empty++extend :: (Ord k, Singleton c a, Foldable c2) => k -> c2 a -> M.Map k (c a) -> M.Map k (c a)+extend key addValues map = foldr (append key) map addValues++append :: (Ord k, Singleton c a) => k -> a -> M.Map k (c a) -> M.Map k (c a)+append key addValue = M.insertWith (flip mappend) key (singleton addValue)++fromList :: (Ord k, Singleton c a) => [(k,a)] -> M.Map k (c a)+fromList = foldr (uncurry append) empty++(!!!!) :: (Ord k, Singleton c a) => M.Map k (c a) -> k -> c a+m !!!! key = M.findWithDefault mempty key m
+ src/OldDate.lhs view
@@ -0,0 +1,347 @@+% Copyright (C) 2003 Peter Simons+% Copyright (C) 2003,2008 David Roundy+%+% 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 2, 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; see the file COPYING. If not, write to+% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+% Boston, MA 02110-1301, USA.++This module is intended to provide backwards-compatibility in the parsing+of darcs patches. In other words: don't change it, new features don't get+added here. The only user should be Darcs.Patch.Info.++\begin{code}+module OldDate ( readUTCDate, showIsoDateTime ) where++import Text.ParserCombinators.Parsec+import System.Time+import Data.Char ( toUpper, isDigit )+import Control.Monad ( liftM, liftM2 )++-- | Read\/interpret a date string, assuming UTC if timezone is not specified in the string+readUTCDate :: String -> CalendarTime+readUTCDate = readDate 0++readDate :: Int -> String -> CalendarTime+readDate tz d =+ case parseDate tz d of+ Left e -> error e+ Right ct -> ct++parseDate :: Int -> String -> Either String CalendarTime+parseDate tz d =+ if length d >= 14 && and (map isDigit $ take 14 d)+ then Right $+ CalendarTime (read $ take 4 d)+ (toEnum $ (+ (-1)) $ read $ take 2 $ drop 4 d)+ (read $ take 2 $ drop 6 d) -- Day+ (read $ take 2 $ drop 8 d) -- Hour+ (read $ take 2 $ drop 10 d) -- Minute+ (read $ take 2 $ drop 12 d) -- Second+ 0 Sunday 0 -- Picosecond, weekday and day of year unknown+ "GMT" 0 False+ else let dt = do { x <- date_time tz; eof; return x }+ in case parse dt "" d of+ Left e -> Left $ "bad date: "++d++" - "++show e+ Right ct -> Right ct++showIsoDateTime :: CalendarTime -> String+showIsoDateTime ct = concat [ show $ ctYear ct+ , twoDigit . show . (+1) . fromEnum $ ctMonth ct+ , twoDigit . show $ ctDay ct+ , twoDigit . show $ ctHour ct+ , twoDigit . show $ ctMin ct+ , twoDigit . show $ ctSec ct+ ]+ where twoDigit [] = undefined+ twoDigit x@(_:[]) = '0' : x+ twoDigit x@(_:_:[]) = x+ twoDigit _ = undefined++----- Parser Combinators ---------------------------------------------++-- |Case-insensitive variant of Parsec's 'char' function.++caseChar :: Char -> GenParser Char a Char+caseChar c = satisfy (\x -> toUpper x == toUpper c)++-- |Case-insensitive variant of Parsec's 'string' function.++caseString :: String -> GenParser Char a ()+caseString cs = mapM_ caseChar cs <?> cs++-- |Match a parser at least @n@ times.++manyN :: Int -> GenParser a b c -> GenParser a b [c]+manyN n p+ | n <= 0 = return []+ | otherwise = liftM2 (++) (count n p) (many p)++-- |Match a parser at least @n@ times, but no more than @m@ times.++manyNtoM :: Int -> Int -> GenParser a b c -> GenParser a b [c]+manyNtoM n m p+ | n < 0 = return []+ | n > m = return []+ | n == m = count n p+ | n == 0 = foldr (<|>) (return []) (map (\x -> try $ count x p) (reverse [1..m]))+ | otherwise = liftM2 (++) (count n p) (manyNtoM 0 (m-n) p)+++----- Date/Time Parser -----------------------------------------------++date_time :: Int -> CharParser a CalendarTime+date_time tz =+ choice [try $ cvs_date_time tz,+ try $ iso8601_date_time tz,+ old_date_time]++cvs_date_time :: Int -> CharParser a CalendarTime+cvs_date_time tz =+ do y <- year+ char '/'+ mon <- month_num + char '/'+ d <- day+ my_spaces+ h <- hour+ char ':'+ m <- minute+ char ':'+ s <- second+ z <- option tz $ my_spaces >> zone+ return (CalendarTime y mon d h m s 0 Monday 0 "" z False)++old_date_time :: CharParser a CalendarTime+old_date_time = do wd <- day_name+ my_spaces+ mon <- month_name+ my_spaces+ d <- day+ my_spaces+ h <- hour+ char ':'+ m <- minute+ char ':'+ s <- second+ my_spaces+ z <- zone+ my_spaces+ y <- year+ return (CalendarTime y mon d h m s 0 wd 0 "" z False)++{- FIXME: In case you ever want to use this outside of darcs, you should note + that this implementation of ISO 8601 is not complete. ++ reluctant to implement (ambiguous!): + * years > 9999 + * truncated representations with implied century (89 for 1989) + unimplemented: + * repeated durations (not relevant)+ * lowest order component fractions in intervals+ * negative dates (BC) + unverified or too relaxed:+ * the difference between 24h and 0h+ * allows stuff like 2005-1212; either you use the hyphen all the way + (2005-12-12) or you don't use it at all (20051212), but you don't use+ it halfway, likewise with time + * No bounds checking whatsoever on intervals! + (next action: read iso doc to see if bounds-checking required?) -}+iso8601_date_time :: Int -> CharParser a CalendarTime+iso8601_date_time localTz = try $ + do d <- iso8601_date+ t <- option id $ try $ do optional $ oneOf " T" + iso8601_time + return $ t $ d { ctTZ = localTz }++iso8601_date :: CharParser a CalendarTime+iso8601_date = + do d <- calendar_date <|> week_date <|> ordinal_date+ return $ foldr ($) nullCalendar d+ where + calendar_date = -- yyyy-mm-dd+ try $ do d <- optchain year_ [ (dash, month_), (dash, day_) ]+ -- allow other variants to be parsed correctly + notFollowedBy (digit <|> char 'W')+ return d+ week_date = --yyyy-Www-dd + try $ do yfn <- year_+ optional dash+ char 'W'+ -- offset human 'week 1' -> computer 'week 0'+ w' <- (\x -> x-1) `liftM` two_digits+ wd <- option 1 $ do { optional dash; n_digits 1 }+ let y = yfn nullCalendar+ firstDay = ctWDay y+ -- things that make this complicated+ -- 1. iso8601 weeks start from Monday; Haskell weeks start from Sunday+ -- 2. the first week is the one that contains at least Thursday+ -- if the year starts after Thursday, then some days of the year+ -- will have already passed before the first week+ let afterThursday = firstDay == Sunday || firstDay > Thursday+ w = if afterThursday then w'+1 else w'+ diff c = c { ctDay = (7 * w) + wd - (fromEnum firstDay) }+ return [(toUTCTime.toClockTime.diff.yfn)]+ ordinal_date = -- yyyy-ddd+ try $ optchain year_ [ (dash, yearDay_) ]+ --+ year_ = try $ do y <- four_digits <?> "year (0000-9999)"+ return $ \c -> c { ctYear = y }+ month_ = try $ do m <- two_digits <?> "month (1 to 12)"+ -- we (artificially) use ctPicosec to indicate+ -- whether the month has been specified.+ return $ \c -> c { ctMonth = intToMonth m, ctPicosec = 0 }+ day_ = try $ do d <- two_digits <?> "day in month (1 to 31)"+ return $ \c -> c { ctDay = d }+ yearDay_ = try $ do d <- n_digits 3 <?> "day in year (1 to 366)"+ return $ \c -> c { ctYDay = d }+ dash = char '-'++-- we return a function which sets the time on another calendar+iso8601_time :: CharParser a (CalendarTime -> CalendarTime)+iso8601_time = try $+ do ts <- optchain hour_ [ (colon , min_)+ , (colon , sec_)+ , (oneOf ",.", pico_) ] + z <- option id $ choice [ zulu , offset ]+ return $ foldr (.) id (z:ts)+ where + hour_ = do h <- two_digits+ return $ \c -> c { ctHour = h }+ min_ = do m <- two_digits+ return $ \c -> c { ctMin = m }+ sec_ = do s <- two_digits+ return $ \c -> c { ctSec = s }+ pico_ = do digs <- many digit+ let picoExp = 12+ digsExp = length digs+ let frac | null digs = 0+ | digsExp > picoExp = read $ take picoExp digs+ | otherwise = 10 ^ (picoExp - digsExp) * (read digs)+ return $ \c -> c { ctPicosec = frac }+ zulu = do { char 'Z'; return (\c -> c { ctTZ = 0 }) }+ offset = do sign <- choice [ do { char '+' >> return 1 }+ , do { char '-' >> return (-1) } ]+ h <- two_digits+ m <- option 0 $ do { optional colon; two_digits }+ return $ \c -> c { ctTZ = sign * 60 * ((h*60)+m) }+ colon = char ':'++optchain :: CharParser a b -> [(CharParser a c, CharParser a b)] -> CharParser a [b]+optchain p next = try $ + do r1 <- p+ r2 <- case next of + [] -> return []+ ((sep,p2):next2) -> option [] $ do { optional sep; optchain p2 next2 }+ return (r1:r2)++n_digits :: Int -> CharParser a Int +n_digits n = read `liftM` count n digit++two_digits, four_digits :: CharParser a Int+two_digits = n_digits 2+four_digits = n_digits 4++my_spaces :: CharParser a String+my_spaces = manyN 1 $ char ' '++day_name :: CharParser a Day+day_name = choice+ [ caseString "Mon" >> return Monday+ , try (caseString "Tue") >> return Tuesday+ , caseString "Wed" >> return Wednesday+ , caseString "Thu" >> return Thursday+ , caseString "Fri" >> return Friday+ , try (caseString "Sat") >> return Saturday+ , caseString "Sun" >> return Sunday+ ]++year :: CharParser a Int+year = four_digits++month_num :: CharParser a Month+month_num = do mn <- manyNtoM 1 2 digit + return $ intToMonth $ (read mn :: Int)++intToMonth :: Int -> Month+intToMonth 1 = January+intToMonth 2 = February+intToMonth 3 = March+intToMonth 4 = April+intToMonth 5 = May+intToMonth 6 = June+intToMonth 7 = July+intToMonth 8 = August+intToMonth 9 = September+intToMonth 10 = October+intToMonth 11 = November+intToMonth 12 = December+intToMonth _ = error "invalid month!"++month_name :: CharParser a Month+month_name = choice+ [ try (caseString "Jan") >> return January+ , caseString "Feb" >> return February+ , try (caseString "Mar") >> return March+ , try (caseString "Apr") >> return April+ , caseString "May" >> return May+ , try (caseString "Jun") >> return June+ , caseString "Jul" >> return July+ , caseString "Aug" >> return August+ , caseString "Sep" >> return September+ , caseString "Oct" >> return October+ , caseString "Nov" >> return November+ , caseString "Dec" >> return December+ ]++day :: CharParser a Int+day = do d <- manyNtoM 1 2 digit+ return (read d :: Int)++hour :: CharParser a Int+hour = two_digits++minute :: CharParser a Int+minute = two_digits++second :: CharParser a Int+second = two_digits++zone :: CharParser a Int+zone = choice+ [ do { char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }+ , do { char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) }+ , mkZone "UTC" 0+ , mkZone "UT" 0+ , mkZone "GMT" 0+ , mkZone "EST" (-5)+ , mkZone "EDT" (-4)+ , mkZone "CST" (-6)+ , mkZone "CDT" (-5)+ , mkZone "MST" (-7)+ , mkZone "MDT" (-6)+ , mkZone "PST" (-8)+ , mkZone "PDT" (-7)+ , mkZone "CEST" 2+ , mkZone "EEST" 3+ -- if we don't understand it, just give a GMT answer...+ , do { manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' '])+ (lookAhead space_digit);+ return 0 }+ ]+ where mkZone n o = try $ do { caseString n; return (o*60*60) }+ space_digit = try $ do { char ' '; oneOf ['0'..'9'] }++nullCalendar :: CalendarTime +nullCalendar = CalendarTime 0 January 0 0 0 0 1 Sunday 0 "" 0 False+\end{code}
+ src/StringCrypto.hs view
@@ -0,0 +1,65 @@+{-+Copyright (C) 2008 Joachim Breitner++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 2, 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; see the file COPYING. If not, write to+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+Boston, MA 02110-1301, USA.+-}+++module StringCrypto + ( md5+ , sha1+ ) where++import qualified Data.Digest.SHA1 as SHA1+import qualified Data.Digest.MD5 as MD5+import Data.Word+import Data.Char++md5 :: String -> String+md5 = toHex1 . MD5.hash . map (fromIntegral. ord)++toHex1 :: [Word8] -> String+toHex1 = concatMap showAsHex1++showAsHex1 :: Word8 -> String+showAsHex1 n = showIt 2 n ""+ where+ showIt :: Int -> Word8 -> String -> String+ showIt 0 _ r = r+ showIt i x r = case quotRem x 16 of+ (y, z) -> let c = intToDigit (fromIntegral z)+ in c `seq` showIt (i-1) y (c:r)++++sha1 :: String -> String+sha1 = toHex2 . SHA1.hash . map (fromIntegral . ord)++toHex2 :: SHA1.Word160 -> String+toHex2 (SHA1.Word160 a b c d e)+ = concatMap showAsHex2 [a, b, c, d, e]++showAsHex2 :: Word32 -> String+showAsHex2 n = showIt 8 n ""+ where+ showIt :: Int -> Word32 -> String -> String+ showIt 0 _ r = r+ showIt i x r = case quotRem x 16 of+ (y, z) -> let c = intToDigit (fromIntegral z)+ in c `seq` showIt (i-1) y (c:r)+++