feed 1.0.0.0 → 1.0.1.0
raw patch · 38 files changed
+1287/−926 lines, 38 filesdep ~basedep ~textdep ~xml-conduitnew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base, text, xml-conduit, xml-types
API changes (from Hackage documentation)
+ Text.Atom.Feed.Export: textFeed :: Feed -> Maybe Text
+ Text.Feed.Export: textFeed :: Feed -> Maybe Text
+ Text.RSS.Export: textRSS :: RSS -> Maybe Text
+ Text.RSS1.Export: textFeed :: Feed -> Maybe Text
- Text.Atom.Feed: ExternalContent :: (Maybe MediaType) -> URI -> EntryContent
+ Text.Atom.Feed: ExternalContent :: Maybe MediaType -> URI -> EntryContent
- Text.Atom.Feed: MixedContent :: (Maybe Text) -> [Node] -> EntryContent
+ Text.Atom.Feed: MixedContent :: Maybe Text -> [Node] -> EntryContent
- Text.Atom.Pub: Categories :: (Maybe Bool) -> (Maybe URI) -> [Category] -> Categories
+ Text.Atom.Pub: Categories :: Maybe Bool -> Maybe URI -> [Category] -> Categories
- Text.Feed.Constructor: RDFKind :: (Maybe Text) -> FeedKind
+ Text.Feed.Constructor: RDFKind :: Maybe Text -> FeedKind
- Text.Feed.Constructor: RSSKind :: (Maybe Text) -> FeedKind
+ Text.Feed.Constructor: RSSKind :: Maybe Text -> FeedKind
- Text.Feed.Types: RDFKind :: (Maybe Text) -> FeedKind
+ Text.Feed.Types: RDFKind :: Maybe Text -> FeedKind
- Text.Feed.Types: RSSKind :: (Maybe Text) -> FeedKind
+ Text.Feed.Types: RSSKind :: Maybe Text -> FeedKind
Files
- CHANGELOG.md +6/−0
- README.lhs +159/−0
- README.md +151/−7
- feed.cabal +33/−12
- src/Data/Text/Util.hs +20/−0
- src/Data/XML/Compat.hs +0/−1
- src/Text/Atom/Feed.hs +55/−56
- src/Text/Atom/Feed/Export.hs +35/−30
- src/Text/Atom/Feed/Import.hs +81/−82
- src/Text/Atom/Feed/Link.hs +0/−1
- src/Text/Atom/Feed/Validate.hs +9/−8
- src/Text/Atom/Pub.hs +0/−1
- src/Text/Atom/Pub/Export.hs +11/−15
- src/Text/DublinCore/Types.hs +0/−1
- src/Text/Feed/Constructor.hs +93/−95
- src/Text/Feed/Export.hs +7/−2
- src/Text/Feed/Import.hs +3/−8
- src/Text/Feed/Query.hs +4/−6
- src/Text/Feed/Translate.hs +2/−4
- src/Text/Feed/Types.hs +0/−1
- src/Text/Feed/Util.hs +0/−1
- src/Text/RSS/Export.hs +67/−58
- src/Text/RSS/Import.hs +80/−81
- src/Text/RSS/Syntax.hs +62/−63
- src/Text/RSS1/Export.hs +27/−22
- src/Text/RSS1/Import.hs +78/−80
- src/Text/RSS1/Syntax.hs +65/−62
- src/Text/RSS1/Utils.hs +2/−3
- tests/Example.hs +5/−4
- tests/Example/CreateAtom.hs +36/−29
- tests/Main.hs +0/−1
- tests/Text/Atom/Tests.hs +10/−9
- tests/Text/Feed/Util/Tests.hs +3/−2
- tests/Text/RSS/Equals.hs +0/−1
- tests/Text/RSS/Export/Tests.hs +154/−153
- tests/Text/RSS/Import/Tests.hs +22/−21
- tests/Text/RSS/Tests.hs +7/−5
- tests/Text/RSS/Utils.hs +0/−1
CHANGELOG.md view
@@ -1,3 +1,9 @@+#### 1.0.1.0++* Support for GHC 8.6.x libraries++* Add `textFeed` and `textRSS` helpers (thanks to Francesco Ariis)+ # 1.0.0.0 * Thanks to Dmitry Dzhus feed has been modernized to use the `text`,
+ README.lhs view
@@ -0,0 +1,159 @@+# Feed++[](http://hackage.haskell.org/package/feed)+[](https://travis-ci.org/bergmark/feed)++## Goal++Interfacing with *RSS* (v 0.9x, 2.x, 1.0) + *Atom* feeds.++- Parsers+- Pretty Printers+- Querying++To help working with the multiple feed formats we've ended up with+this set of modules providing parsers, pretty printers and some utility+code for querying and just generally working with a concrete+representation of feeds in Haskell.++For basic reading and editing of feeds, consult the documentation of+the Text.Feed.* hierarchy.++## Usage++Building an Atom feed is similar to building an RSS feed, but we'll+arbitrarily pick Atom here:++We'd like to generate the XML for a minimal working example.+Constructing our base `Feed` can use the smart constructor called `nullFeed`:++*This is a pattern the library maintains for smart constructors. If you want the+minimum viable 'X', use the 'nullX' constructor.*+++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Prelude.Compat hiding (take)++import Data.Text+import Data.XML.Types as XML+import qualified Data.Text.Lazy as Lazy+import qualified Text.Atom.Feed as Atom+import qualified Text.Atom.Feed.Export as Export (textFeed)++myFeed :: Atom.Feed+myFeed = Atom.nullFeed+ "http://example.com/atom.xml" -- ^ id+ (Atom.TextString "Example Website") -- ^ title+ "2017-08-01" -- ^ last updated+```++Now we can export the feed to `Text`.++```haskell+renderFeed :: Atom.Feed -> Maybe Lazy.Text+renderFeed = Export.textFeed+```++```+> renderFeed myFeed+<?xml version="1.0" encoding="UTF-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Example Website</title>+ <id>http://example.com/atom.xml</id>+ <updated>2017-08-01</updated>+</feed>+```++The `TextContent` sum type allows us to specify which type of text we're providing.++```haskell+data TextContent+ = TextString Text+ | HTMLString Text+ | XHTMLString XML.Element+ deriving (Show)+```++A feed isn't very useful without some content though, so we'll need to build up an `Entry`.++```haskell+data Post+ = Post+ { _postedOn :: Text+ , _url :: Text+ , _content :: Text+ }++examplePosts :: [Post]+examplePosts =+ [ Post "2000-02-02T18:30:00Z" "http://example.com/2" "Bar."+ , Post "2000-01-01T18:30:00Z" "http://example.com/1" "Foo."+ ]+```++Our `Post` data type will need to be converted into an `Entry` in order to use it in the top level `Feed`. The required fields for an entry are an url "id" from which an entry's presence can be validated, a title for the entry, and a posting date. In this example we'll also add authors, link, and the entries actual content, since we have all of this available in the `Post` provided.++```haskell+toEntry :: Post -> Atom.Entry+toEntry (Post date url content) =+ (Atom.nullEntry+ url -- The ID field. Must be a link to validate.+ (Atom.TextString (take 20 content)) -- Title+ date)+ { Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "J. Smith"}]+ , Atom.entryLinks = [Atom.nullLink url]+ , Atom.entryContent = Just (Atom.HTMLContent content)+ }+```++From the base feed we created earlier, we can add further details (`Link` and `Entry` content) as well as map our `toEntry` function over the posts we'd like to include in the feed.++```haskell+feed :: Atom.Feed+feed =+ myFeed { Atom.feedEntries = fmap toEntry examplePosts+ , Atom.feedLinks = [Atom.nullLink "http://example.com/"]+ }+```++```+> renderFeed feed+<?xml version="1.0" encoding="UTF-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Example Website</title>+ <id>http://example.com/atom.xml</id>+ <updated>2017-08-01</updated>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/"/>+ <entry>+ <id>http://example.com/2</id>+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Bar.</title>+ <updated>2000-02-02T18:30:00Z</updated>+ <author>+ <name>J. Smith</name>+ </author>+ <content xmlns:ns="http://www.w3.org/2005/Atom" ns:type="html">Bar.</content>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/2"/>+ </entry>+ <entry>+ <id>http://example.com/1</id>+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Foo.</title>+ <updated>2000-01-01T18:30:00Z</updated>+ <author>+ <name>J. Smith</name>+ </author>+ <content xmlns:ns="http://www.w3.org/2005/Atom" ns:type="html">Foo.</content>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/1"/>+ </entry>+</feed>+```+See [here](https://github.com/bergmark/feed/blob/master/tests/Example/CreateAtom.hs) for this content as an uninterrupted running example.++```haskell+-- Dummy main needed to compile this file with markdown-unlit+main :: IO ()+main = return ()+```
README.md view
@@ -1,15 +1,159 @@-[](https://hackage.haskell.org/package/feed)+# Feed++[](http://hackage.haskell.org/package/feed) [](https://travis-ci.org/bergmark/feed) -Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.+## Goal -To help working with the multiple feed formats we've ended up with,-this set of modules provides parsers, pretty printers and some utility+Interfacing with *RSS* (v 0.9x, 2.x, 1.0) + *Atom* feeds.++- Parsers+- Pretty Printers+- Querying++To help working with the multiple feed formats we've ended up with+this set of modules providing parsers, pretty printers and some utility code for querying and just generally working with a concrete representation of feeds in Haskell. -See [here](https://github.com/bergmark/feed/blob/master/tests/Example/CreateAtom.hs) for an example-of how to create an Atom feed.- For basic reading and editing of feeds, consult the documentation of the Text.Feed.* hierarchy.++## Usage++Building an Atom feed is similar to building an RSS feed, but we'll+arbitrarily pick Atom here:++We'd like to generate the XML for a minimal working example.+Constructing our base `Feed` can use the smart constructor called `nullFeed`:++*This is a pattern the library maintains for smart constructors. If you want the+minimum viable 'X', use the 'nullX' constructor.*+++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Prelude.Compat hiding (take)++import Data.Text+import Data.XML.Types as XML+import qualified Data.Text.Lazy as Lazy+import qualified Text.Atom.Feed as Atom+import qualified Text.Atom.Feed.Export as Export (textFeed)++myFeed :: Atom.Feed+myFeed = Atom.nullFeed+ "http://example.com/atom.xml" -- ^ id+ (Atom.TextString "Example Website") -- ^ title+ "2017-08-01" -- ^ last updated+```++Now we can export the feed to `Text`.++```haskell+renderFeed :: Atom.Feed -> Maybe Lazy.Text+renderFeed = Export.textFeed+```++```+> renderFeed myFeed+<?xml version="1.0" encoding="UTF-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Example Website</title>+ <id>http://example.com/atom.xml</id>+ <updated>2017-08-01</updated>+</feed>+```++The `TextContent` sum type allows us to specify which type of text we're providing.++```haskell+data TextContent+ = TextString Text+ | HTMLString Text+ | XHTMLString XML.Element+ deriving (Show)+```++A feed isn't very useful without some content though, so we'll need to build up an `Entry`.++```haskell+data Post+ = Post+ { _postedOn :: Text+ , _url :: Text+ , _content :: Text+ }++examplePosts :: [Post]+examplePosts =+ [ Post "2000-02-02T18:30:00Z" "http://example.com/2" "Bar."+ , Post "2000-01-01T18:30:00Z" "http://example.com/1" "Foo."+ ]+```++Our `Post` data type will need to be converted into an `Entry` in order to use it in the top level `Feed`. The required fields for an entry are an url "id" from which an entry's presence can be validated, a title for the entry, and a posting date. In this example we'll also add authors, link, and the entries actual content, since we have all of this available in the `Post` provided.++```haskell+toEntry :: Post -> Atom.Entry+toEntry (Post date url content) =+ (Atom.nullEntry+ url -- The ID field. Must be a link to validate.+ (Atom.TextString (take 20 content)) -- Title+ date)+ { Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "J. Smith"}]+ , Atom.entryLinks = [Atom.nullLink url]+ , Atom.entryContent = Just (Atom.HTMLContent content)+ }+```++From the base feed we created earlier, we can add further details (`Link` and `Entry` content) as well as map our `toEntry` function over the posts we'd like to include in the feed.++```haskell+feed :: Atom.Feed+feed =+ myFeed { Atom.feedEntries = fmap toEntry examplePosts+ , Atom.feedLinks = [Atom.nullLink "http://example.com/"]+ }+```++```+> renderFeed feed+<?xml version="1.0" encoding="UTF-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Example Website</title>+ <id>http://example.com/atom.xml</id>+ <updated>2017-08-01</updated>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/"/>+ <entry>+ <id>http://example.com/2</id>+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Bar.</title>+ <updated>2000-02-02T18:30:00Z</updated>+ <author>+ <name>J. Smith</name>+ </author>+ <content xmlns:ns="http://www.w3.org/2005/Atom" ns:type="html">Bar.</content>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/2"/>+ </entry>+ <entry>+ <id>http://example.com/1</id>+ <title xmlns:ns="http://www.w3.org/2005/Atom" ns:type="text">Foo.</title>+ <updated>2000-01-01T18:30:00Z</updated>+ <author>+ <name>J. Smith</name>+ </author>+ <content xmlns:ns="http://www.w3.org/2005/Atom" ns:type="html">Foo.</content>+ <link xmlns:ns="http://www.w3.org/2005/Atom" ns:href="http://example.com/1"/>+ </entry>+</feed>+```+See [here](https://github.com/bergmark/feed/blob/master/tests/Example/CreateAtom.hs) for this content as an uninterrupted running example.++```haskell+-- Dummy main needed to compile this file with markdown-unlit+main :: IO ()+main = return ()+```
feed.cabal view
@@ -1,5 +1,5 @@ name: feed-version: 1.0.0.0+version: 1.0.1.0 license: BSD3 license-file: LICENSE category: Text@@ -30,6 +30,8 @@ , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.1+ , GHC == 8.4.1+ , GHC == 8.6.1 data-files: tests/files/*.xml extra-source-files:@@ -43,7 +45,9 @@ library ghc-options: -Wall hs-source-dirs: src- extensions: OverloadedStrings+ extensions:+ NoImplicitPrelude+ OverloadedStrings exposed-modules: Text.Atom.Feed Text.Atom.Feed.Export@@ -71,8 +75,8 @@ Data.Text.Util Data.XML.Compat build-depends:- base >= 4 && < 4.11- , base-compat == 0.9.*+ base >= 4 && < 4.13+ , base-compat >= 0.9 && < 0.11 , bytestring >= 0.9 && < 0.11 , old-locale == 1.0.* , old-time >= 1 && < 1.2@@ -82,14 +86,16 @@ , time-locale-compat == 0.1.* , utf8-string < 1.1 , xml-types >= 0.3.6 && < 0.4- , xml-conduit >= 1.3 && < 1.6+ , xml-conduit >= 1.3 && < 1.9 test-suite tests ghc-options: -Wall hs-source-dirs: tests main-is: Main.hs type: exitcode-stdio-1.0- extensions: OverloadedStrings+ extensions:+ NoImplicitPrelude+ OverloadedStrings other-modules: Paths_feed Example@@ -102,17 +108,32 @@ Text.RSS.Tests Text.RSS.Utils build-depends:- base >= 4 && < 4.11+ base >= 4 && < 4.13+ , base-compat >= 0.9 && < 0.11 , HUnit >= 1.2 && < 1.7- , base-compat == 0.9.* , feed- , old-locale == 1.0.* , old-time >= 1 && < 1.2 , test-framework == 0.8.* , test-framework-hunit == 0.3.* , text < 1.3 , time < 1.9- , time-locale-compat == 0.1.*- , utf8-string < 1.1 , xml-types >= 0.3.6 && < 0.4- , xml-conduit >= 1.3 && < 1.6+ , xml-conduit >= 1.3 && < 1.9++test-suite readme+ ghc-options: -Wall -pgmL markdown-unlit+ main-is: README.lhs+ extensions:+ NoImplicitPrelude+ OverloadedStrings+ type: exitcode-stdio-1.0+ build-depends:+ base >= 4 && < 4.13+ , base-compat >= 0.9 && < 0.11+ , text+ , xml-types+ , feed+ , xml-conduit+ , xml-types+ build-tool-depends:+ markdown-unlit:markdown-unlit == 0.4.*
src/Data/Text/Util.hs view
@@ -1,12 +1,32 @@ module Data.Text.Util ( readInt+ , renderFeed ) where +import Prelude.Compat+ import Data.Text import Data.Text.Read +import qualified Data.XML.Types as XT -- from xml-types+import qualified Text.XML as XC -- from xml-conduit+import qualified Data.Text.Lazy as TL+ readInt :: Text -> Maybe Integer readInt s = case decimal s of Right (x, _) -> Just x _ -> Nothing++renderFeed :: (a -> XT.Element) -> a -> Maybe TL.Text+renderFeed cf f = let e = cf f+ d = elToDoc e+ in XC.renderText XC.def <$> d+++-- Ancillaries --++elToDoc :: XT.Element -> Maybe XC.Document+elToDoc el = let txd = XT.Document (XC.Prologue [] Nothing []) el []+ cxd = XC.fromXMLDocument txd+ in either (const Nothing) Just cxd
src/Data/XML/Compat.hs view
@@ -3,7 +3,6 @@ -- | Compatibility interface between `xml` and `xml-types`. module Data.XML.Compat where -import Prelude () import Prelude.Compat import Data.Text (Text)
src/Text/Atom/Feed.hs view
@@ -37,7 +37,6 @@ , nullPerson ) where -import Prelude () import Prelude.Compat import Data.Text (Text, unpack)@@ -187,22 +186,22 @@ -> Feed nullFeed i t u = Feed- { feedId = i- , feedTitle = t- , feedUpdated = u- , feedAuthors = []- , feedCategories = []- , feedContributors = []- , feedGenerator = Nothing- , feedIcon = Nothing- , feedLinks = []- , feedLogo = Nothing- , feedRights = Nothing- , feedSubtitle = Nothing- , feedEntries = []- , feedAttrs = []- , feedOther = []- }+ { feedId = i+ , feedTitle = t+ , feedUpdated = u+ , feedAuthors = []+ , feedCategories = []+ , feedContributors = []+ , feedGenerator = Nothing+ , feedIcon = Nothing+ , feedLinks = []+ , feedLogo = Nothing+ , feedRights = Nothing+ , feedSubtitle = Nothing+ , feedEntries = []+ , feedAttrs = []+ , feedOther = []+ } nullEntry :: URI -- ^entryId@@ -211,23 +210,23 @@ -> Entry nullEntry i t u = Entry- { entryId = i- , entryTitle = t- , entryUpdated = u- , entryAuthors = []- , entryCategories = []- , entryContent = Nothing- , entryContributor = []- , entryLinks = []- , entryPublished = Nothing- , entryRights = Nothing- , entrySource = Nothing- , entrySummary = Nothing- , entryInReplyTo = Nothing- , entryInReplyTotal = Nothing- , entryAttrs = []- , entryOther = []- }+ { entryId = i+ , entryTitle = t+ , entryUpdated = u+ , entryAuthors = []+ , entryCategories = []+ , entryContent = Nothing+ , entryContributor = []+ , entryLinks = []+ , entryPublished = Nothing+ , entryRights = Nothing+ , entrySource = Nothing+ , entrySummary = Nothing+ , entryInReplyTo = Nothing+ , entryInReplyTotal = Nothing+ , entryAttrs = []+ , entryOther = []+ } nullGenerator :: Text -- ^genText@@ -239,32 +238,32 @@ -> Link nullLink uri = Link- { linkHref = uri- , linkRel = Nothing- , linkType = Nothing- , linkHrefLang = Nothing- , linkTitle = Nothing- , linkLength = Nothing- , linkAttrs = []- , linkOther = []- }+ { linkHref = uri+ , linkRel = Nothing+ , linkType = Nothing+ , linkHrefLang = Nothing+ , linkTitle = Nothing+ , linkLength = Nothing+ , linkAttrs = []+ , linkOther = []+ } nullSource :: Source nullSource = Source- { sourceAuthors = []- , sourceCategories = []- , sourceGenerator = Nothing- , sourceIcon = Nothing- , sourceId = Nothing- , sourceLinks = []- , sourceLogo = Nothing- , sourceRights = Nothing- , sourceSubtitle = Nothing- , sourceTitle = Nothing- , sourceUpdated = Nothing- , sourceOther = []- }+ { sourceAuthors = []+ , sourceCategories = []+ , sourceGenerator = Nothing+ , sourceIcon = Nothing+ , sourceId = Nothing+ , sourceLinks = []+ , sourceLogo = Nothing+ , sourceRights = Nothing+ , sourceSubtitle = Nothing+ , sourceTitle = Nothing+ , sourceUpdated = Nothing+ , sourceOther = []+ } nullPerson :: Person nullPerson = Person {personName = "", personURI = Nothing, personEmail = Nothing, personOther = []}
src/Text/Atom/Feed/Export.hs view
@@ -29,6 +29,7 @@ , atomThreadNode , atomThreadLeaf , xmlFeed+ , textFeed , xmlEntry , xmlContent , xmlCategory@@ -53,12 +54,13 @@ , mb ) where -import Prelude () import Prelude.Compat import Data.Text (Text, pack) import Data.XML.Types as XML import Text.Atom.Feed+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Util as U atom_prefix :: Maybe Text atom_prefix = Nothing -- Just "atom"@@ -83,10 +85,10 @@ Nothing -> Name {nameLocalName = "xmlns", nameNamespace = Nothing, namePrefix = Nothing} Just s -> Name- { nameLocalName = s- , nameNamespace = Nothing -- XXX: is this ok?- , namePrefix = Just "xmlns"- }+ { nameLocalName = s+ , nameNamespace = Nothing -- XXX: is this ok?+ , namePrefix = Just "xmlns"+ } xmlns_atom_thread :: Attr xmlns_atom_thread = (qn, [ContentText atomThreadNS])@@ -96,10 +98,10 @@ Nothing -> Name {nameLocalName = "xmlns", nameNamespace = Nothing, namePrefix = Nothing} Just s -> Name- { nameLocalName = s- , nameNamespace = Nothing -- XXX: is this ok?- , namePrefix = Just "xmlns"- }+ { nameLocalName = s+ , nameNamespace = Nothing -- XXX: is this ok?+ , namePrefix = Just "xmlns"+ } atomName :: Text -> Name atomName nc = Name {nameLocalName = nc, nameNamespace = Just atomNS, namePrefix = atom_prefix}@@ -143,8 +145,11 @@ mb xmlLogo (feedLogo f) ++ mb xmlRights (feedRights f) ++ mb xmlSubtitle (feedSubtitle f) ++ map xmlEntry (feedEntries f) ++ feedOther f)- {elementAttributes = [xmlns_atom]}+ {elementAttributes = [xmlns_atom]} +textFeed :: Feed -> Maybe TL.Text+textFeed = U.renderFeed xmlFeed+ xmlEntry :: Entry -> XML.Element xmlEntry e = (atomNode "entry" $@@ -162,7 +167,7 @@ mb xmlSource (entrySource e) ++ mb xmlSummary (entrySummary e) ++ mb xmlInReplyTo (entryInReplyTo e) ++ mb xmlInReplyTotal (entryInReplyTotal e) ++ entryOther e)- {elementAttributes = entryAttrs e}+ {elementAttributes = entryAttrs e} xmlContent :: EntryContent -> XML.Element xmlContent cont =@@ -178,21 +183,21 @@ xmlCategory :: Category -> XML.Element xmlCategory c = (atomNode "category" (map NodeElement (catOther c)))- { elementAttributes =- [atomAttr "term" (catTerm c)] ++- mb (atomAttr "scheme") (catScheme c) ++ mb (atomAttr "label") (catLabel c)- }+ { elementAttributes =+ [atomAttr "term" (catTerm c)] +++ mb (atomAttr "scheme") (catScheme c) ++ mb (atomAttr "label") (catLabel c)+ } xmlLink :: Link -> XML.Element xmlLink l = (atomNode "link" (map NodeElement (linkOther l)))- { elementAttributes =- [atomAttr "href" (linkHref l)] ++- mb (atomAttr "rel" . either id id) (linkRel l) ++- mb (atomAttr "type") (linkType l) ++- mb (atomAttr "hreflang") (linkHrefLang l) ++- mb (atomAttr "title") (linkTitle l) ++ mb (atomAttr "length") (linkLength l) ++ linkAttrs l- }+ { elementAttributes =+ [atomAttr "href" (linkHref l)] +++ mb (atomAttr "rel" . either id id) (linkRel l) +++ mb (atomAttr "type") (linkType l) +++ mb (atomAttr "hreflang") (linkHrefLang l) +++ mb (atomAttr "title") (linkTitle l) ++ mb (atomAttr "length") (linkLength l) ++ linkAttrs l+ } xmlSource :: Source -> Element xmlSource s =@@ -213,7 +218,7 @@ xmlGenerator :: Generator -> Element xmlGenerator g = (atomLeaf "generator" (genText g))- {elementAttributes = mb (atomAttr "uri") (genURI g) ++ mb (atomAttr "version") (genVersion g)}+ {elementAttributes = mb (atomAttr "uri") (genURI g) ++ mb (atomAttr "version") (genVersion g)} xmlAuthor :: Person -> XML.Element xmlAuthor p = atomNode "author" (xmlPerson p)@@ -230,17 +235,17 @@ xmlInReplyTo :: InReplyTo -> XML.Element xmlInReplyTo irt = (atomThreadNode "in-reply-to" (replyToContent irt))- { elementAttributes =- mb (atomThreadAttr "ref") (Just $ replyToRef irt) ++- mb (atomThreadAttr "href") (replyToHRef irt) ++- mb (atomThreadAttr "type") (replyToType irt) ++- mb (atomThreadAttr "source") (replyToSource irt) ++ replyToOther irt- }+ { elementAttributes =+ mb (atomThreadAttr "ref") (Just $ replyToRef irt) +++ mb (atomThreadAttr "href") (replyToHRef irt) +++ mb (atomThreadAttr "type") (replyToType irt) +++ mb (atomThreadAttr "source") (replyToSource irt) ++ replyToOther irt+ } xmlInReplyTotal :: InReplyTotal -> XML.Element xmlInReplyTotal irt = (atomThreadLeaf "total" (pack $ show $ replyToTotal irt))- {elementAttributes = replyToTotalOther irt}+ {elementAttributes = replyToTotalOther irt} xmlId :: Text -> XML.Element xmlId = atomLeaf "id"
src/Text/Atom/Feed/Import.hs view
@@ -38,12 +38,11 @@ , pInReplyTo ) where -import Prelude () import Prelude.Compat -import Control.Monad (guard, mplus)-import Data.List (find)-import Data.Maybe (isJust, listToMaybe, mapMaybe)+import Control.Monad.Compat (guard, mplus)+import Data.List.Compat (find)+import Data.Maybe (isNothing, listToMaybe, mapMaybe) import Data.Text (Text) import Data.Text.Read import Data.XML.Types as XML@@ -75,7 +74,7 @@ pAttr x e = (`attributeText` e) =<< fst <$> find sameAttr (elementAttributes e) where ax = atomName x- sameAttr (k, _) = k == ax || (not (isJust (nameNamespace k)) && nameLocalName k == x)+ sameAttr (k, _) = k == ax || (isNothing (nameNamespace k) && nameLocalName k == x) pAttrs :: Text -> XML.Element -> [Text] pAttrs x e = [t | ContentText t <- cnts]@@ -103,25 +102,25 @@ u <- pLeaf "updated" es return Feed- { feedId = i- , feedTitle = t- , feedSubtitle = pTextContent "subtitle" es- , feedUpdated = u- , feedAuthors = pMany "author" pPerson es- , feedContributors = pMany "contributor" pPerson es- , feedCategories = pMany "category" pCategory es- , feedGenerator = pGenerator `fmap` pNode "generator" es- , feedIcon = pLeaf "icon" es- , feedLogo = pLeaf "logo" es- , feedRights = pTextContent "rights" es- , feedLinks = pMany "link" pLink es- , feedEntries = pMany "entry" pEntry es- , feedOther = other_es es- , feedAttrs = other_as (elementAttributes e)- }+ { feedId = i+ , feedTitle = t+ , feedSubtitle = pTextContent "subtitle" es+ , feedUpdated = u+ , feedAuthors = pMany "author" pPerson es+ , feedContributors = pMany "contributor" pPerson es+ , feedCategories = pMany "category" pCategory es+ , feedGenerator = pGenerator `fmap` pNode "generator" es+ , feedIcon = pLeaf "icon" es+ , feedLogo = pLeaf "logo" es+ , feedRights = pTextContent "rights" es+ , feedLinks = pMany "link" pLink es+ , feedEntries = pMany "entry" pEntry es+ , feedOther = other_es es+ , feedAttrs = other_as (elementAttributes e)+ } where- other_es = filter (\el -> not (elementName el `elem` known_elts))- other_as = filter (\a -> not (fst a `elem` known_attrs))+ other_es = filter ((`notElem` known_elts) . elementName)+ other_as = filter ((`notElem` known_attrs) . fst) -- let's have them all (including xml:base and xml:lang + xmlns: stuff) known_attrs = [] known_elts =@@ -162,22 +161,22 @@ name <- pLeaf "name" es -- or missing "name" return Person- { personName = name- , personURI = pLeaf "uri" es- , personEmail = pLeaf "email" es- , personOther = [] -- XXX?- }+ { personName = name+ , personURI = pLeaf "uri" es+ , personEmail = pLeaf "email" es+ , personOther = [] -- XXX?+ } pCategory :: XML.Element -> Maybe Category pCategory e = do term <- pAttr "term" e -- or missing "term" attribute return Category- { catTerm = term- , catScheme = pAttr "scheme" e- , catLabel = pAttr "label" e- , catOther = [] -- XXX?- }+ { catTerm = term+ , catScheme = pAttr "scheme" e+ , catLabel = pAttr "label" e+ , catOther = [] -- XXX?+ } pGenerator :: XML.Element -> Generator pGenerator e =@@ -186,37 +185,37 @@ pSource :: XML.Element -> Source pSource e = let es = children e- in Source- { sourceAuthors = pMany "author" pPerson es- , sourceCategories = pMany "category" pCategory es- , sourceGenerator = pGenerator `fmap` pNode "generator" es- , sourceIcon = pLeaf "icon" es- , sourceId = pLeaf "id" es- , sourceLinks = pMany "link" pLink es- , sourceLogo = pLeaf "logo" es- , sourceRights = pTextContent "rights" es- , sourceSubtitle = pTextContent "subtitle" es- , sourceTitle = pTextContent "title" es- , sourceUpdated = pLeaf "updated" es- , sourceOther = [] -- XXX ?- }+ in Source+ { sourceAuthors = pMany "author" pPerson es+ , sourceCategories = pMany "category" pCategory es+ , sourceGenerator = pGenerator `fmap` pNode "generator" es+ , sourceIcon = pLeaf "icon" es+ , sourceId = pLeaf "id" es+ , sourceLinks = pMany "link" pLink es+ , sourceLogo = pLeaf "logo" es+ , sourceRights = pTextContent "rights" es+ , sourceSubtitle = pTextContent "subtitle" es+ , sourceTitle = pTextContent "title" es+ , sourceUpdated = pLeaf "updated" es+ , sourceOther = [] -- XXX ?+ } pLink :: XML.Element -> Maybe Link pLink e = do uri <- pAttr "href" e return Link- { linkHref = uri- , linkRel = Right `fmap` pAttr "rel" e- , linkType = pAttr "type" e- , linkHrefLang = pAttr "hreflang" e- , linkTitle = pAttr "title" e- , linkLength = pAttr "length" e- , linkAttrs = other_as (elementAttributes e)- , linkOther = []- }+ { linkHref = uri+ , linkRel = Right `fmap` pAttr "rel" e+ , linkType = pAttr "type" e+ , linkHrefLang = pAttr "hreflang" e+ , linkTitle = pAttr "title" e+ , linkLength = pAttr "length" e+ , linkAttrs = other_as (elementAttributes e)+ , linkOther = []+ } where- other_as = filter (\a -> not (fst a `elem` known_attrs))+ other_as = filter ((`notElem` known_attrs) . fst) known_attrs = map atomName ["href", "rel", "type", "hreflang", "title", "length"] pEntry :: XML.Element -> Maybe Entry@@ -227,25 +226,25 @@ u <- pLeaf "updated" es `mplus` pLeaf "published" es return Entry- { entryId = i- , entryTitle = t- , entryUpdated = u- , entryAuthors = pMany "author" pPerson es- , entryContributor = pMany "contributor" pPerson es- , entryCategories = pMany "category" pCategory es- , entryContent = pContent =<< pNode "content" es- , entryLinks = pMany "link" pLink es- , entryPublished = pLeaf "published" es- , entryRights = pTextContent "rights" es- , entrySource = pSource `fmap` pNode "source" es- , entrySummary = pTextContent "summary" es- , entryInReplyTo = pInReplyTo es- , entryInReplyTotal = pInReplyTotal es- , entryAttrs = other_as (elementAttributes e)- , entryOther = [] -- ?- }+ { entryId = i+ , entryTitle = t+ , entryUpdated = u+ , entryAuthors = pMany "author" pPerson es+ , entryContributor = pMany "contributor" pPerson es+ , entryCategories = pMany "category" pCategory es+ , entryContent = pContent =<< pNode "content" es+ , entryLinks = pMany "link" pLink es+ , entryPublished = pLeaf "published" es+ , entryRights = pTextContent "rights" es+ , entrySource = pSource `fmap` pNode "source" es+ , entrySummary = pTextContent "summary" es+ , entryInReplyTo = pInReplyTo es+ , entryInReplyTotal = pInReplyTotal es+ , entryAttrs = other_as (elementAttributes e)+ , entryOther = [] -- ?+ } where- other_as = filter (\a -> not (fst a `elem` known_attrs))+ other_as = filter ((`notElem` known_attrs) . fst) -- let's have them all (including xml:base and xml:lang + xmlns: stuff) known_attrs = [] @@ -281,11 +280,11 @@ Just ref -> return InReplyTo- { replyToRef = ref- , replyToHRef = pQAttr (atomThreadName "href") t- , replyToType = pQAttr (atomThreadName "type") t- , replyToSource = pQAttr (atomThreadName "source") t- , replyToOther = elementAttributes t -- ToDo: snip out matched ones.- , replyToContent = elementNodes t- }+ { replyToRef = ref+ , replyToHRef = pQAttr (atomThreadName "href") t+ , replyToType = pQAttr (atomThreadName "type") t+ , replyToSource = pQAttr (atomThreadName "source") t+ , replyToOther = elementAttributes t -- ToDo: snip out matched ones.+ , replyToContent = elementNodes t+ } _ -> fail "no parse"
src/Text/Atom/Feed/Link.hs view
@@ -16,7 +16,6 @@ , showLinkAttr ) where -import Prelude () import Prelude.Compat -- | Atom feeds uses typed IRI links to represent
src/Text/Atom/Feed/Validate.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ -------------------------------------------------------------------- -- | -- Module : Text.Atom.Feed.Validate@@ -42,7 +44,6 @@ , checkUri ) where -import Prelude () import Prelude.Compat import Data.XML.Types@@ -149,16 +150,16 @@ xs -> case map fst $ filter (\(_, n) -> n == "alternate") $- mapMaybe (\ex -> (\x -> (ex, x)) <$> pAttr "rel" ex) xs of+ mapMaybe (\ex -> (ex,) <$> pAttr "rel" ex) xs of xs1 -> let jmb (Just x) (Just y) = Just (x, y) jmb _ _ = Nothing- in case mapMaybe (\ex -> pAttr "type" ex `jmb` pAttr "hreflang" ex) xs1 of- xs2 ->- if any (\x -> length x > 1) (group xs2)- then demand- "An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements"- else valid+ in case mapMaybe (\ex -> pAttr "type" ex `jmb` pAttr "hreflang" ex) xs1 of+ xs2 ->+ if any (\x -> length x > 1) (group xs2)+ then demand+ "An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements"+ else valid checkId :: Element -> ValidatorResult checkId e =
src/Text/Atom/Pub.hs view
@@ -20,7 +20,6 @@ , Accept(..) ) where -import Prelude () import Prelude.Compat import Data.Text (Text)
src/Text/Atom/Pub/Export.hs view
@@ -27,14 +27,12 @@ , xmlAccept ) where -import Prelude () import Prelude.Compat import Data.Text (Text) import Data.XML.Compat import Data.XML.Types-import Text.Atom.Feed.Export- (mb, xmlCategory, xmlTitle, xmlns_atom)+import Text.Atom.Feed.Export (mb, xmlCategory, xmlTitle, xmlns_atom) import Text.Atom.Pub -- ToDo: old crud; inline away.@@ -61,7 +59,7 @@ mkElem (appName "service") [xmlns_app, xmlns_atom]- (concat [map xmlWorkspace (serviceWorkspaces s), serviceOther s])+ (map xmlWorkspace (serviceWorkspaces s) ++ serviceOther s) xmlWorkspace :: Workspace -> Element xmlWorkspace w =@@ -87,17 +85,15 @@ xmlCategories (Categories mbFixed mbScheme cs) = mkElem (appName "categories")- (concat- [ mb- (\f ->- mkAttr- "fixed"- (if f- then "yes"- else "no"))- mbFixed- , mb (mkAttr "scheme") mbScheme- ])+ (mb+ (\f ->+ mkAttr+ "fixed"+ (if f+ then "yes"+ else "no"))+ mbFixed +++ mb (mkAttr "scheme") mbScheme) (map xmlCategory cs) xmlAccept :: Accept -> Element
src/Text/DublinCore/Types.hs view
@@ -19,7 +19,6 @@ , dc_element_names ) where -import Prelude () import Prelude.Compat import Data.Text
src/Text/Feed/Constructor.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS -fno-warn-incomplete-patterns #-}+ -------------------------------------------------------------------- -- | -- Module : Text.Feed.Constructor@@ -52,7 +54,6 @@ , withItemRights -- :: ItemSetter Text ) where -import Prelude () import Prelude.Compat import Text.Feed.Types as Feed.Types@@ -88,10 +89,10 @@ "dummy-and-bogus-update-date") RSSKind mbV -> let def = RSS.nullRSS "dummy-title" "default-channel-url"- in RSSFeed $ fromMaybe def $ fmap (\v -> def {RSS.rssVersion = v}) mbV+ in RSSFeed $ maybe def (\v -> def {RSS.rssVersion = v}) mbV RDFKind mbV -> let def = RSS1.nullFeed "default-channel-url" "dummy-title"- in RSS1Feed $ fromMaybe def $ fmap (\v -> def {RSS1.feedVersion = v}) mbV+ in RSS1Feed $ maybe def (\v -> def {RSS1.feedVersion = v}) mbV feedFromRSS :: RSS.RSS -> Feed.Types.Feed feedFromRSS = RSSFeed@@ -280,17 +281,18 @@ case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of (as, dci:bs) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}+ } (_, []) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f)- { RSS1.channelDC =- DCItem {dcElt = DC_Date, dcText = dateStr} : RSS1.channelDC (RSS1.feedChannel f)- }- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f)+ { RSS1.channelDC =+ DCItem {dcElt = DC_Date, dcText = dateStr} :+ RSS1.channelDC (RSS1.feedChannel f)+ }+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -319,17 +321,18 @@ case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of (as, dci:bs) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}+ } (_, []) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f)- { RSS1.channelDC =- DCItem {dcElt = DC_Date, dcText = dateStr} : RSS1.channelDC (RSS1.feedChannel f)- }- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f)+ { RSS1.channelDC =+ DCItem {dcElt = DC_Date, dcText = dateStr} :+ RSS1.channelDC (RSS1.feedChannel f)+ }+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -362,15 +365,15 @@ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f- { rssChannel =- (rssChannel f) {rssImage = Just $ RSS.nullImage imgURL (rssTitle (rssChannel f)) lnk}- }+ { rssChannel =+ (rssChannel f) {rssImage = Just $ RSS.nullImage imgURL (rssTitle (rssChannel f)) lnk}+ } Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $ f- { feedImage = Just $ RSS1.nullImage imgURL (RSS1.channelTitle (RSS1.feedChannel f)) lnk- , feedChannel = (feedChannel f) {channelImageURI = Just imgURL}- }+ { feedImage = Just $ RSS1.nullImage imgURL (RSS1.channelTitle (RSS1.feedChannel f)) lnk+ , feedChannel = (feedChannel f) {channelImageURI = Just imgURL}+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -408,17 +411,18 @@ case break isLang $ RSS1.channelDC (RSS1.feedChannel f) of (as, dci:bs) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = lang} : bs}- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = lang} : bs}+ } (_, []) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f)- { RSS1.channelDC =- DCItem {dcElt = DC_Language, dcText = lang} : RSS1.channelDC (RSS1.feedChannel f)- }- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f)+ { RSS1.channelDC =+ DCItem {dcElt = DC_Language, dcText = lang} :+ RSS1.channelDC (RSS1.feedChannel f)+ }+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -442,29 +446,29 @@ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f- { Atom.feedCategories =- map (\(t, mb) -> (Atom.newCategory t) {Atom.catScheme = mb}) cats ++ feedCategories f- }+ { Atom.feedCategories =+ map (\(t, mb) -> (Atom.newCategory t) {Atom.catScheme = mb}) cats ++ feedCategories f+ } Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f- { rssChannel =- (rssChannel f)- { RSS.rssCategories =- map (\(t, mb) -> (RSS.newCategory t) {RSS.rssCategoryDomain = mb}) cats ++- RSS.rssCategories (rssChannel f)- }- }+ { rssChannel =+ (rssChannel f)+ { RSS.rssCategories =+ map (\(t, mb) -> (RSS.newCategory t) {RSS.rssCategoryDomain = mb}) cats +++ RSS.rssCategories (rssChannel f)+ }+ } Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f- { feedChannel =- (feedChannel f)- { RSS1.channelDC =- map (\(t, _) -> DCItem {dcElt = DC_Subject, dcText = t}) cats ++- RSS1.channelDC (feedChannel f)- }- }+ { feedChannel =+ (feedChannel f)+ { RSS1.channelDC =+ map (\(t, _) -> DCItem {dcElt = DC_Subject, dcText = t}) cats +++ RSS1.channelDC (feedChannel f)+ }+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -476,10 +480,7 @@ addChild (unode "category"- (fromMaybe- (: [])- (fmap (\ v x -> [mkAttr "domain" v, x]) mb)- (mkAttr "term" t)))+ (maybe (: []) (\v x -> [mkAttr "domain" v, x]) mb (mkAttr "term" t))) acc) e cats)@@ -499,15 +500,17 @@ case break isSource $ RSS1.channelDC (RSS1.feedChannel f) of (as, dci:bs) -> f- {RSS1.feedChannel = (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = gen} : bs}}+ { RSS1.feedChannel =+ (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = gen} : bs}+ } (_, []) -> f- { RSS1.feedChannel =- (RSS1.feedChannel f)- { RSS1.channelDC =- DCItem {dcElt = DC_Source, dcText = gen} : RSS1.channelDC (RSS1.feedChannel f)- }- }+ { RSS1.feedChannel =+ (RSS1.feedChannel f)+ { RSS1.channelDC =+ DCItem {dcElt = DC_Source, dcText = gen} : RSS1.channelDC (RSS1.feedChannel f)+ }+ } Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $ mapMaybeChildren@@ -601,9 +604,9 @@ Feed.Types.AtomItem e -> Feed.Types.AtomItem e- { Atom.entrySource =- Just Atom.nullSource {sourceId = Just url, sourceTitle = Just (TextString tit)}- }+ { Atom.entrySource =+ Just Atom.nullSource {sourceId = Just url, sourceTitle = Just (TextString tit)}+ } Feed.Types.RSSItem i -> Feed.Types.RSSItem i {RSS.rssItemSource = Just (RSS.nullSource url tit)} Feed.Types.RSS1Item i -> Feed.Types.RSS1Item i {RSS1.itemTitle = tit} Feed.Types.XMLItem i ->@@ -638,28 +641,28 @@ Feed.Types.AtomItem e -> Feed.Types.AtomItem e- { Atom.entryLinks =- ((nullLink url)- { linkRel = Just (Left "enclosure")- , linkType = ty- , linkLength = fmap (pack . show) mb_len- }) :- Atom.entryLinks e- }+ { Atom.entryLinks =+ ((nullLink url)+ { linkRel = Just (Left "enclosure")+ , linkType = ty+ , linkLength = fmap (pack . show) mb_len+ }) :+ Atom.entryLinks e+ } Feed.Types.RSSItem i -> Feed.Types.RSSItem i {RSS.rssItemEnclosure = Just (nullEnclosure url mb_len (fromMaybe "text/html" ty))} Feed.Types.RSS1Item i -> Feed.Types.RSS1Item i- { RSS1.itemContent =- nullContentInfo {contentURI = Just url, contentFormat = ty} : RSS1.itemContent i- }+ { RSS1.itemContent =+ nullContentInfo {contentURI = Just url, contentFormat = ty} : RSS1.itemContent i+ } Feed.Types.XMLItem i -> Feed.Types.XMLItem $ addChild ((unode "enclosure" url)- {elementAttributes = [mkAttr "length" "0", mkAttr "type" (fromMaybe "text/html" ty)]}) $+ {elementAttributes = [mkAttr "length" "0", mkAttr "type" (fromMaybe "text/html" ty)]}) $ filterChildren (\e -> elementName e /= "enclosure") i -- | 'withItemId isURL id' associates new unique identifier with a feed item.@@ -746,33 +749,28 @@ Feed.Types.AtomItem e -> Feed.Types.AtomItem e- { Atom.entryCategories =- map (\(t, mb) -> (Atom.newCategory t) {Atom.catScheme = mb}) cats ++ entryCategories e- }+ { Atom.entryCategories =+ map (\(t, mb) -> (Atom.newCategory t) {Atom.catScheme = mb}) cats ++ entryCategories e+ } Feed.Types.RSSItem i -> Feed.Types.RSSItem i- { RSS.rssItemCategories =- map (\(t, mb) -> (RSS.newCategory t) {RSS.rssCategoryDomain = mb}) cats ++- rssItemCategories i- }+ { RSS.rssItemCategories =+ map (\(t, mb) -> (RSS.newCategory t) {RSS.rssCategoryDomain = mb}) cats +++ rssItemCategories i+ } Feed.Types.RSS1Item i -> Feed.Types.RSS1Item i- { RSS1.itemDC =- map (\(t, _) -> DCItem {dcElt = DC_Subject, dcText = t}) cats ++ RSS1.itemDC i- }+ { RSS1.itemDC =+ map (\(t, _) -> DCItem {dcElt = DC_Subject, dcText = t}) cats ++ RSS1.itemDC i+ } Feed.Types.XMLItem i -> Feed.Types.XMLItem $ foldr (\(t, mb) acc -> addChild- (unode- "category"- (fromMaybe- (: [])- (fmap (\ v x -> [mkAttr "domain" v, x]) mb)- (mkAttr "term" t)))+ (unode "category" (maybe (: []) (\v x -> [mkAttr "domain" v, x]) mb (mkAttr "term" t))) acc) i cats
src/Text/Feed/Export.hs view
@@ -13,18 +13,20 @@ -------------------------------------------------------------------- module Text.Feed.Export ( Text.Feed.Export.xmlFeed -- :: Feed -> XML.Element+ , Text.Feed.Export.textFeed -- :: Feed -> TL.Text ) where -import Prelude ()-import Prelude.Compat ()+import Prelude.Compat import Text.Feed.Types import Text.Atom.Feed.Export as Atom import Text.RSS.Export as RSS import Text.RSS1.Export as RSS1+import qualified Data.Text.Util as U import Data.XML.Types as XML+import qualified Data.Text.Lazy as TL -- | 'xmlFeed f' serializes a @Feed@ document into a conforming -- XML toplevel element.@@ -35,3 +37,6 @@ RSSFeed f -> RSS.xmlRSS f RSS1Feed f -> RSS1.xmlFeed f XMLFeed e -> e -- that was easy!++textFeed :: Feed -> Maybe TL.Text+textFeed = U.renderFeed Text.Feed.Export.xmlFeed
src/Text/Feed/Import.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE CPP #-} - -------------------------------------------------------------------- -- | -- Module : Text.Feed.Import@@ -27,7 +26,6 @@ , readAtom -- :: XML.Element -> Maybe Feed ) where -import Prelude () import Prelude.Compat import Control.Exception@@ -41,7 +39,7 @@ import Text.RSS.Import as RSS import Text.RSS1.Import as RSS1 -import Control.Monad+import Control.Monad.Compat import qualified Text.XML as C #if MIN_VERSION_utf8_string(1,0,0)@@ -56,7 +54,6 @@ utf8readFile :: FilePath -> IO String utf8readFile = UTF8.readFile #endif- class FeedSource s where parseFeedSourceXML :: s -> Either SomeException C.Document @@ -86,10 +83,8 @@ parseFeedWithParser parser str = case parser str of Left _ -> Nothing- Right d ->- readAtom e `mplus` readRSS2 e `mplus` readRSS1 e `mplus` Just (XMLFeed e)- where- e = C.toXMLElement $ C.documentRoot d+ Right d -> readAtom e `mplus` readRSS2 e `mplus` readRSS1 e `mplus` Just (XMLFeed e)+ where e = C.toXMLElement $ C.documentRoot d parseFeedString :: String -> Maybe Feed parseFeedString = parseFeedSource
src/Text/Feed/Query.hs view
@@ -45,7 +45,6 @@ , getItemDescription -- :: ItemGetter Text (synonym of previous.) ) where -import Prelude () import Prelude.Compat import Text.Feed.Types as Feed@@ -62,7 +61,7 @@ import Control.Applicative ((<|>)) import Control.Arrow ((&&&))-import Control.Monad (mplus)+import Control.Monad.Compat (mplus) import Data.Maybe import Data.Text (Text) import qualified Data.Text as T@@ -72,8 +71,7 @@ import qualified Data.Time.Format as F -- for getItemPublishDate rfc822 date parsing.-import Data.Time.Locale.Compat- (defaultTimeLocale, iso8601DateFormat, rfc822DateFormat)+import Data.Time.Locale.Compat (defaultTimeLocale, iso8601DateFormat, rfc822DateFormat) feedItems :: Feed.Feed -> [Feed.Item] feedItems fe =@@ -143,7 +141,7 @@ where isSelf lr = let rel = Atom.linkRel lr- in (isNothing rel || toStr rel == "alternate") && isHTMLType (linkType lr)+ in (isNothing rel || toStr rel == "alternate") && isHTMLType (linkType lr) isHTMLType (Just str) = "html" `T.isSuffixOf` str isHTMLType _ = True -- if none given, assume html. @@ -275,7 +273,7 @@ where isSelf lr = let rel = Atom.linkRel lr- in (isNothing rel || toStr rel == "alternate") && isHTMLType (linkType lr)+ in (isNothing rel || toStr rel == "alternate") && isHTMLType (linkType lr) isHTMLType (Just str) = "html" `T.isSuffixOf` str isHTMLType _ = True -- if none given, assume html.
src/Text/Feed/Translate.hs view
@@ -18,7 +18,6 @@ , withRSS1Item -- :: (RSS1.Item -> RSS1.Item) -> Item -> Item ) where -import Prelude () import Prelude.Compat import Control.Arrow ((&&&))@@ -75,11 +74,10 @@ XMLItem {} -> error "toAtomItem: unimplemented (from shallow XML rep.)" Feed.RSSItem ri -> foldl (\oi f -> f oi) outIt pipeline_rss_atom where outIt =- flip- withAtomEntry- (newItem AtomKind)+ withAtomEntry (\e -> e {Atom.entryOther = RSS.rssItemOther ri, Atom.entryAttrs = RSS.rssItemAttrs ri})+ (newItem AtomKind) pipeline_rss_atom = [ mb withItemTitle (rssItemTitle ri) , mb withItemLink (rssItemLink ri)
src/Text/Feed/Types.hs view
@@ -16,7 +16,6 @@ , FeedKind(..) ) where -import Prelude () import Prelude.Compat import Data.Text
src/Text/Feed/Util.hs view
@@ -15,7 +15,6 @@ , toFeedDateStringUTC ) where -import Prelude () import Prelude.Compat import Data.Time (UTCTime, formatTime)
src/Text/RSS/Export.hs view
@@ -14,6 +14,7 @@ ( qualNode , qualName , xmlRSS+ , textRSS , xmlChannel , xmlItem , xmlSource@@ -30,14 +31,15 @@ , mb ) where -import Prelude () import Prelude.Compat import Data.XML.Compat import Data.XML.Types as XML import Text.RSS.Syntax+import qualified Data.Text.Util as U import Data.Text (Text, pack)+import qualified Data.Text.Lazy as TL qualName :: Text -> XML.Name qualName n = Name n Nothing Nothing@@ -49,32 +51,36 @@ xmlRSS :: RSS -> XML.Element xmlRSS r = (qualNode "rss" $ map NodeElement (xmlChannel (rssChannel r) : rssOther r))- {elementAttributes = mkAttr "version" (rssVersion r) : rssAttrs r}+ {elementAttributes = mkAttr "version" (rssVersion r) : rssAttrs r} +textRSS :: RSS -> Maybe TL.Text+textRSS = U.renderFeed xmlRSS+ xmlChannel :: RSSChannel -> XML.Element xmlChannel ch = qualNode "channel" $- map NodeElement- ([ xmlLeaf "title" (rssTitle ch)- , xmlLeaf "link" (rssLink ch)- , xmlLeaf "description" (rssDescription ch)- ] ++- map xmlItem (rssItems ch) ++- mb (xmlLeaf "language") (rssLanguage ch) ++- mb (xmlLeaf "copyright") (rssCopyright ch) ++- mb (xmlLeaf "managingEditor") (rssEditor ch) ++- mb (xmlLeaf "webMaster") (rssWebMaster ch) ++- mb (xmlLeaf "pubDate") (rssPubDate ch) ++- mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch) ++- map xmlCategory (rssCategories ch) ++- mb (xmlLeaf "generator") (rssGenerator ch) ++- mb (xmlLeaf "docs") (rssDocs ch) ++- mb xmlCloud (rssCloud ch) ++- mb (xmlLeaf "ttl" . pack . show) (rssTTL ch) ++- mb xmlImage (rssImage ch) ++- mb (xmlLeaf "rating") (rssRating ch) ++- mb xmlTextInput (rssTextInput ch) ++- mb xmlSkipHours (rssSkipHours ch) ++ mb xmlSkipDays (rssSkipDays ch) ++ rssChannelOther ch)+ map+ NodeElement+ ([ xmlLeaf "title" (rssTitle ch)+ , xmlLeaf "link" (rssLink ch)+ , xmlLeaf "description" (rssDescription ch)+ ] +++ map xmlItem (rssItems ch) +++ mb (xmlLeaf "language") (rssLanguage ch) +++ mb (xmlLeaf "copyright") (rssCopyright ch) +++ mb (xmlLeaf "managingEditor") (rssEditor ch) +++ mb (xmlLeaf "webMaster") (rssWebMaster ch) +++ mb (xmlLeaf "pubDate") (rssPubDate ch) +++ mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch) +++ map xmlCategory (rssCategories ch) +++ mb (xmlLeaf "generator") (rssGenerator ch) +++ mb (xmlLeaf "docs") (rssDocs ch) +++ mb xmlCloud (rssCloud ch) +++ mb (xmlLeaf "ttl" . pack . show) (rssTTL ch) +++ mb xmlImage (rssImage ch) +++ mb (xmlLeaf "rating") (rssRating ch) +++ mb xmlTextInput (rssTextInput ch) +++ mb xmlSkipHours (rssSkipHours ch) ++ mb xmlSkipDays (rssSkipDays ch) ++ rssChannelOther ch) xmlItem :: RSSItem -> XML.Element xmlItem it =@@ -91,37 +97,39 @@ mb xmlGuid (rssItemGuid it) ++ mb (xmlLeaf "pubDate") (rssItemPubDate it) ++ mb xmlSource (rssItemSource it) ++ rssItemOther it))- {elementAttributes = rssItemAttrs it}+ {elementAttributes = rssItemAttrs it} xmlSource :: RSSSource -> XML.Element xmlSource s = (xmlLeaf "source" (rssSourceTitle s))- {elementAttributes = mkAttr "url" (rssSourceURL s) : rssSourceAttrs s}+ {elementAttributes = mkAttr "url" (rssSourceURL s) : rssSourceAttrs s} xmlEnclosure :: RSSEnclosure -> XML.Element xmlEnclosure e = (xmlLeaf "enclosure" "")- { elementAttributes =- mkAttr "url" (rssEnclosureURL e) :- mkAttr "type" (rssEnclosureType e) :- mb (mkAttr "length" . pack . show) (rssEnclosureLength e) ++ rssEnclosureAttrs e- }+ { elementAttributes =+ mkAttr "url" (rssEnclosureURL e) :+ mkAttr "type" (rssEnclosureType e) :+ mb (mkAttr "length" . pack . show) (rssEnclosureLength e) ++ rssEnclosureAttrs e+ } xmlCategory :: RSSCategory -> XML.Element xmlCategory c = (xmlLeaf "category" (rssCategoryValue c))- { elementAttributes =- maybe id (\n -> (mkAttr "domain" n :)) (rssCategoryDomain c)- (rssCategoryAttrs c)- }+ { elementAttributes =+ maybe id (\n -> (mkAttr "domain" n :)) (rssCategoryDomain c) (rssCategoryAttrs c)+ } xmlGuid :: RSSGuid -> XML.Element xmlGuid g = (xmlLeaf "guid" (rssGuidValue g))- { elementAttributes =- maybe id (\n -> (mkAttr "isPermaLink" (toBool n) :)) (rssGuidPermanentURL g)- (rssGuidAttrs g)- }+ { elementAttributes =+ maybe+ id+ (\n -> (mkAttr "isPermaLink" (toBool n) :))+ (rssGuidPermanentURL g)+ (rssGuidAttrs g)+ } where toBool False = "false" toBool _ = "true"@@ -129,25 +137,26 @@ xmlImage :: RSSImage -> XML.Element xmlImage im = qualNode "image" $- map NodeElement- ([ xmlLeaf "url" (rssImageURL im)- , xmlLeaf "title" (rssImageTitle im)- , xmlLeaf "link" (rssImageLink im)- ] ++- mb (xmlLeaf "width" . pack . show) (rssImageWidth im) ++- mb (xmlLeaf "height" . pack . show) (rssImageHeight im) ++- mb (xmlLeaf "description") (rssImageDesc im) ++ rssImageOther im)+ map+ NodeElement+ ([ xmlLeaf "url" (rssImageURL im)+ , xmlLeaf "title" (rssImageTitle im)+ , xmlLeaf "link" (rssImageLink im)+ ] +++ mb (xmlLeaf "width" . pack . show) (rssImageWidth im) +++ mb (xmlLeaf "height" . pack . show) (rssImageHeight im) +++ mb (xmlLeaf "description") (rssImageDesc im) ++ rssImageOther im) xmlCloud :: RSSCloud -> XML.Element xmlCloud cl = (xmlLeaf "cloud" "")- { elementAttributes =- mb (mkAttr "domain") (rssCloudDomain cl) ++- mb (mkAttr "port") (rssCloudPort cl) ++- mb (mkAttr "path") (rssCloudPath cl) ++- mb (mkAttr "registerProcedure") (rssCloudRegisterProcedure cl) ++- mb (mkAttr "protocol") (rssCloudProtocol cl) ++ rssCloudAttrs cl- }+ { elementAttributes =+ mb (mkAttr "domain") (rssCloudDomain cl) +++ mb (mkAttr "port") (rssCloudPort cl) +++ mb (mkAttr "path") (rssCloudPath cl) +++ mb (mkAttr "registerProcedure") (rssCloudRegisterProcedure cl) +++ mb (mkAttr "protocol") (rssCloudProtocol cl) ++ rssCloudAttrs cl+ } xmlTextInput :: RSSTextInput -> XML.Element xmlTextInput ti =@@ -160,7 +169,7 @@ , xmlLeaf "link" (rssTextInputLink ti) ] ++ rssTextInputOther ti))- {elementAttributes = rssTextInputAttrs ti}+ {elementAttributes = rssTextInputAttrs ti} xmlSkipHours :: [Integer] -> XML.Element xmlSkipHours hs =@@ -175,10 +184,10 @@ xmlLeaf :: Text -> Text -> XML.Element xmlLeaf tg txt = Element- { elementAttributes = []- , elementName = Name tg Nothing Nothing- , elementNodes = [NodeContent (ContentText txt)]- }+ { elementAttributes = []+ , elementName = Name tg Nothing Nothing+ , elementNodes = [NodeContent (ContentText txt)]+ } --- mb :: (a -> b) -> Maybe a -> [b]
src/Text/RSS/Import.hs view
@@ -39,7 +39,6 @@ , readBool ) where -import Prelude () import Prelude.Compat import Data.XML.Compat@@ -48,7 +47,7 @@ import Text.RSS.Syntax import Text.RSS1.Utils (dcNS, dcPrefix) -import Control.Monad (guard, mplus)+import Control.Monad.Compat (guard, mplus) import Data.Char (isSpace) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Text (Text, dropWhile)@@ -96,11 +95,11 @@ ch <- pNode "channel" es >>= elementToChannel return RSS- { rssVersion = v- , rssAttrs = filter (\a -> not (fst a `elem` known_attrs)) as- , rssChannel = ch- , rssOther = filter (\e1 -> elementName e1 /= qualName "channel") es- }+ { rssVersion = v+ , rssAttrs = filter ((`notElem` known_attrs) . fst) as+ , rssChannel = ch+ , rssOther = filter (\e1 -> elementName e1 /= qualName "channel") es+ } where known_attrs = ["version"] @@ -112,29 +111,29 @@ link <- pLeaf "link" es return RSSChannel- { rssTitle = title- , rssLink = link+ { rssTitle = title+ , rssLink = link -- being liberal, <description/> is a required channel element.- , rssDescription = fromMaybe title (pLeaf "description" es)- , rssItems = pMany "item" elementToItem es- , rssLanguage = pLeaf "language" es `mplus` pQLeaf (dcName "lang") es- , rssCopyright = pLeaf "copyright" es- , rssEditor = pLeaf "managingEditor" es `mplus` pQLeaf (dcName "creator") es- , rssWebMaster = pLeaf "webMaster" 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 `mplus` pQLeaf (dcName "source") es- , rssDocs = pLeaf "docs" es- , rssCloud = pNode "cloud" es >>= elementToCloud- , rssTTL = pLeaf "ttl" es >>= readInt- , rssImage = pNode "image" es >>= elementToImage- , rssRating = pLeaf "rating" es- , rssTextInput = pNode "textInput" es >>= elementToTextInput- , rssSkipHours = pNode "skipHours" es >>= elementToSkipHours- , rssSkipDays = pNode "skipDays" es >>= elementToSkipDays- , rssChannelOther = filter (\e1 -> not (elementName e1 `elem` known_channel_elts)) es- }+ , rssDescription = fromMaybe title (pLeaf "description" es)+ , rssItems = pMany "item" elementToItem es+ , rssLanguage = pLeaf "language" es `mplus` pQLeaf (dcName "lang") es+ , rssCopyright = pLeaf "copyright" es+ , rssEditor = pLeaf "managingEditor" es `mplus` pQLeaf (dcName "creator") es+ , rssWebMaster = pLeaf "webMaster" 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 `mplus` pQLeaf (dcName "source") es+ , rssDocs = pLeaf "docs" es+ , rssCloud = pNode "cloud" es >>= elementToCloud+ , rssTTL = pLeaf "ttl" es >>= readInt+ , rssImage = pNode "image" es >>= elementToImage+ , rssRating = pLeaf "rating" es+ , rssTextInput = pNode "textInput" es >>= elementToTextInput+ , rssSkipHours = pNode "skipHours" es >>= elementToSkipHours+ , rssSkipDays = pNode "skipDays" es >>= elementToSkipDays+ , rssChannelOther = filter ((`notElem` known_channel_elts) . elementName) es+ } where known_channel_elts = map@@ -170,14 +169,14 @@ link <- pLeaf "link" es return RSSImage- { rssImageURL = url- , rssImageTitle = title- , rssImageLink = link- , rssImageWidth = pLeaf "width" es >>= readInt- , rssImageHeight = pLeaf "height" es >>= readInt- , rssImageDesc = pLeaf "description" es- , rssImageOther = filter (\e1 -> not (elementName e1 `elem` known_image_elts)) es- }+ { rssImageURL = url+ , rssImageTitle = title+ , rssImageLink = link+ , rssImageWidth = pLeaf "width" es >>= readInt+ , rssImageHeight = pLeaf "height" es >>= readInt+ , rssImageDesc = pLeaf "description" es+ , rssImageOther = filter ((`notElem` known_image_elts) . elementName) es+ } where known_image_elts = map qualName ["url", "title", "link", "width", "height", "description"] @@ -187,10 +186,10 @@ let as = elementAttributes e return RSSCategory- { rssCategoryDomain = pAttr "domain" e- , rssCategoryAttrs = filter (\a -> not (nameLocalName (attrKey a) `elem` known_attrs)) as- , rssCategoryValue = strContent e- }+ { rssCategoryDomain = pAttr "domain" e+ , rssCategoryAttrs = filter ((`notElem` known_attrs) . nameLocalName . attrKey) as+ , rssCategoryValue = strContent e+ } where known_attrs = ["domain"] @@ -200,13 +199,13 @@ let as = elementAttributes e return RSSCloud- { rssCloudDomain = pAttr "domain" e- , rssCloudPort = pAttr "port" e- , rssCloudPath = pAttr "path" e- , rssCloudRegisterProcedure = pAttr "registerProcedure" e- , rssCloudProtocol = pAttr "protocol" e- , rssCloudAttrs = filter (\a -> not (nameLocalName (attrKey a) `elem` known_attrs)) as- }+ { rssCloudDomain = pAttr "domain" e+ , rssCloudPort = pAttr "port" e+ , rssCloudPath = pAttr "path" e+ , rssCloudRegisterProcedure = pAttr "registerProcedure" e+ , rssCloudProtocol = pAttr "protocol" e+ , rssCloudAttrs = filter ((`notElem` known_attrs) . nameLocalName . attrKey) as+ } where known_attrs = ["domain", "port", "path", "registerProcedure", "protocol"] @@ -216,19 +215,19 @@ let es = children e return RSSItem- { rssItemTitle = pLeaf "title" es- , rssItemLink = pLeaf "link" es- , rssItemDescription = pLeaf "description" 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 `mplus` pQLeaf (dcName "date") es- , rssItemSource = pNode "source" es >>= elementToSource- , rssItemAttrs = elementAttributes e- , rssItemOther = filter (\e1 -> not (elementName e1 `elem` known_item_elts)) es- }+ { rssItemTitle = pLeaf "title" es+ , rssItemLink = pLeaf "link" es+ , rssItemDescription = pLeaf "description" 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 `mplus` pQLeaf (dcName "date") es+ , rssItemSource = pNode "source" es >>= elementToSource+ , rssItemAttrs = elementAttributes e+ , rssItemOther = filter ((`notElem` known_item_elts) . elementName) es+ } where known_item_elts = map@@ -252,10 +251,10 @@ url <- pAttr "url" e return RSSSource- { rssSourceURL = url- , rssSourceAttrs = filter (\a -> not (nameLocalName (attrKey a) `elem` known_attrs)) as- , rssSourceTitle = strContent e- }+ { rssSourceURL = url+ , rssSourceAttrs = filter ((`notElem` known_attrs) . nameLocalName . attrKey) as+ , rssSourceTitle = strContent e+ } where known_attrs = ["url"] @@ -267,11 +266,11 @@ ty <- pAttr "type" e return RSSEnclosure- { rssEnclosureURL = url- , rssEnclosureType = ty- , rssEnclosureLength = pAttr "length" e >>= readInt- , rssEnclosureAttrs = filter (\a -> not (nameLocalName (attrKey a) `elem` known_attrs)) as- }+ { rssEnclosureURL = url+ , rssEnclosureType = ty+ , rssEnclosureLength = pAttr "length" e >>= readInt+ , rssEnclosureAttrs = filter ((`notElem` known_attrs) . nameLocalName . attrKey) as+ } where known_attrs = ["url", "type", "length"] @@ -281,10 +280,10 @@ let as = elementAttributes e return RSSGuid- { rssGuidPermanentURL = pAttr "isPermaLink" e >>= readBool- , rssGuidAttrs = filter (\a -> not (nameLocalName (attrKey a) `elem` known_attrs)) as- , rssGuidValue = strContent e- }+ { rssGuidPermanentURL = pAttr "isPermaLink" e >>= readBool+ , rssGuidAttrs = filter ((`notElem` known_attrs) . nameLocalName . attrKey) as+ , rssGuidValue = strContent e+ } where known_attrs = ["isPermaLink"] @@ -298,13 +297,13 @@ link <- pLeaf "link" es return RSSTextInput- { rssTextInputTitle = title- , rssTextInputDesc = desc- , rssTextInputName = name- , rssTextInputLink = link- , rssTextInputAttrs = elementAttributes e- , rssTextInputOther = filter (\e1 -> not (elementName e1 `elem` known_ti_elts)) es- }+ { rssTextInputTitle = title+ , rssTextInputDesc = desc+ , rssTextInputName = name+ , rssTextInputLink = link+ , rssTextInputAttrs = elementAttributes e+ , rssTextInputOther = filter ((`notElem` known_ti_elts) . elementName) es+ } where known_ti_elts = map qualName ["title", "description", "name", "link"]
src/Text/RSS/Syntax.hs view
@@ -39,7 +39,6 @@ , nullTextInput ) where -import Prelude () import Prelude.Compat import Data.Text (Text)@@ -167,47 +166,47 @@ -> RSSChannel nullChannel title link = RSSChannel- { rssTitle = title- , rssLink = link- , rssDescription = title- , rssItems = []- , rssLanguage = Nothing- , rssCopyright = Nothing- , rssEditor = Nothing- , rssWebMaster = Nothing- , rssPubDate = Nothing- , rssLastUpdate = Nothing- , rssCategories = []- , rssGenerator = Nothing- , rssDocs = Nothing- , rssCloud = Nothing- , rssTTL = Nothing- , rssImage = Nothing- , rssRating = Nothing- , rssTextInput = Nothing- , rssSkipHours = Nothing- , rssSkipDays = Nothing- , rssChannelOther = []- }+ { rssTitle = title+ , rssLink = link+ , rssDescription = title+ , rssItems = []+ , rssLanguage = Nothing+ , rssCopyright = Nothing+ , rssEditor = Nothing+ , rssWebMaster = Nothing+ , rssPubDate = Nothing+ , rssLastUpdate = Nothing+ , rssCategories = []+ , rssGenerator = Nothing+ , rssDocs = Nothing+ , rssCloud = Nothing+ , rssTTL = Nothing+ , rssImage = Nothing+ , rssRating = Nothing+ , rssTextInput = Nothing+ , rssSkipHours = Nothing+ , rssSkipDays = Nothing+ , rssChannelOther = []+ } nullItem :: Text -- ^title -> RSSItem nullItem title = RSSItem- { rssItemTitle = Just title- , rssItemLink = Nothing- , rssItemDescription = Nothing- , rssItemAuthor = Nothing- , rssItemCategories = []- , rssItemComments = Nothing- , rssItemEnclosure = Nothing- , rssItemGuid = Nothing- , rssItemPubDate = Nothing- , rssItemSource = Nothing- , rssItemAttrs = []- , rssItemOther = []- }+ { rssItemTitle = Just title+ , rssItemLink = Nothing+ , rssItemDescription = Nothing+ , rssItemAuthor = Nothing+ , rssItemCategories = []+ , rssItemComments = Nothing+ , rssItemEnclosure = Nothing+ , rssItemGuid = Nothing+ , rssItemPubDate = Nothing+ , rssItemSource = Nothing+ , rssItemAttrs = []+ , rssItemOther = []+ } nullSource :: URLString -- ^source URL@@ -222,11 +221,11 @@ -> RSSEnclosure nullEnclosure url mb_len ty = RSSEnclosure- { rssEnclosureURL = url- , rssEnclosureLength = mb_len- , rssEnclosureType = ty- , rssEnclosureAttrs = []- }+ { rssEnclosureURL = url+ , rssEnclosureLength = mb_len+ , rssEnclosureType = ty+ , rssEnclosureAttrs = []+ } newCategory :: Text -- ^category Value@@ -251,25 +250,25 @@ -> RSSImage nullImage url title link = RSSImage- { rssImageURL = url- , rssImageTitle = title- , rssImageLink = link- , rssImageWidth = Nothing- , rssImageHeight = Nothing- , rssImageDesc = Nothing- , rssImageOther = []- }+ { rssImageURL = url+ , rssImageTitle = title+ , rssImageLink = link+ , rssImageWidth = Nothing+ , rssImageHeight = Nothing+ , rssImageDesc = Nothing+ , rssImageOther = []+ } nullCloud :: RSSCloud nullCloud = RSSCloud- { rssCloudDomain = Nothing- , rssCloudPort = Nothing- , rssCloudPath = Nothing- , rssCloudRegisterProcedure = Nothing- , rssCloudProtocol = Nothing- , rssCloudAttrs = []- }+ { rssCloudDomain = Nothing+ , rssCloudPort = Nothing+ , rssCloudPath = Nothing+ , rssCloudRegisterProcedure = Nothing+ , rssCloudProtocol = Nothing+ , rssCloudAttrs = []+ } nullTextInput :: Text -- ^inputTitle@@ -278,10 +277,10 @@ -> RSSTextInput nullTextInput title nm link = RSSTextInput- { rssTextInputTitle = title- , rssTextInputDesc = title- , rssTextInputName = nm- , rssTextInputLink = link- , rssTextInputAttrs = []- , rssTextInputOther = []- }+ { rssTextInputTitle = title+ , rssTextInputDesc = title+ , rssTextInputName = nm+ , rssTextInputLink = link+ , rssTextInputAttrs = []+ , rssTextInputOther = []+ }
src/Text/RSS1/Export.hs view
@@ -12,18 +12,20 @@ -------------------------------------------------------------------- module Text.RSS1.Export ( xmlFeed+ , textFeed ) where -import Prelude () import Prelude.Compat import Text.DublinCore.Types import Text.RSS1.Syntax import Text.RSS1.Utils+import qualified Data.Text.Util as U import Data.List.Compat import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Data.XML.Compat import Data.XML.Types as XML @@ -48,16 +50,19 @@ , feedOther f ])) -- should we expect these to be derived by the XML pretty printer..?- { elementAttributes =- nub $- mkNAttr (qualName (Nothing, Nothing) "xmlns") rss10NS :- mkNAttr (qualName (Nothing, Just "xmlns") rdfPrefix) rdfNS :- mkNAttr (qualName (Nothing, Just "xmlns") synPrefix) synNS :- mkNAttr (qualName (Nothing, Just "xmlns") taxPrefix) taxNS :- mkNAttr (qualName (Nothing, Just "xmlns") conPrefix) conNS :- mkNAttr (qualName (Nothing, Just "xmlns") dcPrefix) dcNS : feedAttrs f- }+ { elementAttributes =+ nub $+ mkNAttr (qualName (Nothing, Nothing) "xmlns") rss10NS :+ mkNAttr (qualName (Nothing, Just "xmlns") rdfPrefix) rdfNS :+ mkNAttr (qualName (Nothing, Just "xmlns") synPrefix) synNS :+ mkNAttr (qualName (Nothing, Just "xmlns") taxPrefix) taxNS :+ mkNAttr (qualName (Nothing, Just "xmlns") conPrefix) conNS :+ mkNAttr (qualName (Nothing, Just "xmlns") dcPrefix) dcNS : feedAttrs f+ } +textFeed :: Feed -> Maybe TL.Text+textFeed = U.renderFeed xmlFeed+ xmlChannel :: Channel -> XML.Element xmlChannel ch = (qualNode (Just rss10NS, Nothing) "channel" $@@ -77,9 +82,9 @@ , mb (xmlLeaf (synNS, Just synPrefix) "updateBase") (channelUpdateBase ch) ] ++ xmlContentItems (channelContent ch) ++ xmlTopics (channelTopics ch) ++ channelOther ch))- { elementAttributes =- mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (channelURI ch) : channelAttrs ch- }+ { elementAttributes =+ mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (channelURI ch) : channelAttrs ch+ } xmlImageURI :: URIString -> XML.Element xmlImageURI u = xmlEmpty (rss10NS, Nothing) "image" [mkNAttr (rdfName "resource") u]@@ -94,7 +99,7 @@ , xmlLeaf (rss10NS, Nothing) "link" (imageLink i) ] ++ map xmlDC (imageDC i) ++ imageOther i))- {elementAttributes = mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (imageURI i) : imageAttrs i}+ {elementAttributes = mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (imageURI i) : imageAttrs i} xmlItemURIs :: [URIString] -> [XML.Element] xmlItemURIs [] = []@@ -120,7 +125,7 @@ , xmlLeaf (rss10NS, Nothing) "link" (textInputLink ti) ] ++ map xmlDC (textInputDC ti) ++ textInputOther ti)- {elementAttributes = mkNAttr (rdfName "about") (textInputURI ti) : textInputAttrs ti}+ {elementAttributes = mkNAttr (rdfName "about") (textInputURI ti) : textInputAttrs ti} xmlDC :: DCItem -> XML.Element xmlDC dc = xmlLeaf (dcNS, Just dcPrefix) (infoToTag (dcElt dc)) (dcText dc)@@ -165,7 +170,7 @@ , mb (rdfResource (conNS, conPrefix) "encoding") (contentEncoding ci) , mb (rdfValue []) (contentValue ci) ]))- {elementAttributes = mb (mkNAttr (rdfName "about")) (contentURI ci)}+ {elementAttributes = mb (mkNAttr (rdfName "about")) (contentURI ci)} rdfResource :: (Text, Text) -> Text -> Text -> XML.Element rdfResource (uri, pre) t v = xmlEmpty (uri, Just pre) t [mkNAttr (rdfName "resource") v]@@ -196,7 +201,7 @@ mb (xmlLeaf (rss10NS, Nothing) "title") (taxonomyTitle tt) ++ mb (xmlLeaf (rss10NS, Nothing) "description") (taxonomyDesc tt) ++ xmlTopics (taxonomyTopics tt) ++ map xmlDC (taxonomyDC tt) ++ taxonomyOther tt))- {elementAttributes = [mkNAttr (rdfName "about") (taxonomyURI tt)]}+ {elementAttributes = [mkNAttr (rdfName "about") (taxonomyURI tt)]} xmlItem :: Item -> XML.Element xmlItem i =@@ -209,15 +214,15 @@ mb (xmlLeaf (rss10NS, Nothing) "description") (itemDesc i) ++ map xmlDC (itemDC i) ++ xmlTopics (itemTopics i) ++ map xmlContentInfo (itemContent i) ++ itemOther i))- {elementAttributes = mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (itemURI i) : itemAttrs i}+ {elementAttributes = mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (itemURI i) : itemAttrs i} xmlLeaf :: (Text, Maybe Text) -> Text -> Text -> XML.Element xmlLeaf (ns, pre) tg txt = Element- { elementName = qualName (Just ns, pre) tg- , elementAttributes = []- , elementNodes = [NodeContent $ ContentText txt]- }+ { elementName = qualName (Just ns, pre) tg+ , elementAttributes = []+ , elementNodes = [NodeContent $ ContentText txt]+ } xmlEmpty :: (Text, Maybe Text) -> Text -> [Attr] -> XML.Element xmlEmpty (uri, pre) t as = (qualNode (Just uri, pre) t []) {elementAttributes = as}
src/Text/RSS1/Import.hs view
@@ -14,7 +14,6 @@ ( elementToFeed ) where -import Prelude () import Prelude.Compat import Data.XML.Compat@@ -23,8 +22,8 @@ import Text.RSS1.Syntax import Text.RSS1.Utils -import Control.Monad (guard, mplus)-import Data.Maybe (fromMaybe, mapMaybe)+import Control.Monad.Compat (guard, mplus)+import Data.Maybe (mapMaybe) import Data.Text.Util ---@@ -34,7 +33,7 @@ ver <- pAttr (Nothing, Nothing) "xmlns" e `mplus` Just rss10NS ch <- pNode "channel" e >>= elementToChannel let mbImg = pNode "image" e >>= elementToImage- let is = fromMaybe [] $ fmap elementToItems $ pNode "items" e+ let is = maybe [] elementToItems $ pNode "items" e let mbTI = pNode "textinput" e >>= elementToTextInput let ch1 = ch {channelItemURIs = is} let its = pMany (Just rss10NS, Nothing) "item" elementToItem e@@ -42,16 +41,16 @@ let as_rest = removeKnownAttrs e return Feed- { feedVersion = ver- , feedChannel = ch1- , feedImage = mbImg- , feedItems = its- , feedTextInput = mbTI- , feedTopics =- mapMaybe elementToTaxonomyTopic $ pQNodes (qualName' (taxNS, taxPrefix) "topic") e- , feedOther = es_rest- , feedAttrs = as_rest- }+ { feedVersion = ver+ , feedChannel = ch1+ , feedImage = mbImg+ , feedItems = its+ , feedTextInput = mbTI+ , feedTopics =+ mapMaybe elementToTaxonomyTopic $ pQNodes (qualName' (taxNS, taxPrefix) "topic") e+ , feedOther = es_rest+ , feedAttrs = as_rest+ } elementToItems :: XML.Element -> [URIString] elementToItems = seqLeaves@@ -67,15 +66,15 @@ let dcs = mapMaybe elementToDC es return TextInputInfo- { textInputURI = uri- , textInputTitle = ti- , textInputDesc = desc- , textInputName = na- , textInputLink = li- , textInputDC = dcs- , textInputOther = es- , textInputAttrs = elementAttributes e- }+ { textInputURI = uri+ , textInputTitle = ti+ , textInputDesc = desc+ , textInputName = na+ , textInputLink = li+ , textInputDC = dcs+ , textInputOther = es+ , textInputAttrs = elementAttributes e+ } elementToItem :: XML.Element -> Maybe Item elementToItem e = do@@ -86,22 +85,22 @@ li <- pQLeaf (rss10NS, Nothing) "link" e let desc = pQLeaf (rss10NS, Nothing) "description" e let dcs = mapMaybe elementToDC es- let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)+ let tos = maybe [] bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e let cs = mapMaybe elementToContent es let es_other = removeKnownElts e let as_other = removeKnownAttrs e return Item- { itemURI = uri- , itemTitle = ti- , itemLink = li- , itemDesc = desc- , itemDC = dcs- , itemTopics = tos- , itemContent = cs- , itemOther = es_other- , itemAttrs = as_other- }+ { itemURI = uri+ , itemTitle = ti+ , itemLink = li+ , itemDesc = desc+ , itemDC = dcs+ , itemTopics = tos+ , itemContent = cs+ , itemOther = es_other+ , itemAttrs = as_other+ } elementToImage :: XML.Element -> Maybe Image elementToImage e = do@@ -114,14 +113,14 @@ let dcs = mapMaybe elementToDC es return Image- { imageURI = uri- , imageTitle = ti- , imageURL = ur- , imageLink = li- , imageDC = dcs- , imageOther = es- , imageAttrs = as- }+ { imageURI = uri+ , imageTitle = ti+ , imageURL = ur+ , imageLink = li+ , imageDC = dcs+ , imageOther = es+ , imageAttrs = as+ } elementToChannel :: XML.Element -> Maybe Channel elementToChannel e = do@@ -131,40 +130,40 @@ li <- pLeaf "link" e de <- pLeaf "description" e let mbImg = pLeaf "image" e- let is = fromMaybe [] (fmap seqLeaves $ pNode "items" e)+ let is = maybe [] seqLeaves $ pNode "items" e let tinp = pLeaf "textinput" e let dcs = mapMaybe elementToDC es- let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)+ let tos = maybe [] bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e let cs = mapMaybe elementToContent es let es_other = removeKnownElts e let as_other = removeKnownAttrs e let def_chan = Channel- { channelURI = uri- , channelTitle = ti- , channelLink = li- , channelDesc = de- , channelImageURI = mbImg- , channelItemURIs = is- , channelTextInputURI = tinp- , channelDC = dcs- , channelUpdatePeriod = Nothing- , channelUpdateFreq = Nothing- , channelUpdateBase = Nothing- , channelContent = cs- , channelTopics = tos- , channelOther = es_other- , channelAttrs = as_other- }+ { channelURI = uri+ , channelTitle = ti+ , channelLink = li+ , channelDesc = de+ , channelImageURI = mbImg+ , channelItemURIs = is+ , channelTextInputURI = tinp+ , channelDC = dcs+ , channelUpdatePeriod = Nothing+ , channelUpdateFreq = Nothing+ , channelUpdateBase = Nothing+ , channelContent = cs+ , channelTopics = tos+ , channelOther = es_other+ , channelAttrs = as_other+ } return (addSyndication e def_chan) addSyndication :: XML.Element -> Channel -> Channel addSyndication e ch = ch- { channelUpdatePeriod = fmap toUpdatePeriod $ pQLeaf' (synNS, synPrefix) "updatePeriod" e- , channelUpdateFreq = readInt =<< pQLeaf' (synNS, synPrefix) "updateFrequency" e- , channelUpdateBase = pQLeaf' (synNS, synPrefix) "updateBase" e- }+ { channelUpdatePeriod = toUpdatePeriod <$> pQLeaf' (synNS, synPrefix) "updatePeriod" e+ , channelUpdateFreq = readInt =<< pQLeaf' (synNS, synPrefix) "updateFrequency" e+ , channelUpdateBase = pQLeaf' (synNS, synPrefix) "updateBase" e+ } where toUpdatePeriod x = case x of@@ -207,26 +206,25 @@ li <- pQLeaf' (taxNS, taxPrefix) "link" e return TaxonomyTopic- { taxonomyURI = uri- , taxonomyLink = li- , taxonomyTitle = pLeaf "title" e- , taxonomyDesc = pLeaf "description" e- , taxonomyTopics =- fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)- , taxonomyDC = mapMaybe elementToDC es- , taxonomyOther = es- }+ { taxonomyURI = uri+ , taxonomyLink = li+ , taxonomyTitle = pLeaf "title" e+ , taxonomyDesc = pLeaf "description" e+ , taxonomyTopics = maybe [] bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e+ , taxonomyDC = mapMaybe elementToDC es+ , taxonomyOther = es+ } elementToContent :: XML.Element -> Maybe ContentInfo elementToContent e = do guard (elementName e == qualName' (conNS, conPrefix) "items") return ContentInfo- { contentURI = pAttr' (rdfNS, rdfPrefix) "about" e- , contentFormat = pQLeaf' (conNS, conPrefix) "format" e- , contentEncoding = pQLeaf' (conNS, conPrefix) "encoding" e- , contentValue = pQLeaf' (rdfNS, rdfPrefix) "value" e- }+ { contentURI = pAttr' (rdfNS, rdfPrefix) "about" e+ , contentFormat = pQLeaf' (conNS, conPrefix) "format" e+ , contentEncoding = pQLeaf' (conNS, conPrefix) "encoding" e+ , contentValue = pQLeaf' (rdfNS, rdfPrefix) "value" e+ } bagLeaves :: XML.Element -> [URIString] bagLeaves be =@@ -235,7 +233,7 @@ guard (elementName e == qualName' (rdfNS, rdfPrefix) "li") pAttr' (rdfNS, rdfPrefix) "resource" e `mplus` fmap strContent (pQNode (qualName' (rdfNS, rdfPrefix) "li") e))- (fromMaybe [] $ fmap children $ pQNode (qualName' (rdfNS, rdfPrefix) "Bag") be)+ (maybe [] children $ pQNode (qualName' (rdfNS, rdfPrefix) "Bag") be) {- bagElements :: XML.Element -> [XML.Element]@@ -252,4 +250,4 @@ (\e -> do guard (elementName e == rdfName "li") return (strContent e))- (fromMaybe [] $ fmap children $ pQNode (rdfName "Seq") se)+ (maybe [] children $ pQNode (rdfName "Seq") se)
src/Text/RSS1/Syntax.hs view
@@ -32,7 +32,6 @@ , nullContentInfo ) where -import Prelude () import Prelude.Compat import Data.Text@@ -141,88 +140,92 @@ nullFeed :: URIString -> TitleString -> Feed nullFeed uri title = Feed- { feedVersion = "1.0"- , feedChannel = nullChannel uri title- , feedImage = Nothing- , feedItems = []- , feedTextInput = Nothing- , feedTopics = []- , feedOther = []- , feedAttrs = []- }+ { feedVersion = "1.0"+ , feedChannel = nullChannel uri title+ , feedImage = Nothing+ , feedItems = []+ , feedTextInput = Nothing+ , feedTopics = []+ , feedOther = []+ , feedAttrs = []+ } nullChannel :: URIString -> TitleString -> Channel nullChannel uri title = Channel- { channelURI = uri- , channelTitle = title- , channelLink = uri- , channelDesc = title- , channelImageURI = Nothing- , channelItemURIs = []- , channelTextInputURI = Nothing- , channelDC = []- , channelUpdatePeriod = Nothing- , channelUpdateFreq = Nothing- , channelUpdateBase = Nothing- , channelContent = []- , channelTopics = []- , channelOther = []- , channelAttrs = []- }+ { channelURI = uri+ , channelTitle = title+ , channelLink = uri+ , channelDesc = title+ , channelImageURI = Nothing+ , channelItemURIs = []+ , channelTextInputURI = Nothing+ , channelDC = []+ , channelUpdatePeriod = Nothing+ , channelUpdateFreq = Nothing+ , channelUpdateBase = Nothing+ , channelContent = []+ , channelTopics = []+ , channelOther = []+ , channelAttrs = []+ } nullImage :: URIString -> Text -> URIString -> Image nullImage imguri title link = Image- { imageURI = imguri- , imageTitle = title- , imageURL = imguri- , imageLink = link- , imageDC = []- , imageOther = []- , imageAttrs = []- }+ { imageURI = imguri+ , imageTitle = title+ , imageURL = imguri+ , imageLink = link+ , imageDC = []+ , imageOther = []+ , imageAttrs = []+ } nullItem :: URIString -> TextString -> URIString -> Item nullItem uri title link = Item- { itemURI = uri- , itemTitle = title- , itemLink = link- , itemDesc = Nothing- , itemDC = []- , itemTopics = []- , itemContent = []- , itemOther = []- , itemAttrs = []- }+ { itemURI = uri+ , itemTitle = title+ , itemLink = link+ , itemDesc = Nothing+ , itemDC = []+ , itemTopics = []+ , itemContent = []+ , itemOther = []+ , itemAttrs = []+ } nullTextInputInfo :: URIString -> TextString -> TextString -> URIString -> TextInputInfo nullTextInputInfo uri title nm link = TextInputInfo- { textInputURI = uri- , textInputTitle = title- , textInputDesc = title- , textInputName = nm- , textInputLink = link- , textInputDC = []- , textInputOther = []- , textInputAttrs = []- }+ { textInputURI = uri+ , textInputTitle = title+ , textInputDesc = title+ , textInputName = nm+ , textInputLink = link+ , textInputDC = []+ , textInputOther = []+ , textInputAttrs = []+ } nullTaxonomyTopic :: URIString -> URIString -> TaxonomyTopic nullTaxonomyTopic uri link = TaxonomyTopic- { taxonomyURI = uri- , taxonomyLink = link- , taxonomyTitle = Nothing- , taxonomyDesc = Nothing- , taxonomyTopics = []- , taxonomyDC = []- , taxonomyOther = []- }+ { taxonomyURI = uri+ , taxonomyLink = link+ , taxonomyTitle = Nothing+ , taxonomyDesc = Nothing+ , taxonomyTopics = []+ , taxonomyDC = []+ , taxonomyOther = []+ } nullContentInfo :: ContentInfo nullContentInfo = ContentInfo- {contentURI = Nothing, contentFormat = Nothing, contentEncoding = Nothing, contentValue = Nothing}+ { contentURI = Nothing+ , contentFormat = Nothing+ , contentEncoding = Nothing+ , contentValue = Nothing+ }
src/Text/RSS1/Utils.hs view
@@ -46,7 +46,6 @@ , removeKnownAttrs ) where -import Prelude () import Prelude.Compat import Data.XML.Compat@@ -145,12 +144,12 @@ known_con_elts = map (qualName' (conNS, conPrefix)) ["items", "item", "format", "encoding"] removeKnownElts :: XML.Element -> [XML.Element]-removeKnownElts e = filter (\e1 -> not (elementName e1 `elem` known_elts)) (elementChildren e)+removeKnownElts e = filter (\e1 -> elementName e1 `notElem` known_elts) (elementChildren e) where known_elts = concat [known_rss_elts, known_syn_elts, known_dc_elts, known_con_elts, known_tax_elts] removeKnownAttrs :: XML.Element -> [Attr]-removeKnownAttrs e = filter (\a -> not (fst a `elem` known_attrs)) (elementAttributes e)+removeKnownAttrs e = filter ((`notElem` known_attrs) . fst) (elementAttributes e) where known_attrs = map rdfName ["about"]
tests/Example.hs view
@@ -1,9 +1,10 @@-module Example where+module Example+ ( exampleTests+ ) where -import Prelude () import Prelude.Compat -import Example.CreateAtom (createAtom)+import Example.CreateAtom (atomFeed) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion)@@ -14,7 +15,7 @@ typeCheckAtom :: Assertion typeCheckAtom =- case createAtom of+ case atomFeed of Just "" -> error "createAtom returned an empty Text" Just _ -> return () Nothing -> error "createAtom returned document with unresolved entities"
tests/Example/CreateAtom.hs view
@@ -1,8 +1,7 @@ module Example.CreateAtom- ( createAtom+ ( atomFeed ) where -import Prelude () import Prelude.Compat hiding (take) import qualified Text.Atom.Feed as Atom@@ -13,38 +12,46 @@ import Data.Text.Lazy (toStrict) import Text.XML -createAtom :: Maybe Text-createAtom = feed examplePosts+atomFeed :: Maybe Text+atomFeed = renderFeed examplePosts -examplePosts :: [(Text, Text, Text)] -- Date, URL, Content+data Post = Post+ { _postedOn :: Text+ , _url :: Text+ , _content :: Text+ }++examplePosts :: [Post] examplePosts =- [ ("2000-02-02T18:30:00Z", "http://example.com/2", "Bar.")- , ("2000-01-01T18:30:00Z", "http://example.com/1", "Foo.")+ [ Post "2000-02-02T18:30:00Z" "http://example.com/2" "Bar."+ , Post "2000-01-01T18:30:00Z" "http://example.com/1" "Foo." ] -feed :: [(Text, Text, Text)] -> Maybe Text+toEntry :: Post -> Atom.Entry+toEntry (Post date url content) =+ (Atom.nullEntry+ url -- The ID field. Must be a link to validate.+ (Atom.TextString (take 20 content)) -- Title+ date)+ { Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "J. Smith"}]+ , Atom.entryLinks = [Atom.nullLink url]+ , Atom.entryContent = Just (Atom.HTMLContent content)+ }++feed :: [Post] -> Atom.Feed feed posts =+ Atom.nullFeed+ "http://example.com/atom.xml" -- ID+ (Atom.TextString "Example Website") -- Title+ (case posts -- Updated+ of+ Post latestPostDate _ _:_ -> latestPostDate+ _ -> "")++renderFeed :: [Post] -> Maybe Text+renderFeed posts = fmap (toStrict . renderText def) $ elementToDoc $ Export.xmlFeed $- fd {Atom.feedEntries = fmap toEntry posts, Atom.feedLinks = [Atom.nullLink "http://example.com/"]}- where- fd :: Atom.Feed- fd =- Atom.nullFeed- "http://example.com/atom.xml" -- ID- (Atom.TextString "Example Website") -- Title- (case posts -- Updated- of- (latestPostDate, _, _):_ -> latestPostDate- _ -> "")- toEntry :: (Text, Text, Text) -> Atom.Entry- toEntry (date, url, content) =- (Atom.nullEntry- url -- The ID field. Must be a link to validate.- (Atom.TextString (take 20 content)) -- Title- date)- { Atom.entryAuthors = [Atom.nullPerson {Atom.personName = "J. Smith"}]- , Atom.entryLinks = [Atom.nullLink url]- , Atom.entryContent = Just (Atom.HTMLContent content)- }+ (feed posts)+ {Atom.feedEntries = fmap toEntry posts, Atom.feedLinks = [Atom.nullLink "http://example.com/"]}
tests/Main.hs view
@@ -2,7 +2,6 @@ ( main ) where -import Prelude () import Prelude.Compat import Example (exampleTests)
tests/Text/Atom/Tests.hs view
@@ -1,6 +1,7 @@-module Text.Atom.Tests where+module Text.Atom.Tests+ ( atomTests+ ) where -import Prelude () import Prelude.Compat import Data.Maybe (isJust)@@ -9,9 +10,9 @@ import Test.HUnit (Assertion, assertBool) import Text.XML -import Text.Atom.Feed-import Text.Feed.Export-import Text.Feed.Import+import Text.Atom.Feed (TextContent(TextString), entryLinks, nullEntry, nullLink)+import Text.Feed.Export (xmlFeed)+import Text.Feed.Import (parseFeedFromFile) import Text.Feed.Query import Text.Feed.Types import Text.RSS.Utils@@ -29,9 +30,9 @@ where testAtom :: Assertion testAtom = do- print . fmap (renderText def) . elementToDoc . xmlFeed =<<- parseFeedFromFile =<< getDataFileName "tests/files/atom.xml"- assertBool "OK" True+ contents <- parseFeedFromFile =<< getDataFileName "tests/files/atom.xml"+ let res = fmap (renderText def) . elementToDoc . xmlFeed $ contents+ assertBool "Atom Parsing" $ isJust res testAtomAlternate :: Test testAtomAlternate = testCase "*unspecified* link relation means 'alternate'" testAlt@@ -40,4 +41,4 @@ testAlt = let nullent = nullEntry "" (TextString "") "" item = AtomItem nullent {entryLinks = [nullLink ""]}- in assertBool "unspecified means alternate" $ isJust $ getItemLink item+ in assertBool "unspecified means alternate" $ isJust $ getItemLink item
tests/Text/Feed/Util/Tests.hs view
@@ -1,6 +1,7 @@-module Text.Feed.Util.Tests where+module Text.Feed.Util.Tests+ ( feedUtilTests+ ) where -import Prelude () import Prelude.Compat import Data.Time
tests/Text/RSS/Equals.hs view
@@ -2,7 +2,6 @@ module Text.RSS.Equals where -import Prelude () import Prelude.Compat import Text.RSS.Syntax (RSSCloud(..))
tests/Text/RSS/Export/Tests.hs view
@@ -1,6 +1,7 @@-module Text.RSS.Export.Tests where+module Text.RSS.Export.Tests+ ( rssExportTests+ ) where -import Prelude () import Prelude.Compat import Data.Text (pack)@@ -39,69 +40,69 @@ testImage = do let other = XML.Element- { elementName = createQName "other"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image other"]- }+ { elementName = createQName "other"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image other"]+ } let image = RSSImage- { rssImageURL = "image url"- , rssImageTitle = "image title"- , rssImageLink = "image link"- , rssImageWidth = Just 100- , rssImageHeight = Just 200- , rssImageDesc = Just "image desc"- , rssImageOther = [other]- }+ { rssImageURL = "image url"+ , rssImageTitle = "image title"+ , rssImageLink = "image link"+ , rssImageWidth = Just 100+ , rssImageHeight = Just 200+ , rssImageDesc = Just "image desc"+ , rssImageOther = [other]+ } let expected = XML.Element- { elementName = createQName "image"- , elementAttributes = [] :: [Attr]- , elementNodes =- [ NodeElement- XML.Element- { elementName = createQName "url"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image url"]- }- , NodeElement- XML.Element- { elementName = createQName "title"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image title"]- }- , NodeElement- XML.Element- { elementName = createQName "link"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image link"]- }- , NodeElement- XML.Element- { elementName = createQName "width"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "100"]- }- , NodeElement- XML.Element- { elementName = createQName "height"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "200"]- }- , NodeElement- XML.Element- { elementName = createQName "description"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image desc"]- }- , NodeElement- XML.Element- { elementName = createQName "other"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "image other"]- }- ]- }+ { elementName = createQName "image"+ , elementAttributes = [] :: [Attr]+ , elementNodes =+ [ NodeElement+ XML.Element+ { elementName = createQName "url"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image url"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "title"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image title"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "link"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image link"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "width"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "100"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "height"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "200"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "description"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image desc"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "other"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "image other"]+ }+ ]+ } assertEqual "image" expected (xmlImage image) testCreateXMLCloud :: Test@@ -112,26 +113,26 @@ let attr = mkNAttr (createQName "attr") "text for attr" let cloud = RSSCloud- { rssCloudDomain = Just "domain cloud"- , rssCloudPort = Just "port cloud"- , rssCloudPath = Just "path cloud"- , rssCloudRegisterProcedure = Just "register cloud"- , rssCloudProtocol = Just "protocol cloud"- , rssCloudAttrs = [attr]- }+ { rssCloudDomain = Just "domain cloud"+ , rssCloudPort = Just "port cloud"+ , rssCloudPath = Just "path cloud"+ , rssCloudRegisterProcedure = Just "register cloud"+ , rssCloudProtocol = Just "protocol cloud"+ , rssCloudAttrs = [attr]+ } let expected = XML.Element- { elementName = createQName "cloud"- , elementAttributes =- [ mkNAttr (createQName "domain") "domain cloud"- , mkNAttr (createQName "port") "port cloud"- , mkNAttr (createQName "path") "path cloud"- , mkNAttr (createQName "registerProcedure") "register cloud"- , mkNAttr (createQName "protocol") "protocol cloud"- , attr- ] :: [Attr]- , elementNodes = [createContent ""]- }+ { elementName = createQName "cloud"+ , elementAttributes =+ [ mkNAttr (createQName "domain") "domain cloud"+ , mkNAttr (createQName "port") "port cloud"+ , mkNAttr (createQName "path") "path cloud"+ , mkNAttr (createQName "registerProcedure") "register cloud"+ , mkNAttr (createQName "protocol") "protocol cloud"+ , attr+ ] :: [Attr]+ , elementNodes = [createContent ""]+ } assertEqual "cloud" expected (xmlCloud cloud) testCreateXMLTextInput :: Test@@ -142,56 +143,56 @@ let attr = mkNAttr (createQName "attr") "text for attr" let other = XML.Element- { elementName = createQName "leaf"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "text for leaf"]- }+ { elementName = createQName "leaf"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "text for leaf"]+ } let input = RSSTextInput- { rssTextInputTitle = "title"- , rssTextInputDesc = "desc"- , rssTextInputName = "name"- , rssTextInputLink = "http://url.com"- , rssTextInputAttrs = [attr]- , rssTextInputOther = [other]- }+ { rssTextInputTitle = "title"+ , rssTextInputDesc = "desc"+ , rssTextInputName = "name"+ , rssTextInputLink = "http://url.com"+ , rssTextInputAttrs = [attr]+ , rssTextInputOther = [other]+ } let expected = XML.Element- { elementName = createQName "textInput"- , elementAttributes = [attr] :: [Attr]- , elementNodes =- [ NodeElement- XML.Element- { elementName = createQName "title"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "title"]- }- , NodeElement- XML.Element- { elementName = createQName "description"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "desc"]- }- , NodeElement- XML.Element- { elementName = createQName "name"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "name"]- }- , NodeElement- XML.Element- { elementName = createQName "link"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "http://url.com"]- }- , NodeElement- XML.Element- { elementName = createQName "leaf"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent "text for leaf"]- }- ]- }+ { elementName = createQName "textInput"+ , elementAttributes = [attr] :: [Attr]+ , elementNodes =+ [ NodeElement+ XML.Element+ { elementName = createQName "title"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "title"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "description"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "desc"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "name"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "name"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "link"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "http://url.com"]+ }+ , NodeElement+ XML.Element+ { elementName = createQName "leaf"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent "text for leaf"]+ }+ ]+ } assertEqual "text input" expected (xmlTextInput input) testCreateEmptyXMLSkipHours :: Test@@ -203,10 +204,10 @@ let hoursToSkip = [] let expected = XML.Element- { elementName = createQName "skipHours"- , elementAttributes = [] :: [Attr]- , elementNodes = []- }+ { elementName = createQName "skipHours"+ , elementAttributes = [] :: [Attr]+ , elementNodes = []+ } assertEqual "empty skip hours" expected (xmlSkipHours hoursToSkip) testCreateXMLSkipHours :: Test@@ -217,18 +218,18 @@ let hoursToSkip = [1, 2, 3] let expected = XML.Element- { elementName = createQName "skipHours"- , elementAttributes = [] :: [Attr]- , elementNodes = [hourElem 0, hourElem 1, hourElem 2]- }+ { elementName = createQName "skipHours"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [hourElem 0, hourElem 1, hourElem 2]+ } where hourElem ind = NodeElement XML.Element- { elementName = createQName "hour"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent $ pack $ show $ hoursToSkip !! ind]- }+ { elementName = createQName "hour"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent $ pack $ show $ hoursToSkip !! ind]+ } assertEqual "skip hours" expected (xmlSkipHours hoursToSkip) testCreateEmptyXMLSkipDays :: Test@@ -240,10 +241,10 @@ let daysToSkip = [] let expected = XML.Element- { elementName = createQName "skipDays"- , elementAttributes = [] :: [Attr]- , elementNodes = []- }+ { elementName = createQName "skipDays"+ , elementAttributes = [] :: [Attr]+ , elementNodes = []+ } assertEqual "empty skip days" expected (xmlSkipDays daysToSkip) testCreateXMLSkipDays :: Test@@ -254,18 +255,18 @@ let daysToSkip = ["first day", "second day", "third day"] let expected = XML.Element- { elementName = createQName "skipDays"- , elementAttributes = [] :: [Attr]- , elementNodes = [dayElem 0, dayElem 1, dayElem 2]- }+ { elementName = createQName "skipDays"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [dayElem 0, dayElem 1, dayElem 2]+ } where dayElem ind = NodeElement XML.Element- { elementName = createQName "day"- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent $ daysToSkip !! ind]- }+ { elementName = createQName "day"+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent $ daysToSkip !! ind]+ } assertEqual "skip days" expected (xmlSkipDays daysToSkip) testCreateXMLAttr :: Test@@ -287,8 +288,8 @@ let txt = "example of leaf text" let expected = XML.Element- { elementName = createQName tg- , elementAttributes = [] :: [Attr]- , elementNodes = [createContent txt]- }+ { elementName = createQName tg+ , elementAttributes = [] :: [Attr]+ , elementNodes = [createContent txt]+ } assertEqual "create a leaf" expected (xmlLeaf tg txt)
tests/Text/RSS/Import/Tests.hs view
@@ -1,6 +1,7 @@-module Text.RSS.Import.Tests where+module Text.RSS.Import.Tests+ ( rssImportTests+ ) where -import Prelude () import Prelude.Compat import Data.XML.Types as XML@@ -27,7 +28,7 @@ notCreateRSSCloud = do let notXmlCloudElement = XML.Element- {elementName = createQName "notCloud", elementAttributes = [], elementNodes = []}+ {elementName = createQName "notCloud", elementAttributes = [], elementNodes = []} let expected = Nothing assertEqual "not create rss cloud" expected (elementToCloud notXmlCloudElement) @@ -39,25 +40,25 @@ let attr = mkNAttr (createQName "attr") "text for attr" let xmlCloudElement = XML.Element- { elementName = createQName "cloud"- , elementAttributes =- [ mkNAttr (createQName "domain") "domain cloud"- , mkNAttr (createQName "port") "port cloud"- , mkNAttr (createQName "path") "path cloud"- , mkNAttr (createQName "registerProcedure") "register cloud"- , mkNAttr (createQName "protocol") "protocol cloud"- , attr- ] :: [Attr]- , elementNodes = [createContent ""]- }+ { elementName = createQName "cloud"+ , elementAttributes =+ [ mkNAttr (createQName "domain") "domain cloud"+ , mkNAttr (createQName "port") "port cloud"+ , mkNAttr (createQName "path") "path cloud"+ , mkNAttr (createQName "registerProcedure") "register cloud"+ , mkNAttr (createQName "protocol") "protocol cloud"+ , attr+ ] :: [Attr]+ , elementNodes = [createContent ""]+ } let expected = Just RSSCloud- { rssCloudDomain = Just "domain cloud"- , rssCloudPort = Just "port cloud"- , rssCloudPath = Just "path cloud"- , rssCloudRegisterProcedure = Just "register cloud"- , rssCloudProtocol = Just "protocol cloud"- , rssCloudAttrs = [attr]- }+ { rssCloudDomain = Just "domain cloud"+ , rssCloudPort = Just "port cloud"+ , rssCloudPath = Just "path cloud"+ , rssCloudRegisterProcedure = Just "register cloud"+ , rssCloudProtocol = Just "protocol cloud"+ , rssCloudAttrs = [attr]+ } assertEqual "create rss cloud" expected (elementToCloud xmlCloudElement)
tests/Text/RSS/Tests.hs view
@@ -1,8 +1,10 @@-module Text.RSS.Tests where+module Text.RSS.Tests+ ( rssTests+ ) where -import Prelude () import Prelude.Compat +import Data.Maybe (isJust) import Test.Framework (Test, mutuallyExclusive, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, assertBool)@@ -27,6 +29,6 @@ where testRss20 :: Assertion testRss20 = do- print . fmap (renderText def) . elementToDoc . xmlFeed =<<- parseFeedFromFile =<< getDataFileName "tests/files/rss20.xml"- assertBool "OK" True+ contents <- parseFeedFromFile =<< getDataFileName "tests/files/rss20.xml"+ let res = fmap (renderText def) . elementToDoc . xmlFeed $ contents+ assertBool "RSS 2.0 Parsing" $ isJust res
tests/Text/RSS/Utils.hs view
@@ -1,6 +1,5 @@ module Text.RSS.Utils where -import Prelude () import Prelude.Compat import Data.Text