atom-conduit 0.4.0.3 → 0.5.0.0

raw patch · 4 files changed

+152/−147 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Atom/Conduit/Render.hs +33/−31
• Text/Atom/Types.hs +24/−3
• atom-conduit.cabal +63/−59
• test/Main.hs +32/−54

@@ -41,16 +41,16 @@  -- | Render the top-level @atom:feed@ element. renderAtomFeed :: (Monad m) => AtomFeed -> Source m Event-renderAtomFeed f = tag "feed" (attr "xmlns" "http://www.w3.org/2005/Atom") $ do+renderAtomFeed f = atomTag "feed" (attr "xmlns" "http://www.w3.org/2005/Atom") $ do   forM_ (f^.feedAuthorsL) $ renderAtomPerson "author"   forM_ (f^.feedCategoriesL) renderAtomCategory   forM_ (f^.feedContributorsL) $ renderAtomPerson "contributor"   forM_ (f^.feedEntriesL) renderAtomEntry   forM_ (f^.feedGeneratorL) renderAtomGenerator-  forM_ (feedIcon f) $ tag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'-  tag "id" mempty . content $ f^.feedIdL+  forM_ (feedIcon f) $ atomTag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  atomTag "id" mempty . content $ f^.feedIdL   forM_ (f^.feedLinksL) renderAtomLink-  forM_ (feedLogo f) $ tag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  forM_ (feedLogo f) $ atomTag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'   forM_ (f^.feedRightsL) $ renderAtomText "rights"   forM_ (f^.feedSubtitleL) $ renderAtomText "subtitle"   renderAtomText "title" $ f^.feedTitleL@@ -58,12 +58,12 @@  -- | Render an @atom:entry@ element. renderAtomEntry :: (Monad m) => AtomEntry -> Source m Event-renderAtomEntry e = tag "entry" mempty $ do+renderAtomEntry e = atomTag "entry" mempty $ do   forM_ (e^.entryAuthorsL) $ renderAtomPerson "author"   forM_ (e^.entryCategoriesL) renderAtomCategory   forM_ (e^.entryContentL) renderAtomContent   forM_ (e^.entryContributorsL) $ renderAtomPerson "contributor"-  tag "id" mempty . content $ e^.entryIdL+  atomTag "id" mempty . content $ e^.entryIdL   forM_ (e^.entryLinksL) renderAtomLink   forM_ (e^.entryPublishedL) $ dateTag "published"   forM_ (e^.entryRightsL) $ renderAtomText "rights"@@ -74,24 +74,24 @@  -- | Render an @atom:content@ element. renderAtomContent :: (Monad m) => AtomContent -> Source m Event-renderAtomContent (AtomContentInlineXHTML t) = tag "content" (attr "type" "xhtml")-  . tag "div" mempty $ content t-renderAtomContent (AtomContentOutOfLine ctype uri) = tag "content" (nonEmptyAttr "type" ctype <> attr "src" (decodeUtf8 $ withAtomURI serializeURIRef' uri)) $ return ()-renderAtomContent (AtomContentInlineText TypeHTML t) = tag "content" (attr "type" "html") $ content t-renderAtomContent (AtomContentInlineText TypeText t) = tag "content" mempty $ content t-renderAtomContent (AtomContentInlineOther ctype t) = tag "content" (attr "type" ctype) $ content t+renderAtomContent (AtomContentInlineXHTML t) = atomTag "content" (attr "type" "xhtml")+  . tag "{http://www.w3.org/1999/xhtml}div" mempty $ content t+renderAtomContent (AtomContentOutOfLine ctype uri) = atomTag "content" (nonEmptyAttr "type" ctype <> attr "src" (decodeUtf8 $ withAtomURI serializeURIRef' uri)) $ return ()+renderAtomContent (AtomContentInlineText TypeHTML t) = atomTag "content" (attr "type" "html") $ content t+renderAtomContent (AtomContentInlineText TypeText t) = atomTag "content" mempty $ content t+renderAtomContent (AtomContentInlineOther ctype t) = atomTag "content" (attr "type" ctype) $ content t  -- | Render an @atom:source@ element. renderAtomSource :: (Monad m) => AtomSource -> Source m Event-renderAtomSource s = tag "source" mempty $ do+renderAtomSource s = atomTag "source" mempty $ do   forM_ (s^.sourceAuthorsL) $ renderAtomPerson "author"   forM_ (s^.sourceCategoriesL) renderAtomCategory   forM_ (s^.sourceContributorsL) $ renderAtomPerson "contributor"   forM_ (s^.sourceGeneratorL) renderAtomGenerator-  forM_ (sourceIcon s) $ tag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'-  unless (Text.null $ s^.sourceIdL) . tag "id" mempty . content $ s^.sourceIdL+  forM_ (sourceIcon s) $ atomTag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  unless (Text.null $ s^.sourceIdL) . atomTag "id" mempty . content $ s^.sourceIdL   forM_ (s^.sourceLinksL) renderAtomLink-  forM_ (sourceLogo s) $ tag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  forM_ (sourceLogo s) $ atomTag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'   forM_ (s^.sourceRightsL) $ renderAtomText "rights"   forM_ (s^.sourceSubtitleL) $ renderAtomText "subtitle"   forM_ (s^.sourceTitleL) $ renderAtomText "title"@@ -99,13 +99,13 @@  -- | Render an @atom:generator@ element. renderAtomGenerator :: (Monad m) => AtomGenerator -> Source m Event-renderAtomGenerator g = tag "generator" attributes . content . toNullable $ g^.generatorContentL+renderAtomGenerator g = atomTag "generator" attributes . content . toNullable $ g^.generatorContentL   where attributes = optionalAttr "uri" (decodeUtf8 . withAtomURI serializeURIRef' <$> generatorUri g)                      <> nonEmptyAttr "version" (g^.generatorVersionL)  -- | Render an @atom:link@ element. renderAtomLink :: (Monad m) => AtomLink -> Source m Event-renderAtomLink l = tag "link" linkAttrs $ return ()+renderAtomLink l = atomTag "link" linkAttrs $ return ()   where linkAttrs = attr "href" (decodeUtf8 . withAtomURI serializeURIRef' $ linkHref l)                     <> nonEmptyAttr "rel" (l^.linkRelL)                     <> nonEmptyAttr "type" (l^.linkTypeL)@@ -115,28 +115,30 @@  -- | Render an @atom:category@ element. renderAtomCategory :: (Monad m) => AtomCategory -> Source m Event-renderAtomCategory c = tag "category" attributes $ return ()+renderAtomCategory c = atomTag "category" attributes $ return ()   where attributes = attr "term" (toNullable $ c^.categoryTermL)                      <> nonEmptyAttr "scheme" (c^.categorySchemeL)                      <> nonEmptyAttr "label" (c^.categoryLabelL)  -- | Render an atom person construct.-renderAtomPerson :: (Monad m) => Name -> AtomPerson -> Source m Event-renderAtomPerson name p = tag name mempty $ do-  tag "name" mempty . content . toNullable $ p^.personNameL-  unless (Text.null $ p^.personEmailL) $ tag "email" mempty . content $ p^.personEmailL-  forM_ (personUri p) $ tag "uri" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+renderAtomPerson :: (Monad m) => Text -> AtomPerson -> Source m Event+renderAtomPerson name p = atomTag name mempty $ do+  atomTag "name" mempty . content . toNullable $ p^.personNameL+  unless (Text.null $ p^.personEmailL) $ atomTag "email" mempty . content $ p^.personEmailL+  forM_ (personUri p) $ atomTag "uri" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'  -- | Render an atom text construct.-renderAtomText :: (Monad m) => Name -> AtomText -> Source m Event-renderAtomText name (AtomXHTMLText t) = tag name (attr "type" "xhtml")-  . tag "div" mempty $ content t-renderAtomText name (AtomPlainText TypeHTML t) = tag name (attr "type" "html") $ content t-renderAtomText name (AtomPlainText TypeText t) = tag name mempty $ content t+renderAtomText :: (Monad m) => Text -> AtomText -> Source m Event+renderAtomText name (AtomXHTMLText t) = atomTag name (attr "type" "xhtml")+  . tag "{http://www.w3.org/1999/xhtml}div" mempty $ content t+renderAtomText name (AtomPlainText TypeHTML t) = atomTag name (attr "type" "html") $ content t+renderAtomText name (AtomPlainText TypeText t) = atomTag name mempty $ content t +atomTag :: Monad m => Text -> Attributes -> Source m Event -> Source m Event+atomTag name = tag (Name name (Just "http://www.w3.org/2005/Atom") (Just "atom")) -dateTag :: (Monad m) => Name -> UTCTime -> Source m Event-dateTag name = tag name mempty . content . formatTimeRFC3339 . utcToZonedTime utc+dateTag :: (Monad m) => Text -> UTCTime -> Source m Event+dateTag name = atomTag name mempty . content . formatTimeRFC3339 . utcToZonedTime utc  nonEmptyAttr :: Name -> Text -> Attributes nonEmptyAttr name value

