packages feed

atom-conduit 0.5.0.1 → 0.5.0.2

raw patch · 4 files changed

+95/−107 lines, 4 filesdep +filepathdep +tasty-goldendep −conduit-combinatorsdep ~basedep ~conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath, tasty-golden

Dependencies removed: conduit-combinators

Dependency ranges changed: base, conduit

API changes (from Hackage documentation)

- Text.Atom.Conduit.Parse: instance GHC.Exception.Exception Text.Atom.Conduit.Parse.AtomException
+ Text.Atom.Conduit.Parse: instance GHC.Exception.Type.Exception Text.Atom.Conduit.Parse.AtomException
- Text.Atom.Conduit.Render: renderAtomCategory :: (Monad m) => AtomCategory -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomCategory :: Monad m => AtomCategory -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomContent :: (Monad m) => AtomContent -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomContent :: Monad m => AtomContent -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomEntry :: (Monad m) => AtomEntry -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomEntry :: Monad m => AtomEntry -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomFeed :: (Monad m) => AtomFeed -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomFeed :: Monad m => AtomFeed -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomGenerator :: (Monad m) => AtomGenerator -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomGenerator :: Monad m => AtomGenerator -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomLink :: (Monad m) => AtomLink -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomLink :: Monad m => AtomLink -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomPerson :: (Monad m) => Text -> AtomPerson -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomPerson :: Monad m => Text -> AtomPerson -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomSource :: (Monad m) => AtomSource -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomSource :: Monad m => AtomSource -> ConduitT () Event m ()
- Text.Atom.Conduit.Render: renderAtomText :: (Monad m) => Text -> AtomText -> Source m Event
+ Text.Atom.Conduit.Render: renderAtomText :: Monad m => Text -> AtomText -> ConduitT () Event m ()
- Text.Atom.Types: AtomURI :: (URIRef a) -> AtomURI
+ Text.Atom.Types: AtomURI :: URIRef a -> AtomURI

Files

