diff --git a/Text/Atom/Conduit/Render.hs b/Text/Atom/Conduit/Render.hs --- a/Text/Atom/Conduit/Render.hs +++ b/Text/Atom/Conduit/Render.hs @@ -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 diff --git a/Text/Atom/Types.hs b/Text/Atom/Types.hs --- a/Text/Atom/Types.hs +++ b/Text/Atom/Types.hs @@ -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 diff --git a/atom-conduit.cabal b/atom-conduit.cabal --- a/atom-conduit.cabal +++ b/atom-conduit.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 " atomLink + result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid " atomLink result ^. linkHrefL @?= AtomURI (RelativeRef Nothing "/feed" (Query []) Nothing) (result ^. linkRelL) @?= "self" where input = [""] personCase :: TestTree personCase = testCase "Person construct" $ do - result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid " (atomPerson "author") + result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid " (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 " atomGenerator + result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid " 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 " atomSource + result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid " 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&T bought by SBC!" - c @?= AtomXHTMLText "AT&T bought by SBC!" + c @?= AtomXHTMLText "AT&T bought by SBC<!" where input = [ "AT&T bought by SBC!" , "" @@ -126,14 +123,14 @@ , "" , "" , "<div xmlns=\"http://www.w3.org/1999/xhtml\">" - , "AT&T bought <b><em>by SBC</em></b>!" + , "AT&T bought <b><em>by SBC</em></b><!" , "</div>" , "" ] simpleCase :: TestTree simpleCase = testCase "Simple case" $ do - result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.force "Invalid " atomFeed + result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid " atomFeed return () where input = [ "" @@ -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 " (atomPerson "test")) - -roundtripAtomCategoryProperty :: TestTree -roundtripAtomCategoryProperty = testProperty "parse . render = id (AtomCategory)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomCategory i =$= XML.force "Invalid " atomCategory) - -roundtripAtomLinkProperty :: TestTree -roundtripAtomLinkProperty = testProperty "parse . render = id (AtomLink)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomLink i =$= XML.force "Invalid " atomLink) - -roundtripAtomGeneratorProperty :: TestTree -roundtripAtomGeneratorProperty = testProperty "parse . render = id (AtomGenerator)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomGenerator i =$= XML.force "Invalid " atomGenerator) - -roundtripAtomSourceProperty :: TestTree -roundtripAtomSourceProperty = testProperty "parse . render = id (AtomSource)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomSource i =$= XML.force "Invalid " 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 " atomFeed) - -roundtripAtomEntryProperty :: TestTree -roundtripAtomEntryProperty = testProperty "parse . render = id (AtomEntry)" $ \i -> either (const False) (i ==) (runConduit $ renderAtomEntry i =$= XML.force "Invalid " 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