@@ -35,9 +35,7 @@ import           Data.Text           hiding (map) import           Data.Time.Clock import           Data.Time.LocalTime ()- import           GHC.Generics- import           URI.ByteString -- }}} @@ -52,20 +50,27 @@   AtomURI a@URI{} == AtomURI b@URI{} = a == b   AtomURI a@RelativeRef{} == AtomURI b@RelativeRef{} = a == b   _ == _ = False+instance Ord AtomURI where+  AtomURI a@URI{} `compare` AtomURI b@URI{} = a `compare` b+  AtomURI a@RelativeRef{} `compare` AtomURI b@RelativeRef{} = a `compare` b+  AtomURI a@URI{} `compare` _ = LT+  AtomURI a@RelativeRef{} `compare` b = b `compare` AtomURI a instance Show AtomURI where   show (AtomURI a@URI{}) = show a   show (AtomURI a@RelativeRef{}) = show a   data TextType = TypeText | TypeHTML-  deriving(Eq, Generic, Show)+  deriving(Eq, Ord, Generic, Read, Show)  -- | An atom text construct. data AtomText = AtomPlainText TextType Text               | AtomXHTMLText Text -- ^ XHTML special characters will be in encoded form  deriving instance Eq AtomText+deriving instance Ord AtomText deriving instance Generic AtomText+deriving instance Read AtomText deriving instance Show AtomText  -- | An atom person construct.@@ -76,7 +81,9 @@   }  deriving instance Eq AtomPerson+deriving instance Ord AtomPerson deriving instance Generic AtomPerson+-- deriving instance Read AtomPerson deriving instance Show AtomPerson  -- | The @atom:category@ element.@@ -87,7 +94,9 @@   }  deriving instance Eq AtomCategory+deriving instance Ord AtomCategory deriving instance Generic AtomCategory+deriving instance Read AtomCategory deriving instance Show AtomCategory  -- | The @atom:link@ element.@@ -101,7 +110,9 @@   }  deriving instance Eq AtomLink+deriving instance Ord AtomLink deriving instance Generic AtomLink+-- deriving instance Read AtomLink deriving instance Show AtomLink  -- | The @atom:generator@ element.@@ -112,7 +123,9 @@   }  deriving instance Eq AtomGenerator+deriving instance Ord AtomGenerator deriving instance Generic AtomGenerator+-- deriving instance Read AtomGenerator deriving instance Show AtomGenerator  -- | The @atom:source@ element.@@ -132,7 +145,9 @@   }  deriving instance Eq AtomSource+deriving instance Ord AtomSource deriving instance Generic AtomSource+-- deriving instance Read AtomSource deriving instance Show AtomSource  type Type = Text@@ -144,7 +159,9 @@                  | AtomContentOutOfLine Type AtomURI  deriving instance Eq AtomContent+deriving instance Ord AtomContent deriving instance Generic AtomContent+-- deriving instance Read AtomContent deriving instance Show AtomContent  -- | The @atom:entry@ element.@@ -164,7 +181,9 @@   }  deriving instance Eq AtomEntry+deriving instance Ord AtomEntry deriving instance Generic AtomEntry+-- deriving instance Read AtomEntry deriving instance Show AtomEntry  -- | The @atom:feed@ element.@@ -185,5 +204,7 @@   }  deriving instance Eq AtomFeed+deriving instance Ord AtomFeed deriving instance Generic AtomFeed+-- deriving instance Read AtomFeed deriving instance Show AtomFeed