Text/Atom/Conduit/Parse.hs view
@@ -100,10 +100,10 @@ tagIgnoreAttrs' name handler = tagName' name ignoreAttrs $ const handler  xhtmlContent :: MonadThrow m => ConduitM Event o m Text-xhtmlContent = fmap (decodeUtf8 . toByteString) $ many_ takeAnyTreeContent =$= Render.renderBuilder def =$= foldC+xhtmlContent = fmap (decodeUtf8 . toByteString) $ many_ takeAnyTreeContent .| Render.renderBuilder def .| foldC  -projectC :: Monad m => Fold a a' b b' -> Conduit a m b+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -111,7 +111,7 @@     (Just _, _) -> recurse     _           -> return () -headRequiredC :: MonadThrow m => Text -> Consumer a m a+headRequiredC :: MonadThrow m => Text -> ConduitT a o m a headRequiredC e = liftMaybe (MissingElement e) =<< headC  atomId :: MonadThrow m => ConduitM Event o m (Maybe Text)@@ -138,11 +138,11 @@ -- >   <uri>http://example.com/~johndoe</uri> -- > </author> atomPerson :: MonadThrow m => Text -> ConduitM Event o m (Maybe AtomPerson)-atomPerson name = tagIgnoreAttrs' name $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where+atomPerson name = tagIgnoreAttrs' name $ (manyYield' (choose piece) .| parser) <* many ignoreAnyTreeContent where   parser = getZipConduit $ AtomPerson-    <$> ZipConduit (projectC _PersonName =$= headRequiredC "Missing or invalid <name> element")-    <*> ZipConduit (projectC _PersonEmail =$= headDefC "")-    <*> ZipConduit (projectC _PersonUri =$= headC)+    <$> ZipConduit (projectC _PersonName .| headRequiredC "Missing or invalid <name> element")+    <*> ZipConduit (projectC _PersonEmail .| headDefC "")+    <*> ZipConduit (projectC _PersonUri .| headC)   piece = [ fmap PersonName <$> tagIgnoreAttrs' "name" (content >>= asNonNull)           , fmap PersonEmail <$> tagIgnoreAttrs' "email" content           , fmap PersonUri <$> tagIgnoreAttrs' "uri" (content >>= asURIReference)@@ -245,20 +245,20 @@ -- >   <rights>© 2005 Example, Inc.</rights> -- > </source> atomSource :: MonadThrow m => ConduitM Event o m (Maybe AtomSource)-atomSource = tagIgnoreAttrs' "source" $ manyYield' (choose piece) =$= zipConduit where+atomSource = tagIgnoreAttrs' "source" $ manyYield' (choose piece) .| zipConduit where   zipConduit = getZipConduit $ AtomSource-    <$> ZipConduit (projectC _SourceAuthor =$= sinkList)-    <*> ZipConduit (projectC _SourceCategory =$= sinkList)-    <*> ZipConduit (projectC _SourceContributor =$= sinkList)-    <*> ZipConduit (projectC _SourceGenerator =$= headC)-    <*> ZipConduit (projectC _SourceIcon =$= headC)-    <*> ZipConduit (projectC _SourceId =$= headDefC "")-    <*> ZipConduit (projectC _SourceLink =$= sinkList)-    <*> ZipConduit (projectC _SourceLogo =$= headC)-    <*> ZipConduit (projectC _SourceRights =$= headC)-    <*> ZipConduit (projectC _SourceSubtitle =$= headC)-    <*> ZipConduit (projectC _SourceTitle =$= headC)-    <*> ZipConduit (projectC _SourceUpdated =$= headC)+    <$> ZipConduit (projectC _SourceAuthor .| sinkList)+    <*> ZipConduit (projectC _SourceCategory .| sinkList)+    <*> ZipConduit (projectC _SourceContributor .| sinkList)+    <*> ZipConduit (projectC _SourceGenerator .| headC)+    <*> ZipConduit (projectC _SourceIcon .| headC)+    <*> ZipConduit (projectC _SourceId .| headDefC "")+    <*> ZipConduit (projectC _SourceLink .| sinkList)+    <*> ZipConduit (projectC _SourceLogo .| headC)+    <*> ZipConduit (projectC _SourceRights .| headC)+    <*> ZipConduit (projectC _SourceSubtitle .| headC)+    <*> ZipConduit (projectC _SourceTitle .| headC)+    <*> ZipConduit (projectC _SourceUpdated .| headC)   piece = [ fmap SourceAuthor <$> atomPerson "author"           , fmap SourceCategory <$> atomCategory           , fmap SourceContributor <$> atomPerson "contributor"@@ -291,20 +291,20 @@  -- | Parse an @atom:entry@ element. atomEntry :: MonadThrow m => ConduitM Event o m (Maybe AtomEntry)-atomEntry = tagIgnoreAttrs' "entry" $ manyYield' (choose piece) =$= zipConduit where+atomEntry = tagIgnoreAttrs' "entry" $ manyYield' (choose piece) .| zipConduit where   zipConduit = getZipConduit $ AtomEntry-    <$> ZipConduit (projectC _EntryAuthor =$= sinkList)-    <*> ZipConduit (projectC _EntryCategory =$= sinkList)-    <*> ZipConduit (projectC _EntryContent =$= headC)-    <*> ZipConduit (projectC _EntryContributor =$= sinkList)-    <*> ZipConduit (projectC _EntryId =$= headRequiredC "Missing <id> element")-    <*> ZipConduit (projectC _EntryLink =$= sinkList)-    <*> ZipConduit (projectC _EntryPublished =$= headC)-    <*> ZipConduit (projectC _EntryRights =$= headC)-    <*> ZipConduit (projectC _EntrySource =$= headC)-    <*> ZipConduit (projectC _EntrySummary =$= headC)-    <*> ZipConduit (projectC _EntryTitle =$= headRequiredC "Missing or invalid <title> element.")-    <*> ZipConduit (projectC _EntryUpdated =$= headRequiredC "Missing or invalid <updated> element.")+    <$> ZipConduit (projectC _EntryAuthor .| sinkList)+    <*> ZipConduit (projectC _EntryCategory .| sinkList)+    <*> ZipConduit (projectC _EntryContent .| headC)+    <*> ZipConduit (projectC _EntryContributor .| sinkList)+    <*> ZipConduit (projectC _EntryId .| headRequiredC "Missing <id> element")+    <*> ZipConduit (projectC _EntryLink .| sinkList)+    <*> ZipConduit (projectC _EntryPublished .| headC)+    <*> ZipConduit (projectC _EntryRights .| headC)+    <*> ZipConduit (projectC _EntrySource .| headC)+    <*> ZipConduit (projectC _EntrySummary .| headC)+    <*> ZipConduit (projectC _EntryTitle .| headRequiredC "Missing or invalid <title> element.")+    <*> ZipConduit (projectC _EntryUpdated .| headRequiredC "Missing or invalid <updated> element.")   piece = [ fmap EntryAuthor <$> atomPerson "author"           , fmap EntryCategory <$> atomCategory           , fmap EntryContent <$> atomContent@@ -338,21 +338,21 @@  -- | Parse an @atom:feed@ element. atomFeed :: MonadThrow m => ConduitM Event o m (Maybe AtomFeed)-atomFeed = tagIgnoreAttrs' "feed" $ manyYield' (choose piece) =$= zipConduit where+atomFeed = tagIgnoreAttrs' "feed" $ manyYield' (choose piece) .| zipConduit where   zipConduit = getZipConduit $ AtomFeed-    <$> ZipConduit (projectC _FeedAuthor =$= sinkList)-    <*> ZipConduit (projectC _FeedCategory =$= sinkList)-    <*> ZipConduit (projectC _FeedContributor =$= sinkList)-    <*> ZipConduit (projectC _FeedEntry =$= sinkList)-    <*> ZipConduit (projectC _FeedGenerator =$= headC)-    <*> ZipConduit (projectC _FeedIcon =$= headC)-    <*> ZipConduit (projectC _FeedId =$= headRequiredC "Missing <id> element")-    <*> ZipConduit (projectC _FeedLink =$= sinkList)-    <*> ZipConduit (projectC _FeedLogo =$= headC)-    <*> ZipConduit (projectC _FeedRights =$= headC)-    <*> ZipConduit (projectC _FeedSubtitle =$= headC)-    <*> ZipConduit (projectC _FeedTitle =$= headRequiredC "Missing <title> element.")-    <*> ZipConduit (projectC _FeedUpdated =$= headRequiredC "Missing <updated> element.")+    <$> ZipConduit (projectC _FeedAuthor .| sinkList)+    <*> ZipConduit (projectC _FeedCategory .| sinkList)+    <*> ZipConduit (projectC _FeedContributor .| sinkList)+    <*> ZipConduit (projectC _FeedEntry .| sinkList)+    <*> ZipConduit (projectC _FeedGenerator .| headC)+    <*> ZipConduit (projectC _FeedIcon .| headC)+    <*> ZipConduit (projectC _FeedId .| headRequiredC "Missing <id> element")+    <*> ZipConduit (projectC _FeedLink .| sinkList)+    <*> ZipConduit (projectC _FeedLogo .| headC)+    <*> ZipConduit (projectC _FeedRights .| headC)+    <*> ZipConduit (projectC _FeedSubtitle .| headC)+    <*> ZipConduit (projectC _FeedTitle .| headRequiredC "Missing <title> element.")+    <*> ZipConduit (projectC _FeedUpdated .| headRequiredC "Missing <updated> element.")   piece = [ fmap FeedAuthor <$> atomPerson "author"           , fmap FeedCategory <$> atomCategory           , fmap FeedContributor <$> atomPerson "contributor"
Text/Atom/Conduit/Render.hs view
@@ -40,7 +40,7 @@ -- }}}  -- | Render the top-level @atom:feed@ element.-renderAtomFeed :: (Monad m) => AtomFeed -> Source m Event+renderAtomFeed :: (Monad m) => AtomFeed -> ConduitT () Event m () renderAtomFeed f = atomTag "feed" (attr "xmlns" "http://www.w3.org/2005/Atom") $ do   forM_ (f^.feedAuthorsL) $ renderAtomPerson "author"   forM_ (f^.feedCategoriesL) renderAtomCategory@@ -57,7 +57,7 @@   dateTag "updated" $ f^.feedUpdatedL  -- | Render an @atom:entry@ element.-renderAtomEntry :: (Monad m) => AtomEntry -> Source m Event+renderAtomEntry :: (Monad m) => AtomEntry -> ConduitT () Event m () renderAtomEntry e = atomTag "entry" mempty $ do   forM_ (e^.entryAuthorsL) $ renderAtomPerson "author"   forM_ (e^.entryCategoriesL) renderAtomCategory@@ -73,7 +73,7 @@   dateTag "updated" (e^.entryUpdatedL)  -- | Render an @atom:content@ element.-renderAtomContent :: (Monad m) => AtomContent -> Source m Event+renderAtomContent :: (Monad m) => AtomContent -> ConduitT () Event m () 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 ()@@ -82,7 +82,7 @@ renderAtomContent (AtomContentInlineOther ctype t) = atomTag "content" (attr "type" ctype) $ content t  -- | Render an @atom:source@ element.-renderAtomSource :: (Monad m) => AtomSource -> Source m Event+renderAtomSource :: (Monad m) => AtomSource -> ConduitT () Event m () renderAtomSource s = atomTag "source" mempty $ do   forM_ (s^.sourceAuthorsL) $ renderAtomPerson "author"   forM_ (s^.sourceCategoriesL) renderAtomCategory@@ -98,13 +98,13 @@   forM_ (s^.sourceUpdatedL) $ dateTag "updated"  -- | Render an @atom:generator@ element.-renderAtomGenerator :: (Monad m) => AtomGenerator -> Source m Event+renderAtomGenerator :: (Monad m) => AtomGenerator -> ConduitT () Event m () 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 :: (Monad m) => AtomLink -> ConduitT () Event m () renderAtomLink l = atomTag "link" linkAttrs $ return ()   where linkAttrs = attr "href" (decodeUtf8 . withAtomURI serializeURIRef' $ linkHref l)                     <> nonEmptyAttr "rel" (l^.linkRelL)@@ -114,30 +114,30 @@                     <> nonEmptyAttr "length" (l^.linkLengthL)  -- | Render an @atom:category@ element.-renderAtomCategory :: (Monad m) => AtomCategory -> Source m Event+renderAtomCategory :: (Monad m) => AtomCategory -> ConduitT () Event m () 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) => Text -> AtomPerson -> Source m Event+renderAtomPerson :: (Monad m) => Text -> AtomPerson -> ConduitT () Event m () 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) => Text -> AtomText -> Source m Event+renderAtomText :: (Monad m) => Text -> AtomText -> ConduitT () Event m () 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 :: Monad m => Text -> Attributes -> ConduitT () Event m () -> ConduitT () Event m () atomTag name = tag (Name name (Just "http://www.w3.org/2005/Atom") (Just "atom")) -dateTag :: (Monad m) => Text -> UTCTime -> Source m Event+dateTag :: (Monad m) => Text -> UTCTime -> ConduitT () Event m () dateTag name = atomTag name mempty . content . formatTimeRFC3339 . utcToZonedTime utc  nonEmptyAttr :: Name -> Text -> Attributes
atom-conduit.cabal view
@@ -1,10 +1,10 @@ name: atom-conduit-version: 0.5.0.1+version: 0.5.0.2 cabal-version: >=1.10 build-type: Simple license: PublicDomain license-file: LICENSE-maintainer: koral att mailoo dott org+maintainer: koral synopsis: Streaming parser/renderer for the Atom 1.0 standard (RFC 4287). description:     Please refer to README.@@ -29,10 +29,9 @@         Text.Atom.Lens         Text.Atom.Types     build-depends:-        base >=4.8 && <5,+        base >=4.9 && <5,         blaze-builder -any,-        conduit -any,-        conduit-combinators >=1.0.5,+        conduit >=1.3,         safe-exceptions -any,         lens-simple -any,         mono-traversable >=1.0.0.1,@@ -50,18 +49,19 @@     main-is: Main.hs     build-depends:         atom-conduit -any,-        base >=4.8,+        base >=4.9,         blaze-builder -any,-        conduit -any,-        conduit-combinators >=1.0.5,+        conduit >=1.3,         data-default -any,-        safe-exceptions -any,+        filepath -any,         lens-simple -any,         mono-traversable >=1.0.0.1,         parsers -any,         quickcheck-instances -any,         resourcet -any,+        safe-exceptions -any,         tasty -any,+        tasty-golden -any,         tasty-hunit -any,         tasty-quickcheck -any,         time >=1.5,
test/Main.hs view
@@ -1,24 +1,30 @@+{-# LANGUAGE ExplicitForAll    #-} {-# 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.Combinators     as Conduit (decodeUtf8, fold,+                                                          sourceFile, yieldMany) import           Data.Default import           Data.Functor.Identity import           Data.Monoid import           Data.MonoTraversable import           Data.NonNull+import           Data.String import           Data.Text                    as Text import           Data.Text.Encoding           as Text+import qualified Data.Text.Lazy.Encoding      as Lazy import           Data.Time.Clock import           Data.Void import           Data.XML.Types import           Lens.Simple+import           System.FilePath import           Test.QuickCheck.Instances import           Test.Tasty+import           Test.Tasty.Golden            (findByExtension, goldenVsString) import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck import           Text.Atom.Conduit.Parse      as Parser@@ -26,15 +32,13 @@ 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-  ]+main = do+  goldenTests <- genGoldenTests+  defaultMain $ testGroup "Tests" [ unitTests, properties, goldenTests ]  unitTests :: TestTree unitTests = testGroup "Unit tests"@@ -43,9 +47,18 @@   , generatorCase   , sourceCase   , textConstructCase-  , simpleCase   ] +genGoldenTests :: IO TestTree+genGoldenTests = do+  xmlFiles <- findByExtension [".xml"] "."++  return $ testGroup "Atom golden tests" $ do+    xmlFile <- xmlFiles+    let goldenFile = addExtension xmlFile ".golden"+        f file = fmap (Lazy.encodeUtf8 . fromString . show) $ runResourceT $ runConduit $ sourceFile file .| Conduit.decodeUtf8 .| XML.parseText' def .| XML.force "Invalid <feed>" atomFeed+    return $ goldenVsString xmlFile goldenFile $ f xmlFile+ properties :: TestTree properties = testGroup "Properties"   [ roundtripProperty "AtomText" (renderAtomText "test") (atomText "test")@@ -61,14 +74,14 @@  linkCase :: TestTree linkCase = testCase "Link element" $ do-  result <- runResourceT . runConduit $ yieldMany 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 $ yieldMany 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)@@ -82,7 +95,7 @@  generatorCase :: TestTree generatorCase = testCase "Generator element" $ do-  result <- runResourceT . runConduit $ yieldMany 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"@@ -94,7 +107,7 @@  sourceCase :: TestTree sourceCase = testCase "Source element" $ do-  result <- runResourceT . runConduit $ yieldMany 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"@@ -110,7 +123,7 @@  textConstructCase :: TestTree textConstructCase = testCase "Text construct" $ do-  a:b:c:_ <- runResourceT . runConduit $ yieldMany 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>&lt;!"@@ -126,38 +139,13 @@           , "</title>"           ] -simpleCase :: TestTree-simpleCase = testCase "Simple case" $ do-  result <- runResourceT . runConduit $ yieldMany input =$= XML.parseText' def =$= XML.force "Invalid <feed>" atomFeed-  return ()-  where input =-          [ "<?xml version=\"1.0\" encoding=\"utf-8\"?>"-          , "<feed xmlns=\"http://www.w3.org/2005/Atom\">"-          , "<title type=\"text\">&lt;em&gt;Example&lt;/em&gt; Feed</title>"-          , "<link href=\"http://example.org/\"/>"-          , "<updated>2003-12-13T18:30:02Z</updated>"-          , "<author>"-          , "<name>John Doe</name>"-          , "</author>"-          , "<id>urn:uuid:60a76c80-d399-11d9-b93C-0003939e0af6</id>"-          , "<entry>"-          , "<title>Atom-Powered Robots Run Amok</title>"-          , "<link href=\"http://example.org/2003/12/13/atom03\"/>"-          , "<id>urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a</id>"-          , "<updated>2003-12-13T18:30:02Z</updated>"-          , "<summary>Some text.</summary>"-          , "</entry>"-          , "</feed>"-          ] - roundtripProperty :: Eq a => Arbitrary a => Show a-                  => TestName -> (a -> Source Maybe Event) -> ConduitM Event Void Maybe (Maybe a) -> TestTree+                  => TestName -> (a -> ConduitT () Event Maybe ()) -> 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+  let output = join $ runConduit $ render input .| parse+  return $ Just input == output   letter = choose ('a', 'z')