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 +47/−47
- Text/Atom/Conduit/Render.hs +11/−11
- atom-conduit.cabal +9/−9
- test/Main.hs +28/−40
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&T bought <b>by SBC</b>!" c @?= AtomXHTMLText "AT&T bought <b xmlns=\"http://www.w3.org/1999/xhtml\"><em>by SBC</em></b><!"@@ -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\"><em>Example</em> 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')