@@ -1,65 +1,69 @@-name:                atom-conduit-version:             0.4.0.3-synopsis:            Streaming parser/renderer for the Atom 1.0 standard (RFC 4287).-description:         Please refer to README.-license:             PublicDomain-license-file:        LICENSE-author:              koral-maintainer:          koral att mailoo dott org-category:            XML, Conduit-build-type:          Simple-extra-source-files:  README.md-cabal-version:       >=1.10+name: atom-conduit+version: 0.5.0.0+cabal-version: >=1.10+build-type: Simple+license: PublicDomain+license-file: LICENSE+maintainer: koral att mailoo dott org+synopsis: Streaming parser/renderer for the Atom 1.0 standard (RFC 4287).+description:+    Please refer to README.+category: XML, Conduit+author: koral+extra-source-files:+    README.md  source-repository head-    type:     git+    type: git     location: git://github.com/k0ral/atom-conduit.git  library-  exposed-modules:-    Text.Atom.Conduit.Parse-    Text.Atom.Conduit.Render-    Text.Atom.Lens-    Text.Atom.Types-  -- other-modules:-  build-depends:-      base >= 4.8 && < 5-    , blaze-builder-    , conduit-    , conduit-combinators >= 1.0.5-    , safe-exceptions-    , lens-simple-    , mono-traversable >= 1.0.0.1-    , parsers-    , text-    , time >= 1.5-    , timerep >= 2.0-    , uri-bytestring >= 0.2-    , xml-conduit >= 1.5-    , xml-types-  default-language:    Haskell2010+    exposed-modules:+        Text.Atom.Conduit.Parse+        Text.Atom.Conduit.Render+        Text.Atom.Lens+        Text.Atom.Types+    build-depends:+        base >=4.8 && <5,+        blaze-builder -any,+        conduit -any,+        conduit-combinators >=1.0.5,+        safe-exceptions -any,+        lens-simple -any,+        mono-traversable >=1.0.0.1,+        parsers -any,+        text -any,+        time >=1.5,+        timerep >=2.0,+        uri-bytestring >=0.2,+        xml-conduit >=1.5,+        xml-types -any+    default-language: Haskell2010 -test-suite Tests-  type: exitcode-stdio-1.0-  hs-source-dirs: test-  main-is: Main.hs-  build-depends: atom-conduit,-                 base >= 4.8,-                 conduit,-                 data-default,-                 safe-exceptions,-                 hlint,-                 lens-simple,-                 mono-traversable >= 1.0.0.1,-                 parsers,-                 quickcheck-instances,-                 resourcet,-                 tasty,-                 tasty-hunit,-                 tasty-quickcheck,-                 time >= 1.5,-                 text,-                 uri-bytestring >= 0.2,-                 xml-conduit >= 1.4,-                 xml-types-  default-language:    Haskell2010+test-suite  Tests+    type: exitcode-stdio-1.0+    main-is: Main.hs+    build-depends:+        atom-conduit -any,+        base >=4.8,+        blaze-builder -any,+        conduit -any,+        conduit-combinators >=1.0.5,+        data-default -any,+        safe-exceptions -any,+        hlint -any,+        lens-simple -any,+        mono-traversable >=1.0.0.1,+        parsers -any,+        quickcheck-instances -any,+        resourcet -any,+        tasty -any,+        tasty-hunit -any,+        tasty-quickcheck -any,+        time >=1.5,+        text -any,+        uri-bytestring >=0.2,+        xml-conduit >=1.4,+        xml-types -any+    default-language: Haskell2010+    hs-source-dirs: test

