packages feed

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 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++[![feed](https://img.shields.io/hackage/v/feed.svg)](http://hackage.haskell.org/package/feed)+[![Build Status](https://travis-ci.org/bergmark/feed.svg?branch=master)](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 @@-[![feed](https://img.shields.io/hackage/v/feed.svg)](https://hackage.haskell.org/package/feed)+# Feed++[![feed](https://img.shields.io/hackage/v/feed.svg)](http://hackage.haskell.org/package/feed) [![Build Status](https://travis-ci.org/bergmark/feed.svg?branch=master)](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