diff --git a/Text/Atom/Feed.hs b/Text/Atom/Feed.hs --- a/Text/Atom/Feed.hs +++ b/Text/Atom/Feed.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Isaac Potoczny-Jones +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- @@ -99,6 +99,7 @@ , linkHrefLang :: Maybe String , linkTitle :: Maybe String , linkLength :: Maybe String + , linkAttrs :: [XML.Attr] , linkOther :: [XML.Element] } deriving (Show) @@ -228,6 +229,7 @@ , linkHrefLang = Nothing , linkTitle = Nothing , linkLength = Nothing + , linkAttrs = [] , linkOther = [] } diff --git a/Text/Atom/Feed/Export.hs b/Text/Atom/Feed/Export.hs --- a/Text/Atom/Feed/Export.hs +++ b/Text/Atom/Feed/Export.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Convert from Atom to XML -- @@ -174,6 +174,7 @@ ++ mb (atomAttr "hreflang") (linkHrefLang l) ++ mb (atomAttr "title") (linkTitle l) ++ mb (atomAttr "length") (linkLength l) + ++ linkAttrs l } xmlSource :: Source -> Element diff --git a/Text/Atom/Feed/Import.hs b/Text/Atom/Feed/Import.hs --- a/Text/Atom/Feed/Import.hs +++ b/Text/Atom/Feed/Import.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2007-2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Convert from XML to Atom -- @@ -169,9 +169,15 @@ , linkHrefLang = pAttr "hreflang" e , linkTitle = pAttr "title" e , linkLength = pAttr "length" e + , linkAttrs = other_as (elAttribs e) , linkOther = [] } + where + other_as as = filter (\ a -> not (attrKey a `elem` known_attrs)) + as + known_attrs = map atomName + [ "href", "rel", "type", "hreflang", "title", "length"] pEntry :: XML.Element -> Maybe Entry diff --git a/Text/Atom/Feed/Link.hs b/Text/Atom/Feed/Link.hs --- a/Text/Atom/Feed/Link.hs +++ b/Text/Atom/Feed/Link.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/Atom/Feed/Validate.hs b/Text/Atom/Feed/Validate.hs --- a/Text/Atom/Feed/Validate.hs +++ b/Text/Atom/Feed/Validate.hs @@ -1,3 +1,14 @@ +-------------------------------------------------------------------- +-- | +-- Module : Text.Atom.Feed.Validate +-- Copyright : (c) Galois, Inc. 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: +-- +-------------------------------------------------------------------- module Text.Atom.Feed.Validate where import Text.Atom.Feed.Import diff --git a/Text/Atom/Pub.hs b/Text/Atom/Pub.hs --- a/Text/Atom/Pub.hs +++ b/Text/Atom/Pub.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/Atom/Pub/Export.hs b/Text/Atom/Pub/Export.hs --- a/Text/Atom/Pub/Export.hs +++ b/Text/Atom/Pub/Export.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Serializing APP types (as XML.) -- diff --git a/Text/DublinCore/Types.hs b/Text/DublinCore/Types.hs --- a/Text/DublinCore/Types.hs +++ b/Text/DublinCore/Types.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Representing the DublinCore metadata elements in Haskell. The Dublin -- Core Metadata Element Set. See: diff --git a/Text/Feed/Constructor.hs b/Text/Feed/Constructor.hs --- a/Text/Feed/Constructor.hs +++ b/Text/Feed/Constructor.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Module for an abstraction layer between different kinds of feeds. -- diff --git a/Text/Feed/Export.hs b/Text/Feed/Export.hs --- a/Text/Feed/Export.hs +++ b/Text/Feed/Export.hs @@ -4,14 +4,16 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Convert from Feeds to XML. -- -------------------------------------------------------------------- -module Text.Feed.Export where +module Text.Feed.Export + ( Text.Feed.Export.xmlFeed -- :: Feed -> XML.Element + ) where import Text.Feed.Types @@ -21,6 +23,8 @@ import Text.XML.Light as XML +-- | 'xmlFeed f' serializes a @Feed@ document into a conforming +-- XML toplevel element. xmlFeed :: Feed -> XML.Element xmlFeed fe = case fe of diff --git a/Text/Feed/Import.hs b/Text/Feed/Import.hs --- a/Text/Feed/Import.hs +++ b/Text/Feed/Import.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Convert from XML to Feeds. -- @@ -13,6 +13,11 @@ module Text.Feed.Import ( parseFeedFromFile -- :: FilePath -> IO Feed , parseFeedString -- :: String -> IO Feed + + -- if you know your format, use these directly: + , readRSS2 -- :: XML.Element -> Maybe Feed + , readRSS1 -- :: XML.Element -> Maybe Feed + , readAtom -- :: XML.Element -> Maybe Feed ) where import Text.Atom.Feed.Import as Atom @@ -24,29 +29,43 @@ import Control.Monad +import System.IO.UTF8 as UTF8 ( readFile ) + +-- | 'parseFeedFromFile fp' reads in the contents of the file at @fp@; +-- the assumed encoding is UTF-8. parseFeedFromFile :: FilePath -> IO Feed parseFeedFromFile fp = do - ls <- readFile fp + ls <- UTF8.readFile fp case parseFeedString ls of - Nothing -> fail "parseFeedFromFile: not a well-formed XML content" + Nothing -> fail ("parseFeedFromFile: not a well-formed XML content in: " ++ fp) Just f -> return f +-- | 'parseFeedString str' tries to parse the string @str@ as +-- one of the feed formats. First as Atom, then RSS2 before +-- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned +-- as an indication of error. parseFeedString :: String -> Maybe Feed parseFeedString str = case parseXMLDoc str of Nothing -> Nothing Just e -> readAtom e `mplus` - readRSS1 e `mplus` readRSS2 e `mplus` + readRSS1 e `mplus` Just (XMLFeed e) +-- | 'readRSS2 elt' tries to derive an RSS2.x, RSS-0.9x feed document +-- from the XML element @e@. readRSS2 :: XML.Element -> Maybe Feed readRSS2 e = fmap RSSFeed $ RSS.elementToRSS e +-- | 'readRSS1 elt' tries to derive an RSS1.0 feed document +-- from the XML element @e@. readRSS1 :: XML.Element -> Maybe Feed readRSS1 e = fmap RSS1Feed $ RSS1.elementToFeed e +-- | 'readAtom elt' tries to derive an Atom feed document +-- from the XML element @e@. readAtom :: XML.Element -> Maybe Feed readAtom e = fmap AtomFeed $ Atom.elementFeed e diff --git a/Text/Feed/Query.hs b/Text/Feed/Query.hs --- a/Text/Feed/Query.hs +++ b/Text/Feed/Query.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- @@ -36,11 +36,13 @@ , getItemDate -- :: ItemGetter (DateString) , getItemAuthor -- :: ItemGetter (String) , getItemCommentLink -- :: ItemGetter (URLString) - , getItemEnclosure -- :: ItemGetter (String,MaybeString,Integer) + , getItemEnclosure -- :: ItemGetter (String,Maybe String,Integer) , getItemFeedLink -- :: ItemGetter (URLString) , getItemId -- :: ItemGetter (Bool,String) , getItemCategories -- :: ItemGetter [String] , getItemRights -- :: ItemGetter String + , getItemSummary -- :: ItemGetter String + , getItemDescription -- :: ItemGetter String (synonym of previous.) ) where @@ -318,7 +320,7 @@ isReplies lr = toStr (Atom.linkRel lr) == "replies" isRel dc = dcElt dc == DC_Relation -getItemEnclosure :: ItemGetter (String,Maybe String,Integer) +getItemEnclosure :: ItemGetter (String, Maybe String, Integer) getItemEnclosure it = case it of Feed.AtomItem e -> @@ -404,6 +406,17 @@ Feed.XMLItem _ -> Nothing where isRights dc = dcElt dc == DC_Rights + +getItemSummary :: ItemGetter String +getItemSummary it = getItemDescription it + +getItemDescription :: ItemGetter String +getItemDescription it = + case it of + Feed.AtomItem e -> fmap contentToStr $ Atom.entrySummary e + Feed.RSSItem e -> RSS.rssItemDescription e + Feed.RSS1Item i -> itemDesc i + Feed.XMLItem _ -> Nothing -- strip away toStr :: Maybe (Either String String) -> String diff --git a/Text/Feed/Translate.hs b/Text/Feed/Translate.hs --- a/Text/Feed/Translate.hs +++ b/Text/Feed/Translate.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/Feed/Types.hs b/Text/Feed/Types.hs --- a/Text/Feed/Types.hs +++ b/Text/Feed/Types.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/Feed/Util.hs b/Text/Feed/Util.hs new file mode 100644 --- /dev/null +++ b/Text/Feed/Util.hs @@ -0,0 +1,25 @@ +-------------------------------------------------------------------- +-- | +-- Module : Text.Feed.Util +-- Copyright : (c) Galois, Inc. 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: +-- +-------------------------------------------------------------------- +module Text.Feed.Util where + +import Text.Feed.Types +import Time +import Locale + +-- | 'toFeedDate' translates a calendar time into +-- the format expected by the feed kind. +toFeedDateString :: FeedKind -> ClockTime -> {-Date-}String +toFeedDateString fk ct = + case fk of + AtomKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct) + RSSKind{} -> formatCalendarTime defaultTimeLocale "%a, %d %b %Y %H:%m:%s GMT" (toUTCTime ct) + RDFKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct) diff --git a/Text/RSS/Export.hs b/Text/RSS/Export.hs --- a/Text/RSS/Export.hs +++ b/Text/RSS/Export.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Convert from RSS to XML -- diff --git a/Text/RSS/Import.hs b/Text/RSS/Import.hs --- a/Text/RSS/Import.hs +++ b/Text/RSS/Import.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: Converting from XML to RSS -- @@ -13,21 +13,31 @@ module Text.RSS.Import where import Text.RSS.Syntax +import Text.RSS1.Utils ( dcNS, dcPrefix ) import Text.XML.Light as XML import Data.Maybe (listToMaybe, mapMaybe) import Data.Char (isSpace ) -import Control.Monad (guard) +import Control.Monad (guard,mplus) pNodes :: String -> [XML.Element] -> [XML.Element] pNodes x es = filter ((qualName x ==) . elName) es +pQNodes :: QName -> [XML.Element] -> [XML.Element] +pQNodes x es = filter ((x==) . elName) es + pNode :: String -> [XML.Element] -> Maybe XML.Element pNode x es = listToMaybe (pNodes x es) +pQNode :: QName -> [XML.Element] -> Maybe XML.Element +pQNode x es = listToMaybe (pQNodes x es) + pLeaf :: String -> [XML.Element] -> Maybe String pLeaf x es = strContent `fmap` pNode x es +pQLeaf :: QName -> [XML.Element] -> Maybe String +pQLeaf x es = strContent `fmap` (pQNode x es) + pAttr :: String -> XML.Element -> Maybe String pAttr x e = lookup (qualName x) [ (k,v) | Attr k v <- elAttribs e ] @@ -40,6 +50,9 @@ qualName :: String -> QName qualName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing} +dcName :: String -> QName +dcName x = blank_name{qName=x,qURI=dcNS,qPrefix=dcPrefix} + elementToRSS :: XML.Element -> Maybe RSS elementToRSS e = do guard (elName e == qualName "rss") @@ -68,14 +81,14 @@ , rssLink = link , rssDescription = desc , rssItems = pMany "item" elementToItem es - , rssLanguage = pLeaf "language" es + , rssLanguage = pLeaf "language" es `mplus` pQLeaf (dcName "lang") es , rssCopyright = pLeaf "copyright" es - , rssEditor = pLeaf "managingEditor" es + , rssEditor = pLeaf "managingEditor" es `mplus` pQLeaf (dcName "creator") es , rssWebMaster = pLeaf "webMaster" es - , rssPubDate = pLeaf "pubDate" es - , rssLastUpdate = pLeaf "lastBuildDate" es + , rssPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es + , rssLastUpdate = pLeaf "lastBuildDate" es `mplus` pQLeaf (dcName "date") es , rssCategories = pMany "category" elementToCategory es - , rssGenerator = pLeaf "generator" es + , rssGenerator = pLeaf "generator" es `mplus` pQLeaf (dcName "source") es , rssDocs = pLeaf "docs" es , rssCloud = pNode "cloud" es >>= elementToCloud , rssTTL = pLeaf "ttl" es >>= readInt @@ -155,12 +168,12 @@ { rssItemTitle = pLeaf "title" es , rssItemLink = pLeaf "link" es , rssItemDescription = pLeaf "description" es - , rssItemAuthor = pLeaf "author" es + , rssItemAuthor = pLeaf "author" es `mplus` pQLeaf (dcName "creator") es , rssItemCategories = pMany "category" elementToCategory es , rssItemComments = pLeaf "comments" es , rssItemEnclosure = pNode "enclosure" es >>= elementToEnclosure , rssItemGuid = pNode "guid" es >>= elementToGuid - , rssItemPubDate = pLeaf "pubDate" es + , rssItemPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es , rssItemSource = pNode "source" es >>= elementToSource , rssItemAttrs = elAttribs e , rssItemOther = filter (\ e1 -> not (elName e1 `elem` known_item_elts)) es diff --git a/Text/RSS/Syntax.hs b/Text/RSS/Syntax.hs --- a/Text/RSS/Syntax.hs +++ b/Text/RSS/Syntax.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Isaac Potoczny-Jones +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Description: The basic syntax for putting together feeds. For instance, -- to create a feed with a single item item: @@ -31,7 +31,7 @@ deriving (Show) type URLString = String -type DateString = String +type DateString = String -- ^ rfc 822 conforming. data RSSChannel = RSSChannel diff --git a/Text/RSS1/Export.hs b/Text/RSS1/Export.hs --- a/Text/RSS1/Export.hs +++ b/Text/RSS1/Export.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/RSS1/Import.hs b/Text/RSS1/Import.hs --- a/Text/RSS1/Import.hs +++ b/Text/RSS1/Import.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/RSS1/Syntax.hs b/Text/RSS1/Syntax.hs --- a/Text/RSS1/Syntax.hs +++ b/Text/RSS1/Syntax.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/Text/RSS1/Utils.hs b/Text/RSS1/Utils.hs --- a/Text/RSS1/Utils.hs +++ b/Text/RSS1/Utils.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- diff --git a/feed.cabal b/feed.cabal --- a/feed.cabal +++ b/feed.cabal @@ -1,12 +1,12 @@ Name: feed -Version: 0.3.2.1 +Version: 0.3.4 License: BSD3 License-file: LICENSE Category: Text Synopsis: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds. Description: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds. -Author: Sigbjorn Finne -Maintainer: Isaac Jones +Author: Sigbjorn Finne +Maintainer: Sigbjorn Finne Extra-Source-Files: tests/Main.hs tests/rss20.xml Cabal-version: >= 1.2 build-type: Simple @@ -37,5 +37,7 @@ Text.Feed.Query Text.Feed.Constructor Text.Feed.Translate + Text.Feed.Util Ghc-Options: -Wall - Build-Depends: base, xml >= 1.2.6 + Build-Depends: base, haskell98, xml >= 1.2.6, utf8-string +