@@ -1,11 +1,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+import           Blaze.ByteString.Builder     (toByteString)+import           Conduit                      (foldC, yieldMany) import           Control.Monad import           Control.Monad.Trans.Resource- import           Data.Char import           Data.Conduit-import           Data.Conduit.List import           Data.Default import           Data.Functor.Identity import           Data.Monoid@@ -14,30 +14,27 @@ import           Data.Text                    as Text import           Data.Text.Encoding           as Text import           Data.Time.Clock+import           Data.Void import           Data.XML.Types--import           Lens.Simple- import qualified Language.Haskell.HLint       as HLint (hlint)-+import           Lens.Simple import           Test.QuickCheck.Instances import           Test.Tasty import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck- import           Text.Atom.Conduit.Parse      as Parser import           Text.Atom.Conduit.Render     as Renderer import           Text.Atom.Lens import           Text.Atom.Types import           Text.Parser.Combinators+import Text.XML.Stream.Render        (renderBuilder) import qualified Text.XML.Stream.Parse        as XML- import           URI.ByteString  main :: IO () main = defaultMain $ testGroup "Tests"   [ unitTests---  , properties+  , properties   , hlint   ] @@ -53,27 +50,27 @@  properties :: TestTree properties = testGroup "Properties"-  [ roundtripAtomTextProperty-  , roundtripAtomPersonProperty-  , roundtripAtomCategoryProperty-  , roundtripAtomLinkProperty-  , roundtripAtomGeneratorProperty-  , roundtripAtomSourceProperty-  , roundtripAtomContentProperty-  -- , roundtripAtomEntryProperty-  -- , roundtripAtomFeedProperty+  [ roundtripProperty "AtomText" (renderAtomText "test") (atomText "test")+  , roundtripProperty "AtomPerson" (renderAtomPerson "test") (atomPerson "test")+  , roundtripProperty "AtomCategory" renderAtomCategory atomCategory+  , roundtripProperty "AtomLink" renderAtomLink atomLink+  , roundtripProperty "AtomGenerator" renderAtomGenerator atomGenerator+  , roundtripProperty "AtomSource" renderAtomSource atomSource+  , roundtripProperty "AtomContent" renderAtomContent atomContent+  -- , roundtripProperty "AtomEntry" renderAtomEntry atomEntry+  -- , roundtripProperty "AtomFeed" renderAtomFeed atomFeed   ]  linkCase :: TestTree linkCase = testCase "Link element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid <link>" atomLink+  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <link>" atomLink   result ^. linkHrefL @?= AtomURI (RelativeRef Nothing "/feed" (Query []) Nothing)   (result ^. linkRelL) @?= "self"   where input = ["<link xmlns=\"http://www.w3.org/2005/Atom\" rel=\"self\" href=\"/feed\" />"]  personCase :: TestTree personCase = testCase "Person construct" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid <author>" (atomPerson "author")+  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <author>" (atomPerson "author")   toNullable (result ^. personNameL) @?= "John Doe"   result ^. personEmailL @?= "JohnDoe@example.com"   result ^. personUriL @?= Just (AtomURI $ URI (Scheme "http") (Just $ Authority Nothing (Host "example.com") Nothing) "/~johndoe" (Query []) Nothing)@@ -87,7 +84,7 @@  generatorCase :: TestTree generatorCase = testCase "Generator element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid <generator>" atomGenerator+  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <generator>" atomGenerator   result ^. generatorUriL @?= Just (AtomURI $ RelativeRef Nothing "/myblog.php" (Query []) Nothing)   (result ^. generatorVersionL) @?= "1.0"   toNullable (result ^. generatorContentL) @?= "Example Toolkit"@@ -99,7 +96,7 @@  sourceCase :: TestTree sourceCase = testCase "Source element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid <source>" atomSource+  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <source>" atomSource   (result ^. sourceIdL) @?= "http://example.org/"   (result ^. sourceTitleL) @?= Just (AtomPlainText TypeText "Fourty-Two")   show <$> (result ^. sourceUpdatedL) @?= Just "2003-12-13 18:30:02 UTC"@@ -115,10 +112,10 @@  textConstructCase :: TestTree textConstructCase = testCase "Text construct" $ do-  a:b:c:_ <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.many (atomText "title")+  a:b:c:_ <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.many (atomText "title")   a @?= AtomPlainText TypeText "AT&T bought by SBC!"   b @?= AtomPlainText TypeHTML "AT&amp;T bought <b>by SBC</b>!"-  c @?= AtomXHTMLText "AT&amp;T bought <b xmlns=\"http://www.w3.org/1999/xhtml\"><em>by SBC</em></b>!"+  c @?= AtomXHTMLText "AT&amp;T bought <b xmlns=\"http://www.w3.org/1999/xhtml\"><em>by SBC</em></b>&lt;!"   where input =           [ "<title xmlns=\"http://www.w3.org/2005/Atom\" type=\"text\">AT&amp;T bought by SBC!</title>"           , "<title xmlns=\"http://www.w3.org/2005/Atom\" type=\"html\">"@@ -126,14 +123,14 @@           , "</title>"           , "<title xmlns=\"http://www.w3.org/2005/Atom\" type=\"xhtml\">"           , "<div xmlns=\"http://www.w3.org/1999/xhtml\">"-          , "AT&amp;T bought <b><em>by SBC</em></b>!"+          , "AT&amp;T bought <b><em>by SBC</em></b>&lt;!"           , "</div>"           , "</title>"           ]  simpleCase :: TestTree simpleCase = testCase "Simple case" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid <feed>" atomFeed+  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <feed>" atomFeed   return ()   where input =           [ "<?xml version=\"1.0\" encoding=\"utf-8\"?>"@@ -161,33 +158,13 @@   result <- HLint.hlint [ "test/", "Text/" ]   Prelude.null result @?= True --roundtripAtomTextProperty :: TestTree-roundtripAtomTextProperty = testProperty "parse . render = id (AtomText)" $ \i -> either (const False) (Just i ==) (runConduit $ renderAtomText "test" i =$= atomText "test")--roundtripAtomPersonProperty :: TestTree-roundtripAtomPersonProperty = testProperty "parse . render = id (AtomPerson)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomPerson "test" i =$= XML.force "Invalid <test>" (atomPerson "test"))--roundtripAtomCategoryProperty :: TestTree-roundtripAtomCategoryProperty = testProperty "parse . render = id (AtomCategory)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomCategory i =$= XML.force "Invalid <category>" atomCategory)--roundtripAtomLinkProperty :: TestTree-roundtripAtomLinkProperty = testProperty "parse . render = id (AtomLink)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomLink i =$= XML.force "Invalid <link>" atomLink)--roundtripAtomGeneratorProperty :: TestTree-roundtripAtomGeneratorProperty = testProperty "parse . render = id (AtomGenerator)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomGenerator i =$= XML.force "Invalid <generator>" atomGenerator)--roundtripAtomSourceProperty :: TestTree-roundtripAtomSourceProperty = testProperty "parse . render = id (AtomSource)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomSource i =$= XML.force "Invalid <source>" atomSource)--roundtripAtomContentProperty :: TestTree-roundtripAtomContentProperty = testProperty "parse . render = id (AtomContent)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomContent i =$= XML.force "Invalid content" atomContent)--roundtripAtomFeedProperty :: TestTree-roundtripAtomFeedProperty = testProperty "parse . render = id (AtomFeed)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomFeed i =$= XML.force "Invalid <feed>" atomFeed)--roundtripAtomEntryProperty :: TestTree-roundtripAtomEntryProperty = testProperty "parse . render = id (AtomEntry)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomEntry i =$= XML.force "Invalid <entry>" atomEntry)+roundtripProperty :: Eq a => Arbitrary a => Show a+                  => TestName -> (a -> Source Maybe Event) -> ConduitM Event Void Maybe (Maybe a) -> TestTree+roundtripProperty name render parse = testProperty ("parse . render = id (" <> name <> ")") $ do+  input <- arbitrary+  let intermediate = fmap (decodeUtf8 . toByteString) $ runConduit $ render input =$= renderBuilder def =$= foldC+      output = join $ runConduit $ render input =$= parse+  return $ counterexample (show input <> " | " <> show intermediate <> " | " <> show output) $ Just input == output   letter = choose ('a', 'z')@@ -269,10 +246,11 @@ instance Arbitrary AtomContent where   arbitrary = oneof     [ AtomContentInlineText <$> arbitrary <*> arbitrary-    , AtomContentInlineXHTML <$> arbitrary+    , AtomContentInlineXHTML <$> (pack <$> listOf1 alphaNum)     , AtomContentInlineOther <$> arbitrary <*> arbitrary     , AtomContentOutOfLine <$> arbitrary <*> arbitrary     ]+  shrink = genericShrink  instance Arbitrary AtomEntry where   arbitrary = do