{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} -- {{{ Imports import Text.RSS.Conduit.Parse as Parser import Text.RSS.Conduit.Render as Renderer import Text.RSS.Extensions import Text.RSS.Extensions.Atom import Text.RSS.Extensions.Content import Text.RSS.Extensions.DublinCore import Text.RSS.Extensions.Syndication import Text.RSS.Lens import Text.RSS.Types import Text.RSS1.Conduit.Parse as Parser import Conduit import Control.Exception.Safe as Exception import Control.Monad import Control.Monad.Trans.Resource import Data.Char import Data.Conduit import Data.Conduit.List import Data.Default import Data.Maybe import Data.String import qualified Data.Text.Lazy.Encoding as Lazy import Data.Time.Calendar hiding (DayOfWeek (..)) import Data.Time.LocalTime import Data.Version import Data.Void import Data.XML.Types import Lens.Micro import System.FilePath import System.IO import System.Timeout import Test.Tasty import Test.Tasty.Golden (findByExtension, goldenVsString) import Test.Tasty.HUnit import Text.Atom.Conduit.Parse import Text.Atom.Types import Text.XML.Stream.Parse as XML hiding (choose) import Text.XML.Stream.Render import URI.ByteString import URI.ByteString.QQ -- }}} main :: IO () main = do goldenTests <- genGoldenTests defaultMain $ testGroup "Tests" [ unitTests , goldenTests ] unitTests :: TestTree unitTests = testGroup "Unit tests" [ skipHoursCase , skipDaysCase , rss1TextInputCase , rss2TextInputCase , rss1ImageCase , rss2ImageCase , categoryCase , cloudCase , guidCase , enclosureCase , sourceCase , rss1ItemCase , rss2ItemCase1 , rss2ItemCase2 , rss1ChannelItemsCase , rss1DocumentCase , dublinCoreChannelCase , dublinCoreItemCase , contentItemCase , syndicationChannelCase , atomChannelCase , multipleExtensionsCase ] genGoldenTests :: IO TestTree genGoldenTests = do xmlFiles <- findByExtension [".xml"] "." return $ testGroup "RSS golden tests" $ do xmlFile <- xmlFiles let goldenFile = addExtension xmlFile ".golden" f file = fmap (Lazy.encodeUtf8 . fromString . show) $ runResourceT $ runConduit $ sourceFile file .| Conduit.decodeUtf8C .| XML.parseText' def .| parser parser = rssDocument :: MonadThrow m => ConduitM Event o m (Maybe (RssDocument NoExtensions)) return $ goldenVsString xmlFile goldenFile $ f xmlFile skipHoursCase :: TestTree skipHoursCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSkipHours result @?= [Hour 0, Hour 9, Hour 18, Hour 21] where input = [ "" , "21" , "9" , "0" , "18" , "9" , "" ] skipDaysCase :: TestTree skipDaysCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSkipDays result @?= [Monday, Saturday, Friday] where input = [ "" , "Monday" , "Monday" , "Friday" , "Saturday" , "" ] rss1TextInputCase :: TestTree rss1TextInputCase = testCase "RSS1 element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rss1TextInput result^.textInputTitleL @?= "Search XML.com" result^.textInputDescriptionL @?= "Search XML.com's XML collection" result^.textInputNameL @?= "s" result^.textInputLinkL @=? RssURI [uri|http://search.xml.com|] where input = [ "" , "Search XML.com" , "Search XML.com's XML collection" , "s" , "http://search.xml.com" , "" ] rss2TextInputCase :: TestTree rss2TextInputCase = testCase "RSS2 element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssTextInput result^.textInputTitleL @?= "Title" result^.textInputDescriptionL @?= "Description" result^.textInputNameL @?= "Name" result^.textInputLinkL @=? RssURI [uri|http://link.ext|] where input = [ "" , "Title" , "Description" , "Name" , "http://link.ext" , "" ] rss1ImageCase :: TestTree rss1ImageCase = testCase "RSS1 element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rss1Image result^.imageUriL @?= RssURI [uri|http://xml.com/universal/images/xml_tiny.gif|] result^.imageTitleL @?= "XML.com" result^.imageLinkL @?= RssURI [uri|http://www.xml.com|] where input = [ "" , "http://xml.com/universal/images/xml_tiny.gif" , "XML.com" , "Ignored" , "http://www.xml.com" , "Ignored" , "" ] rss2ImageCase :: TestTree rss2ImageCase = testCase "RSS2 element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssImage result^.imageUriL @?= RssURI [uri|http://image.ext|] result^.imageTitleL @?= "Title" result^.imageLinkL @?= RssURI [uri|http://link.ext|] result^.imageWidthL @?= Just 100 result^.imageHeightL @?= Just 200 result^.imageDescriptionL @?= "Description" where input = [ "" , "http://image.ext" , "Title" , "Ignored" , "http://link.ext" , "100" , "200" , "Description" , "Ignored" , "" ] categoryCase :: TestTree categoryCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssCategory result @?= RssCategory "Domain" "Name" where input = [ "" , "Name" , "" ] cloudCase :: TestTree cloudCase = testCase " element" $ do result1:result2:_ <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| XML.many rssCloud result1 @?= RssCloud uri "pingMe" ProtocolSoap result2 @?= RssCloud uri "myCloud.rssPleaseNotify" ProtocolXmlRpc where input = [ "" , "" ] uri = RssURI [relativeRef|//rpc.sys.com:80/RPC2|] guidCase :: TestTree guidCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| XML.many rssGuid result @?= [GuidUri uri, GuidText "1", GuidText "2"] where input = [ "//guid.ext" , "1" , "2" ] uri = RssURI [relativeRef|//guid.ext|] enclosureCase :: TestTree enclosureCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssEnclosure result @?= RssEnclosure url 12216320 "audio/mpeg" where input = [ "" ] url = RssURI [uri|http://www.scripting.com/mp3s/weatherReportSuite.mp3|] sourceCase :: TestTree sourceCase = testCase " element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSource result @?= RssSource url "Tomalak's Realm" where input = [ "Tomalak's Realm" ] url = RssURI [uri|http://www.tomalak.org/links2.xml|] rss1ItemCase :: TestTree rss1ItemCase = testCase "RSS1 element" $ do Just result <- runResourceT $ runConduit $ sourceList input .| XML.parseText' def .| rss1Item result^.itemTitleL @?= "Processing Inclusions with XSLT" result^.itemLinkL @?= Just link result^.itemDescriptionL @?= "Processing document inclusions with general XML tools can be problematic. This article proposes a way of preserving inclusion information through SAX-based processing." result^.itemExtensionsL @?= NoItemExtensions where input = [ "" , "Processing Inclusions with XSLT" , "Processing document inclusions with general XML tools can be" , " problematic. This article proposes a way of preserving inclusion" , " information through SAX-based processing." , "" , "http://xml.com/pub/2000/08/09/xslt/xslt.html" , "Some content in unknown tag, should be ignored." , "" ] link = RssURI [uri|http://xml.com/pub/2000/08/09/xslt/xslt.html|] rss2ItemCase1 :: TestTree rss2ItemCase1 = testCase "RSS2 element 1" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssItem result^.itemTitleL @?= "Example entry" result^.itemLinkL @?= Just link result^.itemDescriptionL @?= "Here is some text containing an interesting description." result^.itemGuidL @?= Just (GuidText "7bd204c6-1655-4c27-aeee-53f933c5395f") result^.itemExtensionsL @?= NoItemExtensions isJust (result^.itemPubDateL) @?= True where input = [ "" , "Example entry" , "Here is some text containing an interesting description." , "http://www.example.com/blog/post/1" , "7bd204c6-1655-4c27-aeee-53f933c5395f" , "Sun, 06 Sep 2009 16:20:00 +0000" , "Some content in unknown tag, should be ignored." , "" ] link = RssURI [uri|http://www.example.com/blog/post/1|] rss2ItemCase2 :: TestTree rss2ItemCase2 = testCase "RSS2 element 2" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssItem result^.itemTitleL @?= "Plop" result^.itemLinkL @?= Nothing result^.itemDescriptionL @?= "" result^.itemAuthorL @?= "author@w3schools.com" result^.itemGuidL @?= Nothing result^.itemExtensionsL @?= NoItemExtensions isJust (result^.itemPubDateL) @?= True where input = [ "" , "Plop" , "author@w3schools.com" , "2018-07-13T00:00:00-04:00" , "" ] link = RssURI [uri|http://www.example.com/blog/post/1|] rss1ChannelItemsCase :: TestTree rss1ChannelItemsCase = testCase "RSS1 element" $ do result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rss1ChannelItems result @?= [resource1, resource2] where input = [ "" , "" , "" , "" , "" , "" ] resource1 = "http://xml.com/pub/2000/08/09/xslt/xslt.html" resource2 = "http://xml.com/pub/2000/08/09/rdfdb/index.html" rss1DocumentCase :: TestTree rss1DocumentCase = testCase " element" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rss1Document result^.documentVersionL @?= Version [1] [] result^.channelTitleL @?= "XML.com" result^.channelDescriptionL @?= "XML.com features a rich mix of information and services for the XML community." result^.channelLinkL @?= link result^?channelImageL._Just.imageTitleL @?= Just "XML.com" result^?channelImageL._Just.imageLinkL @?= Just imageLink result^?channelImageL._Just.imageUriL @?= Just imageUri length (result^.channelItemsL) @?= 2 result^?channelTextInputL._Just.textInputTitleL @?= Just "Search XML.com" result^?channelTextInputL._Just.textInputDescriptionL @?= Just "Search XML.com's XML collection" result^?channelTextInputL._Just.textInputNameL @?= Just "s" result^?channelTextInputL._Just.textInputLinkL @?= Just textInputLink result^.channelExtensionsL @?= NoChannelExtensions where input = [ "" , "" , "" , "XML.com" , "http://xml.com/pub" , "XML.com features a rich mix of information and services for the XML community." , "" , "" , "" , "" , "" , "" , "" , "" , "" , "XML.com" , "http://www.xml.com" , "http://xml.com/universal/images/xml_tiny.gif" , "" , "" , "Processing Inclusions with XSLT" , "http://xml.com/pub/2000/08/09/xslt/xslt.html" , "Processing document inclusions with general XML tools can be problematic. This article proposes a way of preserving inclusion information through SAX-based processing." , "" , "" , "Putting RDF to Work" , "http://xml.com/pub/2000/08/09/rdfdb/index.html" , "Tool and API support for the Resource Description Framework is slowly coming of age. Edd Dumbill takes a look at RDFDB, one of the most exciting new RDF toolkits." , "" , "" , "Search XML.com" , "Search XML.com's XML collection" , "s" , "http://search.xml.com" , "" , "" ] link = RssURI [uri|http://xml.com/pub|] imageLink = RssURI [uri|http://www.xml.com|] imageUri = RssURI [uri|http://xml.com/universal/images/xml_tiny.gif|] textInputLink = RssURI [uri|http://search.xml.com|] dublinCoreChannelCase :: TestTree dublinCoreChannelCase = testCase "Dublin Core extension" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument result^.channelExtensionsL @?= DublinCoreChannel dublinCoreElement NoChannelExtensions where input = [ "" , "" , "" , "RSS Title" , "http://xml.com/pub/2000/08/09/xslt/xslt.html" , "The O'Reilly Network" , "Rael Dornfest (mailto:rael@oreilly.com)" , "2000-01-01T12:00:00+00:00" , "EN" , "Copyright © 2000 O'Reilly & Associates, Inc." , "XML" , "" , "" ] dublinCoreElement = mkDcMetaData { elementCreator = "Rael Dornfest (mailto:rael@oreilly.com)" , elementDate = Just date , elementLanguage = "EN" , elementPublisher = "The O'Reilly Network" , elementRights = "Copyright © 2000 O'Reilly & Associates, Inc." , elementSubject = "XML" } date = localTimeToUTC utc $ LocalTime (fromGregorian 2000 1 1) (TimeOfDay 12 0 0) dublinCoreItemCase :: TestTree dublinCoreItemCase = testCase "Dublin Core extension" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem result^.itemExtensionsL @?= DublinCoreItem dublinCoreElement NoItemExtensions where input = [ "" , "Example entry" , "XML is placing increasingly heavy loads on the existing technical " , "infrastructure of the Internet." , "EN" , "The O'Reilly Network" , "Simon St.Laurent (mailto:simonstl@simonstl.com)" , "2000-01-01T12:00:00+00:00" , "Copyright © 2000 O'Reilly & Associates, Inc." , "XML" , "" ] dublinCoreElement = mkDcMetaData { elementCreator = "Simon St.Laurent (mailto:simonstl@simonstl.com)" , elementDate = Just date , elementLanguage = "EN" , elementDescription = "XML is placing increasingly heavy loads on the existing technical infrastructure of the Internet." , elementPublisher = "The O'Reilly Network" , elementRights = "Copyright © 2000 O'Reilly & Associates, Inc." , elementSubject = "XML" } date = localTimeToUTC utc $ LocalTime (fromGregorian 2000 1 1) (TimeOfDay 12 0 0) contentItemCase :: TestTree contentItemCase = testCase "Content extension" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem result^.itemExtensionsL @?= ContentItem "

What a beautiful day!

" NoItemExtensions where input = [ "" , "Example entry" , "What a beautiful day!

]]>
" , "
" ] syndicationChannelCase :: TestTree syndicationChannelCase = testCase "Syndication extension" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument result^.channelExtensionsL @?= SyndicationChannel syndicationInfo NoChannelExtensions where input = [ "" , "" , "" , "RSS Title" , "http://xml.com/pub/2000/08/09/xslt/xslt.html" , "hourly" , "2" , "2000-01-01T12:00:00+00:00" , "" , "" ] syndicationInfo = mkSyndicationInfo { updatePeriod = Just Hourly , updateFrequency = Just 2 , updateBase = Just date } date = localTimeToUTC utc $ LocalTime (fromGregorian 2000 1 1) (TimeOfDay 12 0 0) atomChannelCase :: TestTree atomChannelCase = testCase "Atom extension" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument result^.channelExtensionsL @?= AtomChannel (Just link) NoChannelExtensions where input = [ "" , "" , "" , "RSS Title" , "http://xml.com/pub/2000/08/09/xslt/xslt.html" , "" , "" , "" ] url = AtomURI [uri|http://dallas.example.com/rss.xml|] link = AtomLink url "self" "application/rss+xml" mempty mempty mempty multipleExtensionsCase :: TestTree multipleExtensionsCase = testCase "Multiple extensions" $ do Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem result^.itemExtensionsL @?= ContentItem "

What a beautiful day!

" (AtomItem (Just link) NoItemExtensions) where input = [ "" , "Example entry" , "" , "What a beautiful day!

]]>
" , "
" ] url = AtomURI [uri|http://dallas.example.com/rss.xml|] link = AtomLink url "self" "application/rss+xml" mempty mempty mempty