lambdaFeed (empty) → 0.3.1
raw patch · 23 files changed
+3055/−0 lines, 23 filesdep +basedep +haskell98dep +htmlbuild-type:Customsetup-changed
Dependencies added: base, haskell98, html
Files
- AUTHORS +1/−0
- COPYING +347/−0
- Config.hs +229/−0
- Config.hs.in +229/−0
- Date.hs +204/−0
- Error.hs +54/−0
- Feed.hs +256/−0
- HTML.hs +133/−0
- INSTALL +29/−0
- LambdaFeed.hs +727/−0
- LambdaFeedMain.hs +14/−0
- Makefile +10/−0
- README +18/−0
- RSS.hs +195/−0
- Setup.hs +4/−0
- Stanza.hs +231/−0
- VersionTool.hs +267/−0
- channel.css +37/−0
- lambdaFeed.cabal +28/−0
- runLambdaFeed.hs +4/−0
- test/polar/morefish.lfi +9/−0
- test/polar/whereisthefish.lfi +9/−0
- test/polarbear.lfc +20/−0
+ AUTHORS view
@@ -0,0 +1,1 @@+Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+ COPYING view
@@ -0,0 +1,347 @@+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.++++ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 675 Mass Ave, Cambridge, MA 02139, 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 Library 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++ Appendix: 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) 19yy <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., 675 Mass Ave, Cambridge, MA 02139, 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) 19yy 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 Library General+Public License instead of this License.+
+ Config.hs view
@@ -0,0 +1,229 @@+-- |A simple feed generator: Configuration management and command line parsing+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Config (++ -- * Identity+ version, exactvers, copyright, disclaimer,++ -- * File suffixes+ chanSuffix, itemSuffix, htmlSuffix, rssSuffix,++ -- * Configuration record+ Config(..),++ -- * Command line argument parsing+ processArgs++) where++-- hierachical libraries+--++import Control.Monad (+ when, unless, foldM)++import Data.Char (+ isDigit)++import System.Console.GetOpt (+ ArgOrder(..), OptDescr(..), ArgDescr(..), getOpt, usageInfo)+import System.Environment (+ getArgs, getProgName)++-- lambdaFeed+import Error (+ abortWithIO, exitSuccess)+++-- Version information+-- -------------------++name = "lambdaFeed"+versnum = "0.3.1"+versnick = "'Lambdas are food for thought'"+versdate = "18 Jun 2006"+patchlevel = "pl0"+context = "[TAG version 0.3.1\nManuel M T Chakravarty <chak@cse.unsw.edu.au>**20060619163411] \n"+confdate = "13 Feb 2007"+version = name ++ ", version " ++ versnum ++ " (" ++ patchlevel ++ ") " ++ + versnick ++ ", " ++ versdate+exactvers = version ++ "\nConfigured " ++ confdate ++ " in context:\n" +++ context+copyright = "Copyright (c) 2006 Manuel M T Chakravarty"+disclaimer = "This software is distributed under the \+ \terms of the GNU Public Licence.\n\+ \NO WARRANTY WHATSOEVER IS PROVIDED. \+ \See <http://www.gnu.org/licenses/gpl.html>."+++-- Constants+-- ---------++-- Suffixes+--+chanSuffix = "lfc"+itemSuffix = "lfi"+htmlSuffix = "html"+rssSuffix = "xml"+++-- Dynamic configuration+-- ---------------------++-- Configuration+--+-- * Strictly speaking we should use `Maybe Int' for `maxItems', but I doubt+-- that this will be an issue any time soon.+--+data Config = Config {+ debugCfg :: Int,+ feedDirCfg :: FilePath,+ htmlDirCfg :: FilePath,+ maxItemsOpt :: Int, -- truncate any further channels items+ rssDirCfg :: FilePath,+ verboseCfg :: Bool,+ quietCfg :: Bool+ }++-- Default configuration+--+dftConfig = Config {+ debugCfg = 0,+ feedDirCfg = ".",+ htmlDirCfg = "",+ maxItemsOpt = maxBound,+ rssDirCfg = "",+ verboseCfg = False,+ quietCfg = False+ }++-- Available options+--+data Option = Debug+ | FeedDirOpt FilePath+ | Help+ | HTMLDirOpt FilePath+ | MaxItemsOpt String+ | RSSDirOpt FilePath+ | OutputOpt FilePath+ | Verbose+ | Version Bool+ | Quiet+ deriving Eq++-- Option description+--+options :: [OptDescr Option]+options = [ Option ['d'] ["debug"] (NoArg Debug) + "produces extra diagnostic output; repeat for more"+ , Option ['f'] ["feed"] (ReqArg FeedDirOpt "DIR") + "directory with channel descriptions (default: .)"+ , Option ['h', '?'] ["help"] (NoArg Help)+ "this help message"+ , Option [] ["htmldir"] (ReqArg HTMLDirOpt "DIR")+ "target directory for generated HTML files"+ , Option ['m'] ["max-items"] (ReqArg MaxItemsOpt "N")+ "number of items after which to drop further items per channel"+ , Option [] ["rssdir"] (ReqArg RSSDirOpt "DIR")+ "target directory for generated RSS 2.0 files"+ , Option ['o'] ["output"] (ReqArg OutputOpt "DIR")+ "sets target directory for both HTML and RSS 2.0 files"+ , Option ['v'] ["verbose"] (NoArg Verbose)+ "print summary information (default: off)"+ , Option ['V'] ["version"] (NoArg $ Version False)+ "version information"+ , Option [] ["exact-version"] (NoArg $ Version True)+ "more detailed version information (use for bug reports!)"+ , Option ['q'] ["quiet"] (NoArg Quiet)+ "suppress all output, including parser warnings"+ ]++-- Option processing+--+processArgs :: IO Config+processArgs =+ do+ args <- getArgs+ case getOpt RequireOrder options args of+ (opts, [] , [] ) -> do+ processVersion opts+ processHelp opts+ processConfig dftConfig opts+ (opts, args, [] ) -> abort [unrecErr ++ unwords args]+ (_ , _ , errs) -> abort errs+ where+ unrecErr = "Unrecognised arguments: "++-- Print version information if `Help' or `Version' requested and remove any+-- `Version' options.+--+processVersion :: [Option] -> IO ()+processVersion opts =+ do+ when (Version False `elem` opts || + Version True `elem` opts || + Help `elem` opts ) $ do+ if Version True `elem` opts+ then + putStrLn exactvers+ else+ putStrLn version+ putStrLn copyright+ putStrLn disclaimer+ unless (Help `elem` opts) $+ exitSuccess+ return ()++-- Print help information if `Help' requested and terminate successfully.+--+processHelp :: [Option] -> IO ()+processHelp opts =+ do+ name <- getProgName+ let header = "\nUsage: " ++ name ++ " [ option... ]\n"+ when (Help `elem` opts) $ do+ putStrLn $ usageInfo header options+ exitSuccess+ return ()++-- Process configuration options.+--+processConfig :: Config -> [Option] -> IO Config+processConfig = foldM processOneOption+ where+ processOneOption config Debug = + return $ config {debugCfg = debugCfg config + 1}+ processOneOption config (FeedDirOpt dir) = + return $ config {feedDirCfg = dir}+ processOneOption config (HTMLDirOpt dir) = + return $ config {htmlDirCfg = dir}+ processOneOption config (MaxItemsOpt nStr) = + do+ when (not . all isDigit $ nStr) $+ abort ["`" ++ nStr ++ "': not a number (--max-items)"]+ return $ config {maxItemsOpt = read nStr}+ processOneOption config (RSSDirOpt dir) = + return $ config {rssDirCfg = dir}+ processOneOption config (OutputOpt dir) = + return $ config {htmlDirCfg = dir, rssDirCfg = dir}+ processOneOption config Verbose = + return $ config {verboseCfg = True}+ processOneOption config Quiet = + return $ config {quietCfg = True}++-- Error during parsing command line options+--+abort :: [String] -> IO a+abort = + abortWithIO . (++ ["Try the option `--help' on its own for more \+ \information."])+
+ Config.hs.in view
@@ -0,0 +1,229 @@+-- |A simple feed generator: Configuration management and command line parsing+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Config (++ -- * Identity+ version, exactvers, copyright, disclaimer,++ -- * File suffixes+ chanSuffix, itemSuffix, htmlSuffix, rssSuffix,++ -- * Configuration record+ Config(..),++ -- * Command line argument parsing+ processArgs++) where++-- hierachical libraries+--++import Control.Monad (+ when, unless, foldM)++import Data.Char (+ isDigit)++import System.Console.GetOpt (+ ArgOrder(..), OptDescr(..), ArgDescr(..), getOpt, usageInfo)+import System.Environment (+ getArgs, getProgName)++-- lambdaFeed+import Error (+ abortWithIO, exitSuccess)+++-- Version information+-- -------------------++name = "lambdaFeed"+versnum = @VERSION@+versnick = @VERSNICK@+versdate = @VERSDATE@+patchlevel = @PATCHLEVEL@+context = @CONTEXT@+confdate = @CONFDATE@+version = name ++ ", version " ++ versnum ++ " (" ++ patchlevel ++ ") " ++ + versnick ++ ", " ++ versdate+exactvers = version ++ "\nConfigured " ++ confdate ++ " in context:\n" +++ context+copyright = "Copyright (c) 2006 Manuel M T Chakravarty"+disclaimer = "This software is distributed under the \+ \terms of the GNU Public Licence.\n\+ \NO WARRANTY WHATSOEVER IS PROVIDED. \+ \See <http://www.gnu.org/licenses/gpl.html>."+++-- Constants+-- ---------++-- Suffixes+--+chanSuffix = "lfc"+itemSuffix = "lfi"+htmlSuffix = "html"+rssSuffix = "xml"+++-- Dynamic configuration+-- ---------------------++-- Configuration+--+-- * Strictly speaking we should use `Maybe Int' for `maxItems', but I doubt+-- that this will be an issue any time soon.+--+data Config = Config {+ debugCfg :: Int,+ feedDirCfg :: FilePath,+ htmlDirCfg :: FilePath,+ maxItemsOpt :: Int, -- truncate any further channels items+ rssDirCfg :: FilePath,+ verboseCfg :: Bool,+ quietCfg :: Bool+ }++-- Default configuration+--+dftConfig = Config {+ debugCfg = 0,+ feedDirCfg = ".",+ htmlDirCfg = "",+ maxItemsOpt = maxBound,+ rssDirCfg = "",+ verboseCfg = False,+ quietCfg = False+ }++-- Available options+--+data Option = Debug+ | FeedDirOpt FilePath+ | Help+ | HTMLDirOpt FilePath+ | MaxItemsOpt String+ | RSSDirOpt FilePath+ | OutputOpt FilePath+ | Verbose+ | Version Bool+ | Quiet+ deriving Eq++-- Option description+--+options :: [OptDescr Option]+options = [ Option ['d'] ["debug"] (NoArg Debug) + "produces extra diagnostic output; repeat for more"+ , Option ['f'] ["feed"] (ReqArg FeedDirOpt "DIR") + "directory with channel descriptions (default: .)"+ , Option ['h', '?'] ["help"] (NoArg Help)+ "this help message"+ , Option [] ["htmldir"] (ReqArg HTMLDirOpt "DIR")+ "target directory for generated HTML files"+ , Option ['m'] ["max-items"] (ReqArg MaxItemsOpt "N")+ "number of items after which to drop further items per channel"+ , Option [] ["rssdir"] (ReqArg RSSDirOpt "DIR")+ "target directory for generated RSS 2.0 files"+ , Option ['o'] ["output"] (ReqArg OutputOpt "DIR")+ "sets target directory for both HTML and RSS 2.0 files"+ , Option ['v'] ["verbose"] (NoArg Verbose)+ "print summary information (default: off)"+ , Option ['V'] ["version"] (NoArg $ Version False)+ "version information"+ , Option [] ["exact-version"] (NoArg $ Version True)+ "more detailed version information (use for bug reports!)"+ , Option ['q'] ["quiet"] (NoArg Quiet)+ "suppress all output, including parser warnings"+ ]++-- Option processing+--+processArgs :: IO Config+processArgs =+ do+ args <- getArgs+ case getOpt RequireOrder options args of+ (opts, [] , [] ) -> do+ processVersion opts+ processHelp opts+ processConfig dftConfig opts+ (opts, args, [] ) -> abort [unrecErr ++ unwords args]+ (_ , _ , errs) -> abort errs+ where+ unrecErr = "Unrecognised arguments: "++-- Print version information if `Help' or `Version' requested and remove any+-- `Version' options.+--+processVersion :: [Option] -> IO ()+processVersion opts =+ do+ when (Version False `elem` opts || + Version True `elem` opts || + Help `elem` opts ) $ do+ if Version True `elem` opts+ then + putStrLn exactvers+ else+ putStrLn version+ putStrLn copyright+ putStrLn disclaimer+ unless (Help `elem` opts) $+ exitSuccess+ return ()++-- Print help information if `Help' requested and terminate successfully.+--+processHelp :: [Option] -> IO ()+processHelp opts =+ do+ name <- getProgName+ let header = "\nUsage: " ++ name ++ " [ option... ]\n"+ when (Help `elem` opts) $ do+ putStrLn $ usageInfo header options+ exitSuccess+ return ()++-- Process configuration options.+--+processConfig :: Config -> [Option] -> IO Config+processConfig = foldM processOneOption+ where+ processOneOption config Debug = + return $ config {debugCfg = debugCfg config + 1}+ processOneOption config (FeedDirOpt dir) = + return $ config {feedDirCfg = dir}+ processOneOption config (HTMLDirOpt dir) = + return $ config {htmlDirCfg = dir}+ processOneOption config (MaxItemsOpt nStr) = + do+ when (not . all isDigit $ nStr) $+ abort ["`" ++ nStr ++ "': not a number (--max-items)"]+ return $ config {maxItemsOpt = read nStr}+ processOneOption config (RSSDirOpt dir) = + return $ config {rssDirCfg = dir}+ processOneOption config (OutputOpt dir) = + return $ config {htmlDirCfg = dir, rssDirCfg = dir}+ processOneOption config Verbose = + return $ config {verboseCfg = True}+ processOneOption config Quiet = + return $ config {quietCfg = True}++-- Error during parsing command line options+--+abort :: [String] -> IO a+abort = + abortWithIO . (++ ["Try the option `--help' on its own for more \+ \information."])+
+ Date.hs view
@@ -0,0 +1,204 @@+-- |A simple feed generator: Date utilities+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Date (+ Date(..), addMinutes, parseDate,+) where++-- hierachical libraries+--++import Control.Monad (+ liftM)++import Data.Char (+ isDigit, digitToInt)++import System.Locale (+ TimeLocale(..), defaultTimeLocale, rfc822DateFormat)+import System.Time (+ Month(..), ClockTime, TimeDiff(..), CalendarTime(..), noTimeDiff,+ addToClockTime, toUTCTime, toClockTime, formatCalendarTime)+++-- We convert all dates into an internal representation for storage and+-- comparison. All I/O uses the RFC822 format as required by the RSS 2.0+-- specification.+--+newtype Date = Date ClockTime++instance Eq Date where+ Date d1 == Date d2 = d1 == d2++instance Ord Date where+ compare (Date d1) (Date d2) = compare d1 d2++instance Show Date where+ show (Date d) = + formatCalendarTime defaultTimeLocale rfc822DateFormat (toUTCTime d)++-- Advance a date specification by the specified number of minutes.+--+addMinutes :: Date -> Int -> Date+addMinutes (Date ct) min = + Date $ addToClockTime (noTimeDiff {tdMin = min}) ct++-- Parse an RFC822 date string (but allowing four digits for years and also+-- UTC, in addition to UT)+--+-- * Cf <http://asg.web.cmu.edu/rfc/rfc822.html#sec-5>+--+parseDate :: String -> Maybe Date+parseDate = liftM Date . parseDay+ where+ parseDay (_:_:_:',':' ':noWDay) = parseDay noWDay -- drop weekday+ parseDay (d1 :' ':monthEtc) -- 1 digit day+ | isDigit d1 = parseMonth (convDay '0' d1 ) monthEtc+ parseDay (d1:d2:' ':monthEtc) -- 2 digit day+ | isDigit d1 && isDigit d2 = parseMonth (convDay d1 d2) monthEtc+ parseDay _ = Nothing+ --+ parseMonth day (m1:m2:m3:' ':yearEtc) = + parseYear day (parseMonth' (m1:m2:m3:[])) yearEtc+ --+ parseMonth' "Jan" = Just January+ parseMonth' "Feb" = Just February+ parseMonth' "Mar" = Just March+ parseMonth' "Apr" = Just April+ parseMonth' "May" = Just May+ parseMonth' "Jun" = Just June+ parseMonth' "Jul" = Just July+ parseMonth' "Aug" = Just August+ parseMonth' "Sep" = Just September+ parseMonth' "Oct" = Just October+ parseMonth' "Nov" = Just November+ parseMonth' "Dec" = Just December+ parseMonth' _ = Nothing+ --+ parseYear day mons (y1:y2 :' ':timeStr) -- 2 digit year+ | isDigit y1 && isDigit y2 =+ convert day mons (convYear Nothing y1 y2) (parseTime timeStr)+ parseYear day mons (y1:y2:y3:y4:' ':timeStr) -- 4 digit year+ | isDigit y1 && isDigit y2 && isDigit y3 && isDigit y4 =+ convert day mons (convYear (Just (y1, y2)) y3 y4) (parseTime timeStr)+ parseYear _ _ _ = Nothing+ --+ parseTime (h1:h2:':':m1:m2:':':s1:s2:' ':zoneStr) -- w/ seconds+ | isDigit h1 && isDigit h2 && isDigit m1 && isDigit m2 &&+ isDigit s1 && isDigit s2 =+ do+ hour <- convHour h1 h2+ mins <- convMins m1 m2+ secs <- convSecs s1 s2+ zone <- parseZone zoneStr+ return $ (hour, mins, secs, zone)+ parseTime (h1:h2:':':m1:m2 :' ':zoneStr) -- w/o seconds+ | isDigit h1 && isDigit h2 && isDigit m1 && isDigit m2 =+ do+ hour <- convHour h1 h2+ mins <- convMins m1 m2+ let secs = 0+ zone <- parseZone zoneStr+ return (hour, mins, secs, zone)+ parseTime _ = Nothing+ --+ convYear Nothing y1 y2 | 70 <= year = Just $ 1900 + year+ | otherwise = Just $ 2000 + year+ where year = digitToInt y1 * 10 + + digitToInt y2+ convYear (Just (y1, y2)) y3 y4 = Just $ digitToInt y1 * 1000 ++ digitToInt y2 * 100 ++ digitToInt y3 * 10 ++ digitToInt y4+ convDay d1 d2 | 1 <= day && day <= 31 = Just day+ | otherwise = Nothing+ where day = digitToInt d1 * 10 + digitToInt d2+ convHour h1 h2 | 0 <= hour && hour <= 23 = Just hour+ | otherwise = Nothing+ where hour = digitToInt h1 * 10 + digitToInt h2+ convMins m1 m2 | 0 <= mins && mins <= 59 = Just mins+ | otherwise = Nothing+ where mins = digitToInt m1 * 10 + digitToInt m2+ convSecs s1 s2 | 0 <= secs && secs <= 59 = Just secs+ | otherwise = Nothing+ where secs = digitToInt s1 * 10 + digitToInt s2+ --+ parseZone :: String -> Maybe Int+ parseZone "UT" = Just 0+ parseZone "UTC" = Just 0+ parseZone "GMT" = Just 0+ parseZone "EST" = Just (hourToSecs (-5))+ parseZone "EDT" = Just (hourToSecs (-4))+ parseZone "CST" = Just (hourToSecs (-6))+ parseZone "CDT" = Just (hourToSecs (-5))+ parseZone "MST" = Just (hourToSecs (-7))+ parseZone "MDT" = Just (hourToSecs (-6))+ parseZone "PST" = Just (hourToSecs (-8))+ parseZone "PDT" = Just (hourToSecs (-7))+ parseZone "Z" = Just 0+ parseZone "A" = Just (hourToSecs (-1))+ parseZone "B" = Just (hourToSecs (-2))+ parseZone "C" = Just (hourToSecs (-3))+ parseZone "D" = Just (hourToSecs (-4))+ parseZone "E" = Just (hourToSecs (-5))+ parseZone "F" = Just (hourToSecs (-6))+ parseZone "G" = Just (hourToSecs (-7))+ parseZone "H" = Just (hourToSecs (-8))+ parseZone "I" = Just (hourToSecs (-9))+ parseZone "K" = Just (hourToSecs (-10))+ parseZone "L" = Just (hourToSecs (-11))+ parseZone "M" = Just (hourToSecs (-12))+ parseZone "N" = Just (hourToSecs 1)+ parseZone "O" = Just (hourToSecs 2)+ parseZone "P" = Just (hourToSecs 3)+ parseZone "Q" = Just (hourToSecs 4)+ parseZone "R" = Just (hourToSecs 5)+ parseZone "S" = Just (hourToSecs 6)+ parseZone "T" = Just (hourToSecs 7)+ parseZone "U" = Just (hourToSecs 8)+ parseZone "V" = Just (hourToSecs 9)+ parseZone "W" = Just (hourToSecs 10)+ parseZone "X" = Just (hourToSecs 11)+ parseZone "Y" = Just (hourToSecs 12)+ parseZone ('+':hhmm) = parseDiff 1 hhmm+ parseZone ('-':hhmm) = parseDiff (-1) hhmm+ parseZone _ = Nothing+ --+ parseDiff :: Int -> String -> Maybe Int+ parseDiff sign (h1:h2:m1:m2:[]) =+ do+ hour <- convHour h1 h2+ mins <- convMins m1 m2+ return $ sign * (hour * 60 + mins) * 60+ --+ hourToSecs hour = hour * 60 * 60+ --+ convert day mons year time = + do+ day' <- day+ mons' <- mons+ year' <- year+ (hour, mins, secs, zone) <- time+ return $ toClockTime $ CalendarTime {+ ctYear = year',+ ctMonth = mons',+ ctDay = day' ,+ ctHour = hour ,+ ctMin = mins ,+ ctSec = secs ,+ ctPicosec = 0 ,+ ctTZ = zone ,+ -- to avoid getting a warning+ ctWDay = undefined,+ ctYDay = undefined, + ctTZName = undefined,+ ctIsDST = undefined+ }
+ Error.hs view
@@ -0,0 +1,54 @@+-- |A simple feed generator: Error handling+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Error (++ -- * Error formatting+ elementErrStr, ++ -- * Program termination+ abortWith, abortWithIO, exitSuccess++) where++-- hierachical libraries+import System.Environment (+ getProgName)+import System.Exit (+ ExitCode(..), exitWith, exitFailure)+++-- Produce an error message for a given source, line range, and custom error+-- message.+--+elementErrStr :: String -> (Int, Int) -> String -> String+elementErrStr sname (start, end) err =+ sname ++ ":" ++ show start ++ "-" ++ show end ++": " ++ err++-- Terminate with a set of errors (in pure code).+--+abortWith :: [String] -> a+abortWith = error . ("FATAL ERROR" ++) . concat . map ('\n':)++-- Terminate with a set of errors (in IO code).+--+abortWithIO :: [String] -> IO a+abortWithIO errs =+ do+ name <- getProgName+ putStrLn $ name ++ ": FATAL ERROR"+ putStr (unlines errs)+ exitFailure++-- Terminate sucessfully.+--+exitSuccess :: IO a+exitSuccess = exitWith ExitSuccess
+ Feed.hs view
@@ -0,0 +1,256 @@+-- |A simple feed generator: Feed data structure+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Feed (++ -- * Internal representation of feeds+ URL, Feed(..), Channel(..), Image(..), Category(..), Item(..),+ Enclosure(..), GUID(..), Source(..), Info(..),++ -- * Copying of non-parametric components of channels+ copyChannelInfo,++ -- * Default values for all feed sub-structures+ defaultChannel, defaultImage, defaultCategory, defaultItem,+ defaultEnclosure, defaultGUID, defaultSource++) where++-- lambdaFeed+import Date (+ Date)+++-- Feed data structure (following RSS 2.0.1 (rv 6))+-- -------------------++-- URL data type+--+type URL = String++-- A feed consists of a set of channels.+--+data Feed items = Feed [Channel items]+ deriving Show++-- Channel description+--+data Channel items = + Channel {+ titleChan :: String,+ linkChan :: URL,+ descriptionChan :: String,+ languageChan :: Maybe String,+ copyrightChan :: Maybe String,+ managingEditorChan :: Maybe String,+ webMasterChan :: Maybe String,+ pubDateChan :: Maybe Date,+ lastBuildDateChan :: Maybe Date,+ categoryChan :: [Category], -- may be empty+ generatorChan :: Maybe String,+ docsChan :: Maybe URL,+ cloudChan :: (),+ ttlChan :: Maybe Int, -- in minutes+ imageChan :: Maybe Image,+ ratingChan :: (),+ textInputChan :: (),+ skipHoursChan :: (),+ skipDaysChan :: (),+ itemsChan :: items,+ infoChan :: Info -- internal info about a channel+ }+ deriving Show++-- Generic categorisation information+--+data Category = Category {+ categoryCategory :: String,+ domainCategory :: Maybe String+ }+ deriving Show++-- Inline image+--+data Image = Image {+ urlImage :: URL,+ titleImage :: String,+ linkImage :: URL,+ widthImage :: Maybe Int,+ heightImage :: Maybe Int,+ descriptionImage :: Maybe String+ }+ deriving Show++-- Feed item+--+-- * Either `titleItem' or `descriptionItem' must be present.+--+data Item = Item {+ titleItem :: Maybe String,+ linkItem :: Maybe URL,+ descriptionItem :: Maybe String,+ authorItem :: Maybe String, -- email of author+ categoryItem :: [Category], -- may be empty+ commentsItem :: Maybe URL,+ enclosureItem :: Maybe Enclosure,+ guidItem :: Maybe GUID,+ pubDateItem :: Maybe Date,+ sourceItem :: Maybe Source+ }+ deriving Show++-- Inline media content+--+data Enclosure = Enclosure {+ urlEnclosure :: URL,+ lengthEnclosure :: Int, -- in bytes+ typeEnclosure :: String+ }+ deriving Show++-- Global identification+--+data GUID = GUID {+ guidGUID :: String,+ isPermaLinkGUID :: Maybe Bool+ }+ deriving Show++-- Item source+--+data Source = Source {+ sourceSource :: String,+ urlSource :: URL+ }+ deriving Show++-- lambdaFeed specific information about a channel+--+data Info = Info {+ fnameInfo :: FilePath -- basename of .lfc+ }+ deriving Show++-- Copies all components of a channel structure except `itemsChan'.+--+copyChannelInfo :: Channel a -> Channel b+copyChannelInfo chan =+ Channel {+ titleChan = titleChan chan,+ linkChan = linkChan chan,+ descriptionChan = descriptionChan chan,+ languageChan = languageChan chan,+ copyrightChan = copyrightChan chan,+ managingEditorChan = managingEditorChan chan,+ webMasterChan = webMasterChan chan,+ pubDateChan = pubDateChan chan,+ lastBuildDateChan = lastBuildDateChan chan,+ categoryChan = categoryChan chan,+ generatorChan = generatorChan chan,+ docsChan = docsChan chan,+ cloudChan = cloudChan chan,+ ttlChan = ttlChan chan,+ imageChan = imageChan chan,+ ratingChan = ratingChan chan,+ textInputChan = textInputChan chan,+ skipHoursChan = skipHoursChan chan,+ skipDaysChan = skipDaysChan chan,+ itemsChan = error "channel missing items (after copy)",+ infoChan = infoChan chan+ }++-- Channel value with default components.+--+defaultChannel :: Channel items+defaultChannel = Channel {+ titleChan = error "channel missing title",+ linkChan = error "channel missing link",+ descriptionChan = error "channel missing description",+ languageChan = Nothing,+ copyrightChan = Nothing,+ managingEditorChan = Nothing,+ webMasterChan = Nothing,+ pubDateChan = Nothing,+ lastBuildDateChan = Nothing,+ categoryChan = [],+ generatorChan = Nothing,+ docsChan = Nothing,+ cloudChan = (),+ ttlChan = Nothing,+ imageChan = Nothing,+ ratingChan = (),+ textInputChan = (),+ skipHoursChan = (),+ skipDaysChan = (),+ itemsChan = error "channel missing items",+ infoChan = error "channel missing info"+ }++-- Image value with default components.+--+defaultImage :: Image+defaultImage = Image {+ urlImage = error "image missing url",+ titleImage = error "image missing title",+ linkImage = error "image missing link",+ widthImage = Nothing,+ heightImage = Nothing,+ descriptionImage = Nothing+ }++-- Category value with default components..+--+defaultCategory :: Category+defaultCategory = Category {+ categoryCategory = error "category missing category",+ domainCategory = Nothing+ }++-- Items value with default components.+--+defaultItem :: Item+defaultItem = Item {+ titleItem = Nothing,+ linkItem = Nothing,+ descriptionItem = Nothing,+ authorItem = Nothing,+ categoryItem = [],+ commentsItem = Nothing,+ enclosureItem = Nothing,+ guidItem = Nothing,+ pubDateItem = Nothing,+ sourceItem = Nothing+ }++-- Enclosure value with default components..+--+defaultEnclosure :: Enclosure+defaultEnclosure = Enclosure {+ urlEnclosure = error "enclosure missing url",+ lengthEnclosure = error "enclosure missing length",+ typeEnclosure = error "enclosure missing type"+ }++-- GUID value with default components..+--+defaultGUID :: GUID+defaultGUID = GUID {+ guidGUID = error "guid missing guid",+ isPermaLinkGUID = Nothing+ }++-- GUID value with default components..+--+defaultSource :: Source+defaultSource = Source {+ sourceSource = error "source missing source",+ urlSource = error "source missing url"+ }
+ HTML.hs view
@@ -0,0 +1,133 @@+-- |A simple feed generator: HTML generator+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--+-- Docs ----------------------------------------------------------------------+--+-- Introduction to Text.Html: <http://www.cse.ogi.edu/~andy/html/intro.htm>+--++module HTML (+ channelToHTML+) where++-- hierachical libraries+import Control.Monad (+ mplus, liftM2)+import Data.Maybe (+ isJust)+import Text.Html++-- lambdaFeed+import Config (+ Config(..))+import Date (+ Date, addMinutes)+import Feed (+ URL, Channel(..), Image(..), Category(..), Item(..), Enclosure(..),+ GUID(..), Source(..))+++-- Render a channel to HTML.+--+channelToHTML :: Config -> Channel [Item] -> String+channelToHTML config chan = + renderHtml $+ header << concatHtml+ [ thetitle <<+ titleChan chan+ , primHtml "<link rel=\"stylesheet\" type=\"text/css\" \+ \href=\"channel.css\"/>"+ , meta ! [httpequiv "Content-Type", + content "text/html; charset=iso-8859-1"]+ -- FIXME: We should be able to parametrise the charset!!+ , languageChan chan `optional`+ \lang -> meta ! [httpequiv "Content-Language", content lang]+ , (liftM2 addMinutes (lastBuildDateChan chan) (ttlChan chan)) `optional` + \expiryDate -> meta ! [httpequiv "expires", + content (show expiryDate)]+ , generatorChan chan `optional` + \gen -> meta ! [name "generator", content gen]+ , copyrightChan chan `optional` + \cr -> meta ! [name "copyright", content cr]+ , (pubDateChan chan `mplus` lastBuildDateChan chan) `optional`+ \date -> meta ! [name "date", content (show date)]+ -- NB: `pubDate' takes preference+ ]+ +++ + body << concatHtml+ [ imageChan chan `optional` imageToHTML+ , h1 << titleChan chan+ , p << descriptionChan chan+ ]+ ++++ map itemToHTML (itemsChan chan)++-- Render an channel image element in HTML.+--+imageToHTML :: Image -> Html+imageToHTML img =+ anchor ! ([href (linkImage img)] ++ + descriptionImage img `optionalAttr` title) <<+ image ! ([ theclass "channel"+ , src (urlImage img)+ , alt (titleImage img)+ ] +++ ((widthImage img `mplus` Just 88) `optionalAttr` (width.show))+++ ((heightImage img `mplus` Just 31) `optionalAttr` height))+ -- defaults from RSS 2.0 spec++-- Render an item in HTML.+--+itemToHTML :: Item -> Html+itemToHTML item = + thediv ! [theclass "item"] << concatHtml+ [ titleItem item `optional`+ \title -> linkItem item `optionalHrefFor` (h2 << title)+ , descriptionItem item `optional` (p <<)+ , thediv ! [theclass "authorDate"] << concatHtml+ [ authorItem item `optional` toHtml+ , if isJust (authorItem item) && isJust (authorItem item)+ then bulletWithSpace else noHtml+ , pubDateItem item `optional` (toHtml . show)+ ]+ , thediv ! [theclass "commentsEnclosure"] << concatHtml+ [ enclosureItem item `optional` enclosureToHtml+ , if isJust (enclosureItem item) && + isJust (commentsItem item)+ then bulletWithSpace else noHtml+ , commentsItem item `optional`+ \commentsLink -> anchor ! [href commentsLink] << "Comments"+ ]+ ]+ where bulletWithSpace = spaceHtml +++ bullet +++ spaceHtml++-- Render an enclosure to HTML.+--+enclosureToHtml :: Enclosure -> Html+enclosureToHtml enc =+ anchor ! [href (urlEnclosure enc), thetype (typeEnclosure enc) ] << + "Enclosure"++-- Render an optional element.+--+optional :: Maybe a -> (a -> Html) -> Html+optional = flip (maybe noHtml)++-- Render an optional attribute.+--+optionalAttr :: Maybe a -> (a -> HtmlAttr) -> [HtmlAttr]+optionalAttr Nothing _ = []+optionalAttr (Just x) attr = [attr x]++-- An optional enclosing href.+--+optionalHrefFor :: Maybe String -> Html -> Html+optionalHrefFor Nothing inner = inner+optionalHrefFor (Just link) inner = anchor ! [href link] << inner
+ INSTALL view
@@ -0,0 +1,29 @@+Prerequisites+~~~~~~~~~~~~~+To compile this code, you need a Haskell compiler. If you have none, go to+<http://haskell.org/ghc/> to download and install one. (Alternatively, many+GNU/Linux distributions provide ready-to-install Haskell systems; eg, on Fedora+Core, `yum install ghc' will get the Glasgow Haskell Compiler from Fedora+Extras.)++lambdaFeed is written in Haskell 98; ie, it should work with any Haskell+system that supports the hierarchical libraries and on any operating system.+However, I have only tested it with the Glasgow Haskell Compiler (GHC) on+GNU/Linux. I'd appreciate any comments or patches concerning use with other+Haskell systems and operating systems.++Compilation and Installation+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+lambdaFeed uses a Cabal-based <http://haskell.org/cabal/> build system; i.e,+use the following sequence of commands to compile and install sources obtained+from the darcs repository:++ % chmod a+x Setup.hs VersionTool.hs runLambdaFeed.hs+ % ./VersionTool.hs Config.hs+ % ./Setup.hs configure --prefix=INSTALL-DIRECTORY+ % ./Setup.hs build+ % ./Setup.hs install++Alternatively, you can simply invoke `runLambdaFeed.hs' inplace - after adding+execute permissions and running `VersionTool.hs' as above. (This will use +interpreted, rather than compiled code, and hence be significantly slower.)
+ LambdaFeed.hs view
@@ -0,0 +1,727 @@+-- |A simple feed generator+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--+-- Feed source+-- ~~~~~~~~~~~+-- The feed source is a directory containing channel descriptors, which are+-- files with suffix `.lfc'. Each channel descriptor specifies a channel+-- directory, which contains the feed for the channel. These items are+-- individual files in those sub-directories with the suffix `.lfi'.+--+-- Timestamps+-- ~~~~~~~~~~+-- We require all channel items to include a timestamp (aka publication+-- date). If an item doesn't contain an explicit `pubDate' field, the last+-- modification date of the file containing the item is added as a+-- `pubDate'. This holds only for channel items, not for channel+-- descriptions.+--+-- Text files in stanza format+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- This is the format used for channel descriptors and channel items. A+-- stanza file is comprised of a list of stanzas which a separated by one or+-- more empty lines (ie, lines containing nothing but white space). Each+-- such stanza is an association list of tags and values. Tags start in the+-- leftmost column and are terminated by a colon or the end of line. There+-- can be no white space within a tag, but there can be trailing white space,+-- which is discarded. The value associated with a tag is the string+-- following the tag-terminating colon. Such a value string extends to the+-- start of the next tag or end of the current stanza, whichever comes first.+-- Hence, value strings can span multiple lines, but any line after the+-- initial one, ie the one containing the tag, must have white space in the+-- leftmost column. If a tag is terminated by the end of line, instead of a+-- colon, its associated value string is empty.+--+-- A line starting with `--' is a comment line, and hence, ignored,+--+-- Channel descriptors and channel items+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The tags used in channel descriptors and channel items are the same as+-- those in the RSS 2.0 specification, but we permit arbitrary use of upper+-- and lowercase letters and have the following special cases:+--+-- `lastBuildDate': ignored, as it is added by lambdaFeed+-- `generator' : ignored, as it is added by lambdaFeed+-- `pubDate' : using file modification time if absent (only for items)+-- `cloud' : not implemented yet+-- `rating' : not implemented yet+-- `textInput' : not implemented yet+-- `skipHours' : not implemented yet+-- `skipDays' : not implemented yet+--+-- Elements that have attributes need to be in a stanza of their own. The+-- element tag must be the tag of the first line of the stanze. All other+-- lines must be attribute tags of that element.+--+-- Moreover, we have an extra tag in channel descriptors:+--+-- `items' : required element giving the filename of a directory with+-- the channel's items+--+-- Docs+-- ~~~~+-- RSS 2.0 spec: <http://www.rssboard.org/rss-specification>+--+--- Todo ----------------------------------------------------------------------+--+-- * Options to truncate news streams during formatting: (1) Maximal number+-- of items rendered, (2) cut off date for rendering, and (3) maximum age+-- of items to render. We should be able to specify this either for the+-- XML and HTML output together or for both separately (as with output+-- directory). This could also be realised by synthetic channels being able+-- to specify such criteria.+--+-- * More elaborate channel formatting and/or synthetic channels: Channels+-- that don't have an item directory, but instead instructions on how to+-- synthesise them from other channels by eg, merging and filtering.+--+-- * Should also have a CGI script mode, where it dumps either the XML or+-- HTML to stdout. (Could also do that via a shell script, but Haskell may+-- be more portable. However, CGI "scripts" could be separate, small+-- Haskell programs.)+--+-- * Support cloud specification.+--+-- * Don't regenerate a channel if neither its description nor items changed+-- and/or some caching.+--+-- * Validate the format of some fields; eg, URLs should really look like+-- URLs, same for email addresses, but only warnings in case of errors.+--+-- * Read channels in RSS format (probably with HaXml). They'd just be .xml+-- files in the feed directory.+--+-- * Use plugins to do the reading and writing of various formats and for+-- formatting the feed. Also for configuration as in Yi.+--+-- * It might be nice to generate atom feeds, too. There are good reasons to+-- prefer Atom <http://www.tbray.org/atom/RSS-and-Atom>. It seems that a+-- good compromise is requiring input to be Atom-ish, but to be able to+-- render feeds in either format.+--++module LambdaFeed (main)+where++-- hierachical libraries+--++import Control.Monad (+ liftM, mplus)++import Data.Char (+ isDigit, toLower)+import Data.List (+ sortBy)+import Data.Maybe (+ isNothing, fromJust)++import Numeric (+ showFFloat)++import System.CPUTime (+ getCPUTime)+import System.Directory (+ getDirectoryContents)+import System.IO (+ stderr)+import System.Time (+ ClockTime, getClockTime)++-- lambdaFeed+import Config (+ version, + chanSuffix, itemSuffix, htmlSuffix, rssSuffix,+ Config(..), processArgs)+import Date (+ Date(..), parseDate)+import Error (+ elementErrStr, abortWith, abortWithIO, exitSuccess)+import Feed (+ URL, Feed(..), Channel(..), Image(..), Category(..), Item(..),+ Enclosure(..), GUID(..), Source(..), Info(..),+ copyChannelInfo, defaultChannel, defaultImage, defaultCategory, defaultItem,+ defaultEnclosure, defaultGUID, defaultSource)+import HTML (+ channelToHTML)+import RSS (+ channelToRSS)+import Stanza (+ Stanza, StanzaAssoc, readStanzas,+ StanzaProcessor, Proc(..), Action(..), parseStanzas)+++-- Feed processing+-- ---------------++-- Summary information+--+data Summary = Summary {+ -- number of items for each cannel+ channelItemsSummary :: [Int]+ }++-- Read all feed data into our internal feed structure.+--+readFeed :: Config -> IO (Feed [Item])+readFeed config =+ do+ let feedDir = feedDirCfg config+ sayV config $ "Getting channels from feed directory `" ++ feedDir ++ "'"+ --+ fnames <- getDirectoryContents feedDir+ let chanFNames = [ feedDir </> fname + | fname <- fnames, suffix fname == chanSuffix]+ --+ sayV config $ "Reading " ++ show (length chanFNames) ++ " channel(s)"+ --+ chanDescs <- mapM (readChanDesc config) chanFNames+ --+ sayD config 1 $ show chanDescs+ --+ liftM Feed $ mapM (readChan config) chanDescs++-- Read a channel description from the file of the given name and modify its+-- build date to be the current time.+--+-- * We interpret the `itemsChan' file path relative to path from which we+-- read the channel description (unless it is already absolute).+--+readChanDesc :: Config -> FilePath -> IO (Channel FilePath)+readChanDesc config fname = + do+ text <- readStanzas fname+ let (chan, errs) = parseChanDesc fname text+ mapM (say config) errs+ currTime <- getClockTime+ return $ chan {+ generatorChan = Just version,+ lastBuildDateChan = Just $ Date currTime,+ itemsChan = dirname fname </> itemsChan chan,+ -- adjust path to item files+ infoChan = Info {+ fnameInfo = (stripSuffix . basename) fname+ },+ docsChan = docsChan chan `mplus` Just specUrl+ }+ where+ specUrl = "http://www.rssboard.org/rss-specification"++-- Read the items from the items directrory specified by the channel into the+-- channel data structure.+--+readChan :: Config -> Channel FilePath -> IO (Channel [Item])+readChan config chan =+ do+ let itemsDir = itemsChan chan+ sayV config $ "Getting items for " ++ titleChan chan ++ " from `" ++ + itemsDir ++ "'"+ --+ fnames <- getDirectoryContents itemsDir+ let itemFNames = [ itemsDir </> fname + | fname <- fnames, suffix fname == itemSuffix]+ --+ sayV config $ "Reading " ++ show (length itemFNames) ++ " items(s)"+ --+ items <- mapM (readItem config) itemFNames+ --+ sayD config 2 $ show items+ --+ return $ (copyChannelInfo chan) {itemsChan = items}++-- Read an item from the file of the given name.+--+readItem :: Config -> FilePath -> IO Item+readItem config fname = + do+ text <- readStanzas fname+ let (item, errs) = parseItem fname text+ mapM (say config) errs+ pubDate <- case pubDateItem item of+ Just pubDate -> return pubDate+ Nothing -> do+ currTime <- liftM Date $ getClockTime+ appendFile fname $ "\n\nPubDate: " ++ show currTime ++ "\n"+ return currTime+ return $ item {pubDateItem = Just pubDate}++-- Generate the requested feed representation.+--+formatFeed :: Config -> Feed [Item] -> IO (Feed [Item])+formatFeed config (Feed chans) =+ liftM Feed $ mapM (formatChan config) chans++formatChan :: Config -> Channel [Item] -> IO (Channel [Item])+formatChan config chan = + do+ sayV config $ "Sorting channel `" ++ titleChan chan ++ "'"+ return $ chan {itemsChan = take (maxItemsOpt config)+ . sortBy newer+ $ itemsChan chan}+ where+ item1 `newer` item2 = + case pubDateItem item1 `compare` pubDateItem item2 of+ LT -> GT+ EQ -> EQ+ GT -> LT++-- Write feed data to HTML and RSS files.+--+writeFeed :: Config -> Feed [Item] -> IO Summary+writeFeed config (Feed chans) =+ do+ mapM generateHTML chans+ mapM generateRSS chans+ return $ Summary {channelItemsSummary = map (length . itemsChan) chans}+ where+ generateHTML chan =+ do+ let fname = htmlDirCfg config </> (fnameInfo . infoChan) chan <.>+ htmlSuffix+ sayV config $ "Writing HTML for channel `" ++ titleChan chan +++ "' to `" ++ fname ++ "'"+ writeFile fname (channelToHTML config chan)+ generateRSS chan =+ do+ let fname = rssDirCfg config </> (fnameInfo . infoChan) chan <.>+ rssSuffix+ sayV config $ "Writing RSS for channel `" ++ titleChan chan +++ "' to `" ++ fname ++ "'"+ writeFile fname (channelToRSS config chan)+++-- Print summary of feed data.+--+printSummary :: Config -> Summary -> IO ()+printSummary config summary = + do+ pico <- getCPUTime+ let noChannels = length (channelItemsSummary summary)+ noItems = sum (channelItemsSummary summary)+ secs = fromInteger (pico `div` 1000000000) / 1000 :: Float+ sayV config $ "Processed " ++ show noItems ++ " item(s) in " +++ show noChannels ++ " channel(s) in " ++ + showFFloat (Just 3) secs "s."+++-- Stanza parsing+-- --------------++-- Parse a channel description, returning our internal channel representation+-- in the flavour that the name of the directory containing the channel's+-- items.+--+-- * The first argument is to identify the source in error messages.+--+-- * Missing tags in a channel description lead to a fatal error (i.e., no+-- channel description is returned, only some errors). Otherwise, errors+-- are not fatal (parsing will still have produced a valid channel+-- descriptor, although may be not exactly what the user intended).+--+parseChanDesc :: String -> [Stanza] -> (Channel FilePath, [String])+parseChanDesc sname stanzas = + case parseStanzas chanDescProc sname stanzas defaultChannel of+ (Nothing , errs) -> abortWith errs+ (Just chan, errs) -> (chan, errs)+ where+ chanDescProc = + -- required elements+ [ ("title", Proc True $ Simple $+ cantFail $ \v c -> c {titleChan = v}+ )+ , ("link", Proc True $ Simple $+ cantFail $ \v c -> c {linkChan = v}+ )+ , ("description", Proc True $ Simple $+ cantFail $ \v c -> c {descriptionChan = v}+ )+ , ("items", Proc True $ Simple $+ cantFail $ \v c -> c {itemsChan = v}+ )+ -- optional elements+ , ("language", Proc False $ Simple $+ cantFail $ \v c -> c {languageChan = Just v}+ )+ , ("copyright", Proc False $ Simple $+ cantFail $ \v c -> c {copyrightChan = Just v}+ )+ , ("managingeditor", Proc False $ Simple $+ cantFail $ \v c -> c {managingEditorChan = Just v}+ )+ , ("webmaster", Proc False $ Simple $+ cantFail $ \v c -> c {webMasterChan = Just v}+ )+ , ("pubdate", Proc False $ Simple $+ mayFail parseDate "bad date format (see RSS 2.0 spec)" $ + \v c -> c {pubDateChan = Just v}+ )+ , ("lastbuilddate", Proc False $ Simple $+ mayFail parseDate "bad date format (see RSS 2.0 spec)" $ + \v c -> c {lastBuildDateChan = Just v}+ )+ , ("category", Proc False $ Compound $+ cantFailStanza parseCategory $ + \v c -> c {categoryChan = categoryChan c ++ [v]}+ )+ , ("generator", Proc False $ Simple $+ cantFail $ \v c -> c {generatorChan = Just v}+ )+ , ("docs", Proc False $ Simple $+ cantFail $ \v c -> c {docsChan = Just v}+ )+ , ("cloud", Proc False $ Simple $+ cantFail $ \v c -> c {cloudChan = ()} -- ignore+ )+ , ("ttl", Proc False $ Simple $+ mayFail parseNat "positive integer expected" $ + \v c -> c {ttlChan = Just v}+ )+ , ("image", Proc False $ Compound $+ mayFailStanza parseImage $ \v c -> c {imageChan = v}+ )+ , ("rating", Proc False $ Simple $+ cantFail $ \v c -> c {ratingChan = ()} -- ignore+ )+ , ("textinput", Proc False $ Simple $+ cantFail $ \v c -> c {textInputChan = ()} -- ignore+ )+ , ("skiphours", Proc False $ Simple $+ cantFail $ \v c -> c {skipDaysChan = ()} -- ignore+ )+ , ("skipdays", Proc False $ Simple $+ cantFail $ \v c -> c {skipDaysChan = ()} -- ignore+ )+ ]+ --+ mayFail = mayFailS sname+ mayFailStanza = mayFailStanzaS sname++-- Parse an image element.+--+parseImage :: String -> Stanza -> (Maybe Image, [String])+parseImage sname stanza@((_, (start, end), _):_) =+ parseStanzas imageProc extendedSName [stanza] defaultImage+ where+ imageProc = + -- required elements+ [ ("image", Proc True $ Simple $+ mayFail parseNull "image tag can have no value" $ + \v i -> i -- image tag itself has no data+ )+ , ("url", Proc True $ Simple $+ cantFail $ \v i -> i {urlImage = v}+ )+ , ("title", Proc True $ Simple $+ cantFail $ \v i -> i {titleImage = v}+ )+ , ("link", Proc True $ Simple $+ cantFail $ \v i -> i {linkImage = v}+ )+ -- optional elements+ , ("width", Proc False $ Simple $+ mayFail parseNat "positive integer expected" $ + \v c -> c {widthImage = Just v}+ )+ , ("height", Proc False $ Simple $+ mayFail parseNat "positive integer expected" $ + \v c -> c {heightImage = Just v}+ )+ , ("description", Proc False $ Simple $+ cantFail $ \v i -> i {descriptionImage = Just v}+ )+ ]+ --+ mayFail = mayFailS sname+ --+ extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": image"++-- Parse a category element (can't fail)+--+parseCategory :: Stanza -> Category+parseCategory stanza = + (fromJust . fst) (parseStanzas categoryProc "" [stanza] defaultCategory)+ where+ categoryProc = + -- required elements+ [ ("category", Proc True $ Simple $+ cantFail $ \v i -> i {categoryCategory = v}+ )+ -- optional elements+ , ("domain", Proc False $ Simple $+ cantFail $ \v i -> i {domainCategory = Just v}+ )+ ]++-- Parse an item, returning our internal item representation.+--+-- * The first argument is to identify the source in error messages.+--+-- * It's a fatal error if there is neither a title nor a description.+-- Otherwise, errors are not fatal (parsing will still have produced a valid+-- channel descriptor, although may be not exactly what the user intended).+--+parseItem :: String -> [Stanza] -> (Item, [String])+parseItem sname stanzas = + case parseStanzas itemProc sname stanzas defaultItem of+ (Nothing , errs) -> error "parseItem: Impossible" -- no required items+ (Just item, errs) + | isNothing (titleItem item) && isNothing (descriptionItem item) ->+ abortWith [sname ++ ": an item must have a title or description"]+ | otherwise -> (item, errs)+ where+ itemProc = + -- optional elements+ [ ("title", Proc False $ Simple $+ cantFail $ \v c -> c {titleItem = Just v}+ )+ , ("link", Proc False $ Simple $+ cantFail $ \v c -> c {linkItem = Just v}+ )+ , ("description", Proc False $ Simple $+ cantFail $ \v c -> c {descriptionItem = Just v}+ )+ , ("author", Proc False $ Simple $+ cantFail $ \v c -> c {authorItem = Just v}+ )+ , ("category", Proc False $ Compound $+ cantFailStanza parseCategory $ + \v c -> c {categoryItem = categoryItem c ++ [v]}+ )+ , ("comments", Proc False $ Simple $+ cantFail $ \v c -> c {commentsItem = Just v}+ )+ , ("enclosure", Proc False $ Compound $+ mayFailStanza parseEnclosure $ \v c -> c {enclosureItem = v}+ )+ , ("guid", Proc False $ Compound $+ mayFailStanza parseGUID $ \v c -> c {guidItem = v}+ )+ , ("pubdate", Proc False $ Simple $+ mayFail parseDate "bad date format (see RSS 2.0 spec)" $ + \v c -> c {pubDateItem = Just v}+ )+ , ("source", Proc False $ Compound $+ mayFailStanza parseSource $ \v c -> c {sourceItem = v}+ )+ ]+ --+ mayFail = mayFailS sname+ mayFailStanza = mayFailStanzaS sname++-- Parse an enclosure element.+--+parseEnclosure :: String -> Stanza -> (Maybe Enclosure, [String])+parseEnclosure sname stanza@((_, (start, end), _):_) =+ parseStanzas enclosureProc extendedSName [stanza] defaultEnclosure+ where+ enclosureProc = + -- required elements+ [ ("enclosure", Proc True $ Simple $+ mayFail parseNull "enclosure tag can have no value" $ + \v i -> i -- enclosure tag itself has no data+ )+ , ("url", Proc True $ Simple $+ cantFail $ \v i -> i {urlEnclosure = v}+ )+ , ("length", Proc True $ Simple $+ mayFail parseNat "positive integer expected" $ + \v i -> i {lengthEnclosure = v}+ )+ , ("type", Proc True $ Simple $+ cantFail $ \v i -> i {typeEnclosure = v}+ )+ ]+ --+ mayFail = mayFailS sname+ --+ extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": enclosure"++-- Parse a guid element.+--+parseGUID :: String -> Stanza -> (Maybe GUID, [String])+parseGUID sname stanza@((_, (start, end), _):_) =+ parseStanzas guidProc extendedSName [stanza] defaultGUID+ where+ guidProc = + -- required elements+ [ ("guid", Proc True $ Simple $+ cantFail $ \v i -> i {guidGUID = v}+ )+ -- optional elements+ , ("ispermalink", Proc False $ Simple $+ mayFail parseBool "true or false expected" $ + \v i -> i {isPermaLinkGUID = Just v}+ )+ ]+ --+ mayFail = mayFailS sname+ --+ extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": guid"++-- Parse a source element.+--+parseSource :: String -> Stanza -> (Maybe Source, [String])+parseSource sname stanza@((_, (start, end), _):_) =+ parseStanzas sourceProc extendedSName [stanza] defaultSource+ where+ sourceProc = + -- required elements+ [ ("source", Proc True $ Simple $+ cantFail $ \v i -> i {sourceSource = v}+ )+ , ("url", Proc True $ Simple $+ cantFail $ \v i -> i {urlSource = v}+ )+ ]+ --+ extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": source"++-- Parse an integer value.+--+parseNat :: String -> Maybe Int+parseNat str | all isDigit str = Just $ read str+ | otherwise = Nothing++-- Parse a Boolean.+--+parseBool :: String -> Maybe Bool+parseBool str | strLower == "true" = Just True+ | strLower == "false" = Just False+ | otherwise = Nothing+ where strLower = map toLower str++-- Parser that simply asserts that it is being passed an empty string.+--+parseNull :: String -> Maybe ()+parseNull s | null s = Just ()+ | otherwise = Nothing++-- Simple action without any special parsing.+--+cantFail :: (String -> r -> r) -- record updater+ -> (StanzaAssoc -> r -> (r, [String]))+cantFail upd = \(_, _, v) c -> (upd v c, [])++-- Compound action without any special parsing.+--+cantFailStanza :: (Stanza -> a) -- stanza parser+ -> (a -> r -> r) -- record updater+ -> (Stanza -> r -> (r, [String]))+cantFailStanza parse upd = \stanza rec -> (upd (parse stanza) rec, [])++-- Action with parsing that may fail.+--+mayFailS :: String -- source name+ -> (String -> Maybe a) -- value parser+ -> String -- error message+ -> (a -> r -> r) -- record updater+ -> (StanzaAssoc -> r -> (r, [String]))+mayFailS sname parse err upd = \(_, range, v) rec -> + case parse v of+ Just x -> (upd x rec, [])+ Nothing -> (rec , [elementErrStr sname range err])++-- Action with parsing that may fail.+--+mayFailStanzaS :: String -- source name+ -> (String -> Stanza -> (a, [String])) -- stanza parser+ -> (a -> r -> r) -- record updater+ -> (Stanza -> r -> (r, [String]))+mayFailStanzaS sname parse upd = \stanza rec -> + let (v, errs) = parse sname stanza + in+ (upd v rec, errs)+++-- Filename operations (this stuff won't work on win32)+-- -------------------++-- Project the suffix from a filename.+--+suffix :: FilePath -> String+suffix = reverse . takeWhile (/= '.') . reverse++-- Remove the suffix from a filename.+--+stripSuffix :: FilePath -> String+stripSuffix fname | null fname' = fname+ | otherwise = reverse (tail fname')+ where+ fname' = dropWhile (/= '.') . reverse $ fname++-- Drop the directory of a path.+--+basename :: FilePath -> String+basename fname | null fname' = fname+ | otherwise = fname'+ where+ fname' = reverse . takeWhile (/= '/') . reverse $ fname++-- Drop the file name of a path.+--+dirname :: FilePath -> String+dirname = reverse . dropWhile (/= '/') . reverse++-- Join a directory and file path. If the file path is already absolute,+-- ignore the directory argument.+--+(</>) :: FilePath -> FilePath -> FilePath+"" </> fname = fname+dir </> "" = dir+dir </> fname | head fname == '/' = fname+ | last dir == '/' = dir ++ fname+ | otherwise = dir ++ "/" ++ fname++-- Join a suffix to a file name.+--+(<.>) :: FilePath -> String -> FilePath+fname <.> "" = fname+fname <.> suffix = fname ++ "." ++ suffix+++-- Logging+-- -------++-- Warnings if not quiet.+--+say :: Config -> String -> IO ()+say config str | not (quietCfg config) = putStrLn str+ | otherwise = return ()++-- Information messages if in verbose mode.+--+sayV :: Config -> String -> IO ()+sayV config str | verboseCfg config = putStrLn str+ | otherwise = return ()++-- Diagnostic messages if in debug mode.+--+sayD :: Config -> Int -> String -> IO ()+sayD config lvl str | debugCfg config >= lvl = putStrLn str+ | otherwise = return ()+++-- Main+-- ----++main :: IO ()+main =+ do+ config <- processArgs+ ( readFeed config + >>= formatFeed config + >>= writeFeed config + >>= printSummary config)+ `catch` \e -> abortWithIO [show e]+ exitSuccess
+ LambdaFeedMain.hs view
@@ -0,0 +1,14 @@+-- |A simple feed generator: Main module for compiling lambdaFeed+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98++module Main (main)+where++import LambdaFeed (main)
+ Makefile view
@@ -0,0 +1,10 @@+# A simple feed generator: make system+#+# Copyright (c) 2006 Manuel M T Chakravarty+#+# License: <http://www.gnu.org/licenses/gpl.html>+#++default:+ @echo "*** lambdaFeed uses a Cabal-based build system <http://haskell.org/cabal/>."+ @echo "*** See the file INSTALL for details."
+ README view
@@ -0,0 +1,18 @@+ lambdaFeed -*-text-*-+ ~~~~~~~~~~++lambdaFeed is an RSS 2.0 feed generator. It reads news items - in a non-XML,+human-friendly format - distributed over multiple channels and renders them+into the RSS 2.0 XML format understood by most news aggregators as well as+into HTML for inclusion into web pages. The project web site is at++ http://www.cse.unsw.edu.au/~chak/lambdaFeed/++lambdaFeed is free software. You can use, modify, and re-distribute it under+the terms of the GPL v2 or later, but NO WARRANTY WHATSOEVER IS PROVIDED.+Please see the file COPYING for legal details and the file AUTHORS for the+origin of this software.++Please refer to the file INSTALL for installation instructions.++-= Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+ RSS.hs view
@@ -0,0 +1,195 @@+-- |A simple feed generator: RSS 2.0 generator+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module RSS (+ channelToRSS+) where++-- standard libraries+--+import Data.Char (+ toLower)+import Data.Maybe (+ maybe, catMaybes, maybeToList)+import Text.PrettyPrint++-- lambdaFeed+import Config (Config(..))+import Feed (+ URL, Channel(..), Image(..), Category(..), Item(..), Enclosure(..),+ GUID(..), Source(..))++infixr 0 $?+infix 4 =!+++-- Render a channel to RSS.+--+channelToRSS :: Config -> Channel [Item] -> String+channelToRSS config chan = renderXML $+ RecXML "rss" ["version" =! "2.0"]+ [ RecXML "channel" [] $+ [ TextXML "title" [] $ titleChan chan+ , TextXML "link" [] $ linkChan chan+ , TextXML "description" [] $ descriptionChan chan+ ] ++ catMaybes+ [ TextXML "language" [] $? languageChan chan+ , TextXML "copyright" [] $? copyrightChan chan+ , TextXML "managingEditor" [] $? managingEditorChan chan+ , TextXML "webMaster" [] $? webMasterChan chan+ , TextXML "pubDate" [] . show $? pubDateChan chan+ , TextXML "lastBuildDate" [] . show $? lastBuildDateChan chan+ ] ++ + categoryToRSS $* categoryChan chan+ ++ catMaybes+ [ TextXML "generator" [] $? generatorChan chan+ , TextXML "docs" [] $? docsChan chan+ , TextXML "ttl" [] . show $? ttlChan chan+ , imageToRSS $? imageChan chan+ ] +++ map itemToRSS (itemsChan chan)+ ]++-- Render a category to RSS.+--+categoryToRSS :: Category -> XML+categoryToRSS category =+ TextXML "category" (maybeToList ("domain" =? domainCategory category)) $+ categoryCategory category++-- Render an image to RSS.+--+imageToRSS :: Image -> XML+imageToRSS image =+ EmptyXML "image" $+ [ "url" =! urlImage image+ , "title" =! titleImage image+ , "link" =! linkImage image+ ] ++ catMaybes+ [ "width" =? (show $? widthImage image)+ , "height" =? (show $? heightImage image)+ , "description" =? descriptionImage image+ ]++-- Render an item to RSS.+--+itemToRSS :: Item -> XML+itemToRSS item =+ RecXML "item" [] $ catMaybes+ [ TextXML "title" [] $? titleItem item+ , TextXML "link" [] $? linkItem item+ , TextXML "description" [] $? descriptionItem item+ , TextXML "author" [] $? authorItem item+ ] +++ categoryToRSS $* categoryItem item+ ++ catMaybes+ [ TextXML "comments" [] $? commentsItem item+ , enclosureToRSS $? enclosureItem item+ , guidToRSS $? guidItem item+ , TextXML "pubDate" [] . show $? pubDateItem item+ , sourceToRSS $? sourceItem item+ ]++-- Render an enclosure to RSS.+--+enclosureToRSS :: Enclosure -> XML+enclosureToRSS enclosure =+ EmptyXML "enclosure"+ [ "url" =! urlEnclosure enclosure+ , "length" =! (show . lengthEnclosure $ enclosure)+ , "type" =! typeEnclosure enclosure+ ]++-- Render a GUID to RSS.+--+guidToRSS :: GUID -> XML+guidToRSS guid =+ TextXML "guid" + (maybeToList ("isPermaLink" =? (showBool $? isPermaLinkGUID guid))) $+ guidGUID guid+ where+ showBool = map toLower . show++-- Render a source specification to RSS.+--+sourceToRSS :: Source -> XML+sourceToRSS source =+ TextXML "source" ["url" =! urlSource source ] $+ sourceSource source++-- Attribute construction.+--+(=!) :: String -> String -> AttrXML+name =! value = (name, value)++-- Optional attribute construction.+--+(=?) :: String -> Maybe String -> Maybe AttrXML+name =? value = (name =!) $? value++-- Map+--+($*) :: (a -> b) -> [a] -> [b]+($*) = fmap++-- Optional application.+--+($?) :: (a -> b) -> Maybe a -> Maybe b+($?) = fmap+++-- Poor Man's XML Rendering+-- ------------------------++-- An XML tree consisting of empty and non-empty tags.+--+data XML = EmptyXML String [AttrXML]+ | TextXML String [AttrXML] String+ | RecXML String [AttrXML] [XML]++-- XML attributes are associations.+--+type AttrXML = (String, String)++-- Render an XML tree.+--+renderXML :: XML -> String+renderXML xml = render $+ text "<?xml version=\"1.0\"?>"+ $+$+ renderTag xml+ where+ renderTag (EmptyXML name attrs ) = + renderStartTag name attrs (text "/>")+ renderTag (TextXML name attrs txt ) = cat+ [ renderStartTag name attrs (char '>')+ , nest 4 (text txt)+ , renderEndTag name+ ]+ renderTag (RecXML name attrs xmls) =+ renderStartTag name attrs (char '>')+ $+$+ nest 4 (vcat . map renderTag $ xmls)+ $+$+ renderEndTag name+ --+ renderStartTag name attrs terminator = cat+ [ sep + [ char '<' <> text name+ , nest 2 (sep $ map renderAttr attrs)+ ]+ , terminator+ ]+ --+ renderEndTag name = text "</" <> text name <> char '>'+ --+ renderAttr (name, value) = + text name <> char '=' <> doubleQuotes (text value)
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ Stanza.hs view
@@ -0,0 +1,231 @@+-- |A simple feed generator: Stanza reading and parsing+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: <http://www.gnu.org/licenses/gpl.html>+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--++module Stanza (++ -- * Stanza structure+ Stanza, StanzaAssoc,++ -- * Stanza reading+ readStanzas,++ -- * Stanza processors+ StanzaProcessor, Proc(..), Action(..),++ -- * Stanza parsing+ parseStanzas++) where++-- hierachical libraries+--+import Data.Char (+ isDigit, isSpace, toLower)+import Data.List (+ (\\))++-- lambdaFeed+import Error (+ elementErrStr)+++-- Stanze file parsing+-- -------------------++-- A stanza is a list of associations, where each association comprises+--+-- (1) a tag string (without the terminating colon of the textual+-- representation),+-- (2) a range of source file lines (containing the association in the textual+-- representation), and+-- (3) a value string.+--+type Stanza = [StanzaAssoc]+type StanzaAssoc = (String, (Int, Int), String)++-- Read a text file in stanza format (including line numbers for better error+-- messages).+--+-- * See top of file for details of the format.+--+readStanzas :: FilePath -> IO [Stanza]+readStanzas fname =+ do+ contents <- readFile fname+ let numbered = zip [1..] (filter notComment . lines $ contents)+ stanzas = splitIntoStanzas numbered+ return $ map splitIntoAssocs stanzas+ where+ splitIntoStanzas [] = []+ splitIntoStanzas lines = + let+ lines0 = dropWhile isEmptyLine lines+ (stanza, lines') = break isEmptyLine lines0+ stanzas = splitIntoStanzas lines'+ in+ stanza:stanzas+ --+ splitIntoAssocs [] = []+ splitIntoAssocs ((start, line):lines) =+ let+ (values, lines') = break isTagLine lines+ assocs = splitIntoAssocs lines'+ --+ (tag, value1) = break (== ':') line+ allValues = stripColonNClean value1 : map (clean . snd) values+ --+ end | null values = start+ | otherwise = (fst . last) values+ in+ case extractTag tag of+ Just rawTag -> + (rawTag, (start, end), unwords' allValues):assocs+ Nothing -> malformedTagErr fname start tag+ --+ extractTag "" = Nothing+ extractTag tag | isSpace (head tag) = Nothing+ | any isSpace cleanedTag = Nothing+ | otherwise = Just cleanedTag+ where cleanedTag = cleanTrailing tag+ --+ notComment ('-':'-':_) = False+ notComment _ = True+ --+ stripColonNClean (':':str) = clean str -- strip leading colon & clean w/s+ stripColonNClean str = clean str+ --+ isEmptyLine = all isSpace . snd+ isTagLine = not . isSpace . (!!0) . snd+ --+ unwords' = dropWhile isSpace . unwords++-- Complain about a malformed tag and abort+--+malformedTagErr :: FilePath -> Int -> String -> a+malformedTagErr fname line tag =+ error $ fname ++ ":" ++ show line ++ ": `" ++ cleanTrailing tag ++ + "' is not a valid tag"++-- Lose leading and trailing whitespace+--+clean :: String -> String+clean = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- Lose trailing whitespace+--+cleanTrailing :: String -> String+cleanTrailing = reverse . dropWhile isSpace . reverse+++-- Stanza processing+-- -----------------++-- Association of tag names with functions that add the associated value to+-- some structure `a' (and may also return a list of error messages).+--+-- * We ignore case when comparing tag names.+--+type StanzaProcessor a = [(String, Proc a)]++-- Determines whether the associated tag is required.+--+data Proc a = Proc Bool (Action a)++-- The actual processing functions come in two flavours:+--+-- * Simple processors consume one stanza association.+--+-- * Compound processors consume an entire stanza, where the first entry of+-- the stanza is the one that triggered the processor and the others are+-- attributes to that element. If they occur within a stanza, they get+-- passed a singelton stanza with the one association.+--+data Action a = Simple (StanzaAssoc -> (a -> (a, [String])))+ | Compound (Stanza -> (a -> (a, [String])))++-- Apply a stanza processor to a stanza list.+--+-- * The second argument indicates the source of the stanza list and is used+-- in error messages.+--+-- * If required tags are missing, we inject an the error message into the+-- errors produced by the transformer. As this error is fatal in some+-- context, we indicate the error also by producing a transformer that+-- returns constant `Nothing' in its first component.+--+parseStanzas :: StanzaProcessor a -- stanza processor for parsing+ -> String -- name of stanza source+ -> [Stanza] -- stanzas to parse+ -> (a -> (Maybe a, [String]))+--+-- The following is a two step process:+--+-- (1) The stanza processor computes from the input stanza a *function* that+-- when applied to a value of type `a' (usually a record) adds the+-- information from the stanza to that value.+-- (2) We apply the function from Step (1) to a value of type `a' (usually a+-- record with default values in all components) to get the final result+-- of parsing.+--+parseStanzas stanzaProc sname stanzas = \rec ->+ let + (transformer, req) = processStanzas required stanzas+ (results, errs) = transformer rec+ in+ if null req+ then -- a required tags were found+ (Just results, errs)+ else -- some required tags were missing => no result+ (Nothing, [sname ++ ": required tags missing: " ++ show req,+ sname ++ ": invalidates the whole element" ] ++ errs)+ where+ required = [tag | (tag, Proc reqd _) <- stanzaProc, reqd]+ --+ --processStanzas :: [String] -> [Stanza] -> (a -> (a, [String]), [String])+ processStanzas reqd [] = (idNil, reqd)+ processStanzas reqd ([] :stanzas) =+ processStanzas reqd stanzas+ processStanzas reqd (stanza@((tag, range, _):_):stanzas) =+ let+ (trans1, reqd1) = + case lookup (map toLower tag) stanzaProc of+ Just (Proc _ (Simple _ )) -> processAssocs reqd stanza+ Just (Proc _ (Compound act)) -> (act stanza, reqd \| tag)+ Nothing -> (addError (unknownTag range tag), + reqd)+ (trans2, reqd2) = processStanzas reqd1 stanzas+ in+ (trans2 .++ trans1, reqd2)+ -- + --processAssocs :: [String] -> Stanza -> (a -> (a, [String]), [String])+ processAssocs reqd [] = (idNil, reqd)+ processAssocs reqd (assoc@(tag, range, _):assocs) =+ let+ (trans1, reqd1) =+ case lookup (map toLower tag) stanzaProc of+ Just (Proc _ (Simple act)) -> (act assoc , reqd \| tag)+ Just (Proc _ (Compound act)) -> (act [assoc], reqd \| tag)+ Nothing -> (addError (unknownTag range tag), + reqd)+ (trans2, reqd2) = processAssocs reqd1 assocs+ in+ (trans2 .++ trans1, reqd2)+ --+ idNil = \a -> (a, [])+ f1 .++ f2 = \a -> + let (a1, e1) = f1 a; (a2, e2) = f2 a1 in (a2, e1 ++ e2) + --+ l \| tag = l \\ [map toLower tag]+ --+ addError err = \a -> (a, [err])+ --+ unknownTag range tag = elementErrStr sname range $ + "unknown tag `" ++ tag ++ "' (ignoring)"
+ VersionTool.hs view
@@ -0,0 +1,267 @@+#!/bin/env runhaskell ++-- |Tool to insert version information into darcs-controlled program source.+--+-- Copyright (c) 2006 Manuel M T Chakravarty+--+-- License: BSD3 <http://opensource.org/licenses/bsd-license.php>+--+-- Version: 1.0+--+--- Description ---------------------------------------------------------------+--+-- Extract version information from a .cabal file and from darcs, and then,+-- insert it into a source file. The name of the source file that is to be+-- rewritten with the version information must be passed as the only argument+-- to VersionTool. If that file's name is `Version.hs', there must be a+-- template file `Version.hs.in' containing version information markers+-- indicating where VersionTool should to enter the version information. The+-- markers are the following:+--+-- @VERSION@ -- version number, typically in XX.YY.ZZ format+-- (from `Version' entry in Cabal file)+-- @VERSNICK@ -- version nickname, a string that may contain white space+-- (from non-standard `--Versnick' entry in Cabal file)+-- @VERSDATE@ -- date of version, typically in DD MMM YYYY format+-- (from non-standard `--Versdate' entry in Cabal file)+-- @PATCHLEVEL@ -- number of darcs patches after a tag including the value+-- of @VERSION@, in `plN' format+-- @CONTEXT@ -- first entry of `darcs changes --context'+-- @CONFDATE@ -- date when VersionTool ran, in DD MMM YYYY format+--+-- VersionTool replaces these markers by H98 string literals.+--+-- VersionTool allows the Cabal file to have two extra entries not recognised+-- by Cabal itself. Hence, these entries start with the Cabal comment+-- characters `--'.+--+-- VersionTool uses darcs to find a tag containing the version number+-- @VERSION@. If it finds such a tag, the number of patches added, since that+-- tag, determine the patchlevel. If it does not find such a tag, it tags+-- the repository with "Version @VERSION@" and the patchlevel is "pl0".+-- +-- More info at <http://www.cse.unsw.edu.au/~chak/haskell/VersionTool/>.+--++module Main (main)+where++import Data.Char (+ toLower, isSpace)+import Control.Monad (+ when, unless, liftM)+import System.Process (+ runInteractiveCommand, waitForProcess)+import System.Directory (+ getDirectoryContents, doesFileExist)+import System.Environment (+ getArgs)+import System.Exit (+ ExitCode(..))+import System.IO (+ hGetContents)+import System.Time (+ ClockTime, Month, CalendarTime(..), getClockTime, toUTCTime)+++-- Constants+-- ---------++-- Suffix of input file+--+inSuffix :: String+inSuffix = ".in"++-- Darcs commands+--+darcsChangesFromTag, darcsContext :: String+darcsChangesFromTag = "darcs changes --from-tag="+darcsTag = "darcs tag "+darcsContext = "darcs changes --context --last=1"+++-- Data+-- ----++-- Versioning information+--+data Version = Version {+ version :: String,+ nickname :: String,+ versdate :: String,+ patchlevel :: String,+ context :: String,+ confdate :: String+ }+++-- Actual program+-- --------------++main :: IO ()+main =+ do+ -- Get name of source file into which we enter the version information+ args <- getArgs+ when (length args /= 1) $+ error "Usage: VersionTool.hs VERSION-FILE"+ let versionFName = head args+ exists <- doesFileExist (versionFName ++ ".in")+ unless exists $+ error $ "VersionTool: `" ++ versionFName ++ ".in' does not exist"++ -- Get the package's Cabal file and extract version information from it+ fnames <- getDirectoryContents "."+ let cabalFNames = [fname | fname <- fnames, suffix fname == "cabal"]+ when (null cabalFNames) $+ error "VersionTool: no .cabal file in current directory"+ (version, versnick, versdate) <- getCabalInfo (head cabalFNames)++ -- Query darcs for tag, patchlevel, and context; maybe add tag+ (patchlevel, context) <- darcsPatchLevelAndContext version++ -- Get current date+ confdate <- getCurrentDate++ -- Enter the gathered information into the version file+ rewriteFile versionFName + (Version version versnick versdate patchlevel context confdate)+++-- Cabal file processing+-- ---------------------++-- Extract version information (version number and version nick) from Cabal+-- file.+--+getCabalInfo :: FilePath -> IO (String, String, String)+getCabalInfo fname =+ do+ cabalSpec <- liftM lines $ readFile fname+ let versionLs = [line | line <- cabalSpec, "Version" `isPrefix` line]+ versnickLs = [line | line <- cabalSpec, "--Versnick" `isPrefix` line]+ versdateLs = [line | line <- cabalSpec, "--Versdate" `isPrefix` line]+ when (null versionLs) $+ error $ "VersionTool: no line with `version' tag in `" ++ fname ++ "'"+ when (null versnickLs) $+ putStrLn $ "Warning: VersionTool: no line with `--versnick' tag in `" +++ fname ++ "'"+ when (null versdateLs) $+ putStrLn $ "Warning: VersionTool: no line with `--versdate' tag in `" +++ fname ++ "'"+ return (extract versionLs, extract versnickLs, extract versdateLs)+ where+ extract ls | null ls = ""+ | otherwise = clean . tail . dropWhile (/= ':') . head $ ls+++-- Darcs interaction+-- -----------------++-- Compute the current patchlevel in darcs, obtain the context, and maybe set+-- a new version tag.+--+-- * The computation of the patchlevel relies on the fact that `darcs changes'+-- produces output where only the first line of every patch has a non-space+-- character.+--+darcsPatchLevelAndContext :: String -> IO (String, String)+darcsPatchLevelAndContext version = + do+ changes <- runDarcs (darcsChangesFromTag ++ version)+ ("darcs: Couldn't find" `isPrefix`)+ patchlevel <- case changes of+ Nothing -> do+ runDarcs_ (darcsTag ++ "\"version " ++ version ++ "\"")+ return 0+ Just changes -> + return $ length [ line + | line <- lines changes+ , not (null line || isSpace (head line))]+ - 1 -- don't count tag itself+ Just context <- runDarcs darcsContext (const False)+ return ("pl" ++ show patchlevel, dropWhile (/= '[') context)+ where+ runDarcs cmd errorTest =+ do+ (stdin, stdout, stderr, hdl) <- runInteractiveCommand cmd+ exitcode <- waitForProcess hdl+ case exitcode of+ ExitSuccess -> liftM Just $ hGetContents stdout+ ExitFailure code -> do+ errMsg <- hGetContents stderr+ if errorTest errMsg+ then return Nothing+ else+ error $ "VersionTool: darcs error " ++ show code ++ + (if null errMsg then "" else ": " ++ errMsg)+ + runDarcs_ cmd = runDarcs cmd (const False) >> return ()+++-- Date information+-- ----------------++-- Get the current date in `DD MMM YYYY' format.+--+getCurrentDate :: IO String+getCurrentDate =+ do+ time <- liftM toUTCTime $ getClockTime+ let preday = show $ ctDay time+ day = if length preday == 1 then '0':preday else preday+ month = take 3 (show $ ctMonth time)+ year = show $ ctYear time+ return $ day ++ " " ++ month ++ " " ++ year+++-- Target rewriting+-- ----------------++-- Enter version information into the version source.+--+rewriteFile :: FilePath -> Version -> IO ()+rewriteFile fname vers =+ do+ contents <- readFile (fname ++ inSuffix)+ writeFile fname (rewrite contents)+ where+ rewrite "" = ""+ rewrite ('@':rest) = case match rest of+ Nothing -> '@' : rewrite rest+ Just (new, rest') -> show new ++ rewrite rest'+ rewrite (c :rest) = c : rewrite rest+ --+ match str | "VERSION@" `isPrefix` str = + Just (version vers, drop (length "VERSION@" ) str)+ | "VERSNICK@" `isPrefix` str = + Just (nickname vers, drop (length "VERSNICK@") str)+ | "VERSDATE@" `isPrefix` str = + Just (versdate vers, drop (length "VERSDATE@") str)+ | "PATCHLEVEL@" `isPrefix` str = + Just (patchlevel vers, drop (length "PATCHLEVEL@") str)+ | "CONTEXT@" `isPrefix` str = + Just (context vers, drop (length "CONTEXT@") str)+ | "CONFDATE@" `isPrefix` str = + Just (confdate vers, drop (length "CONFDATE@") str)+ match _ = Nothing+++-- Utility functions+-- -----------------++-- Lose leading and trailing whitespace.+--+clean :: String -> String+clean = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- Check for string prefix disregarding case.+--+isPrefix :: String -> String -> Bool+str1 `isPrefix` str2 = + map toLower str1 == map toLower (take (length str1) str2)++-- Project the suffix from a filename.+--+suffix :: FilePath -> String+suffix = reverse . takeWhile (/= '.') . reverse
+ channel.css view
@@ -0,0 +1,37 @@+/* Simple example style sheet for lambdaFeed generated HTML+ */++body {+ font: 12px/1.3 Bitstream Vera Sans, Arial, Helvetica, sans-serif;+ color: black;+ background: white;+}++h1, h2, h3, h4, h5, h6 {+ font-family: Bitstream Vera Sans, Arial, Helvetica, sans-serif;+ font-weight: bold;+}+h1 { font-size: 2.5em; color: grey; font-weight: normal; }+h2 { + font-size: 1.5em; + background: lightgrey; + padding-left: .5em;+ padding-right: .5em;+ padding-top: .2em;+ padding-bottom: .2em;+}+h3 { font-size: 1.25em; }+h4, h5, h6 { font-size: 1em; }+h1, h2, h3, h4, h5, h6 {+ margin-top: 1.5em;+ margin-bottom: .5em;+}++img.channel { + float: right;+ marging-right: 0;+}++div.authorDate { + font-style: italic;+}
+ lambdaFeed.cabal view
@@ -0,0 +1,28 @@+Name: lambdaFeed+Version: 0.3.1+--Versnick: 'Lambdas are food for thought'+--Versdate: 18 Jun 2006+License: GPL+License-File: COPYING+Copyright: Copyright (c) 2006 Manuel M T Chakravarty+Author: Manuel M T Chakravarty+Maintainer: chak@cse.unsw.edu.au+Stability: Experimental+Homepage: http://www.cse.unsw.edu.au/~chak/haskell/lambdaFeed/+--Package-URL: http://www.cse.unsw.edu.au/~chak/haskell/lambdaFeed/lambdaFeed-0.3.1.tar.gz+Synopsis: RSS 2.0 feed generator+Description: LambdaFeed generates RSS 2.0 XML feeds and matching HTML files.+Category: Web+Build-Depends: base, haskell98, html++Executable: lambdaFeed+Main-Is: LambdaFeedMain.hs+Other-Modules: Config+ Date+ Error+ Feed+ LambdaFeed+ HTML+ RSS+ Stanza+Ghc-Options: -O
+ runLambdaFeed.hs view
@@ -0,0 +1,4 @@+#!/bin/env runhaskell +module Main (main)+where+import LambdaFeed (main)
+ test/polar/morefish.lfi view
@@ -0,0 +1,9 @@+-- Simple news item+--+Title: More Fish Discovered!!+Description:+ Yeah, we found more fish! Right in the hole in the ice at the south shore + of the frozen lake. Go and get some while they last!+++PubDate: Mon, 08 May 2006 03:59:03 UTC
+ test/polar/whereisthefish.lfi view
@@ -0,0 +1,9 @@+-- Another simple news item+--+Title: Can't find any fish anymore!+Description:+ Where is all the fish?? Couldn't find any in the hole!+Author: The Hungry Polar Bear <hungry@bear.polar>+++PubDate: Mon, 08 May 2006 05:27:32 UTC
+ test/polarbear.lfc view
@@ -0,0 +1,20 @@+-- Example of a channel description+--+-- The directory following the keyword `Items' is where the news items for+-- this channel are (one file per item).+--+Title: Exciting Polar Bear News+Link : http://bear.artic.net/+Description:+ Breaking news in the world of polar bears.+Items: polar/++Image+URL : http://bear.artic.net/bear-news.jpg+Title: Bear News Logo+Link : http://bear.artic.net/+Description: + Breaking news in the world of polar bears.++PubDate: Sun, 23 Apr 2006 00:00:01 UTC+Docs : http://www.rssboard.org/rss-specification