diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,1 @@ +Manuel M T Chakravarty diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. + + + Copyright (C) 19yy + + 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. + + , 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. + diff --git a/Config.hs b/Config.hs new file mode 100644 --- /dev/null +++ b/Config.hs @@ -0,0 +1,229 @@ +-- |A simple feed generator: Configuration management and command line parsing +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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 **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 ." + + +-- 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."]) + diff --git a/Config.hs.in b/Config.hs.in new file mode 100644 --- /dev/null +++ b/Config.hs.in @@ -0,0 +1,229 @@ +-- |A simple feed generator: Configuration management and command line parsing +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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 ." + + +-- 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."]) + diff --git a/Date.hs b/Date.hs new file mode 100644 --- /dev/null +++ b/Date.hs @@ -0,0 +1,204 @@ +-- |A simple feed generator: Date utilities +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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 +-- +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 + } diff --git a/Error.hs b/Error.hs new file mode 100644 --- /dev/null +++ b/Error.hs @@ -0,0 +1,54 @@ +-- |A simple feed generator: Error handling +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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 diff --git a/Feed.hs b/Feed.hs new file mode 100644 --- /dev/null +++ b/Feed.hs @@ -0,0 +1,256 @@ +-- |A simple feed generator: Feed data structure +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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" + } diff --git a/HTML.hs b/HTML.hs new file mode 100644 --- /dev/null +++ b/HTML.hs @@ -0,0 +1,133 @@ +-- |A simple feed generator: HTML generator +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 +-- +-- Docs ---------------------------------------------------------------------- +-- +-- Introduction to Text.Html: +-- + +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 "" + , 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 diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -0,0 +1,29 @@ +Prerequisites +~~~~~~~~~~~~~ +To compile this code, you need a Haskell compiler. If you have none, go to + 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 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.) diff --git a/LambdaFeed.hs b/LambdaFeed.hs new file mode 100644 --- /dev/null +++ b/LambdaFeed.hs @@ -0,0 +1,727 @@ +-- |A simple feed generator +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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: +-- +--- 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 . 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 diff --git a/LambdaFeedMain.hs b/LambdaFeedMain.hs new file mode 100644 --- /dev/null +++ b/LambdaFeedMain.hs @@ -0,0 +1,14 @@ +-- |A simple feed generator: Main module for compiling lambdaFeed +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- Description --------------------------------------------------------------- +-- +-- Language: Haskell 98 + +module Main (main) +where + +import LambdaFeed (main) diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,10 @@ +# A simple feed generator: make system +# +# Copyright (c) 2006 Manuel M T Chakravarty +# +# License: +# + +default: + @echo "*** lambdaFeed uses a Cabal-based build system ." + @echo "*** See the file INSTALL for details." diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 diff --git a/RSS.hs b/RSS.hs new file mode 100644 --- /dev/null +++ b/RSS.hs @@ -0,0 +1,195 @@ +-- |A simple feed generator: RSS 2.0 generator +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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 "" + $+$ + 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) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/Stanza.hs b/Stanza.hs new file mode 100644 --- /dev/null +++ b/Stanza.hs @@ -0,0 +1,231 @@ +-- |A simple feed generator: Stanza reading and parsing +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: +-- +--- 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)" diff --git a/VersionTool.hs b/VersionTool.hs new file mode 100644 --- /dev/null +++ b/VersionTool.hs @@ -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 +-- +-- 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 . +-- + +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 diff --git a/channel.css b/channel.css new file mode 100644 --- /dev/null +++ b/channel.css @@ -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; +} diff --git a/lambdaFeed.cabal b/lambdaFeed.cabal new file mode 100644 --- /dev/null +++ b/lambdaFeed.cabal @@ -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 diff --git a/runLambdaFeed.hs b/runLambdaFeed.hs new file mode 100644 --- /dev/null +++ b/runLambdaFeed.hs @@ -0,0 +1,4 @@ +#!/bin/env runhaskell +module Main (main) +where +import LambdaFeed (main) diff --git a/test/polar/morefish.lfi b/test/polar/morefish.lfi new file mode 100644 --- /dev/null +++ b/test/polar/morefish.lfi @@ -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 diff --git a/test/polar/whereisthefish.lfi b/test/polar/whereisthefish.lfi new file mode 100644 --- /dev/null +++ b/test/polar/whereisthefish.lfi @@ -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 + + +PubDate: Mon, 08 May 2006 05:27:32 UTC diff --git a/test/polarbear.lfc b/test/polarbear.lfc new file mode 100644 --- /dev/null +++ b/test/polarbear.lfc @@ -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