diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +### 1.3.0.1 +* Add a test to check that validation works on a simple entry. +* Change attribute handling when validating so that type attribute is recognised properly on content. + #### 1.3.0.0 * Reverted changes to `EntryContent` that came in 1.2.0.0. Thanks to Tomas Janousek. diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -1,1 +1,159 @@ -README.md +# 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 + + + Example Website + http://example.com/atom.xml + 2017-08-01 + +``` + +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 + + + Example Website + http://example.com/atom.xml + 2017-08-01 + + + http://example.com/2 + Bar. + 2000-02-02T18:30:00Z + + J. Smith + + Bar. + + + + http://example.com/1 + Foo. + 2000-01-01T18:30:00Z + + J. Smith + + Foo. + + + +``` +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 () +``` diff --git a/feed.cabal b/feed.cabal --- a/feed.cabal +++ b/feed.cabal @@ -1,5 +1,5 @@ name: feed -version: 1.3.0.0 +version: 1.3.0.1 license: BSD3 license-file: LICENSE category: Text @@ -103,6 +103,7 @@ Example.CreateAtom ImportExport Text.Atom.Tests + Text.Atom.Validate.Tests Text.Feed.Util.Tests Text.RSS.Equals Text.RSS.Export.Tests diff --git a/src/Text/Atom/Feed/Import.hs b/src/Text/Atom/Feed/Import.hs --- a/src/Text/Atom/Feed/Import.hs +++ b/src/Text/Atom/Feed/Import.hs @@ -71,15 +71,17 @@ pQLeaf x es = (T.concat . elementText) `fmap` pQNode x es pAttr :: Text -> XML.Element -> Maybe Text -pAttr x e = (`attributeText` e) =<< fst <$> find sameAttr (elementAttributes e) - where - ax = atomName x - sameAttr (k, _) = k == ax || (isNothing (nameNamespace k) && nameLocalName k == x) +pAttr x e = (`attributeText` e) =<< find (sameAtomAttr x) (map fst $ elementAttributes e) pAttrs :: Text -> XML.Element -> [Text] pAttrs x e = [t | ContentText t <- cnts] where - cnts = concat [v | (k, v) <- elementAttributes e, k == atomName x] + cnts = concat [v | (k, v) <- elementAttributes e, sameAtomAttr x k] + +sameAtomAttr :: Text -> Name -> Bool +sameAtomAttr x k = k == ax || (isNothing (nameNamespace k) && nameLocalName k == x) + where + ax = atomName x pQAttr :: Name -> XML.Element -> Maybe Text pQAttr = attributeText diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -8,8 +8,9 @@ import ImportExport (importExportTests) import Test.Framework (defaultMain) import Text.Atom.Tests (atomTests) +import Text.Atom.Validate.Tests (atomValidateTests) import Text.Feed.Util.Tests (feedUtilTests) import Text.RSS.Tests (rssTests) main :: IO () -main = defaultMain [rssTests, atomTests, feedUtilTests, exampleTests, importExportTests] +main = defaultMain [rssTests, atomTests, atomValidateTests, feedUtilTests, exampleTests, importExportTests] diff --git a/tests/Text/Atom/Validate/Tests.hs b/tests/Text/Atom/Validate/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Text/Atom/Validate/Tests.hs @@ -0,0 +1,36 @@ +module Text.Atom.Validate.Tests + ( atomValidateTests + ) where + +import Prelude.Compat + +import Data.Text (Text) +import Data.Text.Lazy (fromStrict) + +import Data.XML.Types + +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assertEqual) + +import Text.Atom.Feed.Validate + +import qualified Text.XML as C + +atomValidateTests :: Test +atomValidateTests = + testGroup + "Text.Atom.Validate" + [testAtomValidate] + +sampleEntryText :: Text +sampleEntryText = "http://example.comexample2000-01-01T00:00:00ZNobody
This is XHTML content.
" + +testAtomValidate :: Test +testAtomValidate = testCase "simple entry is valid" testValid + where + testValid :: Assertion + testValid = do + let document = C.toXMLDocument $ C.parseText_ C.def $ fromStrict sampleEntryText + let entry = documentRoot document + assertEqual "" [] $ flattenT $ validateEntry entry