dublincore-xml-conduit-0.1.0.2: test/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
import           Text.XML.DublinCore.Conduit.Parse
import           Text.XML.DublinCore.Conduit.Render

import           Conduit
import           Data.Monoid
import           Data.Text
import           Data.Time.Clock
import           Data.XML.Types
import           Test.QuickCheck
import           Test.QuickCheck.Instances          ()
import           Test.Tasty
import           Test.Tasty.HUnit
import           Test.Tasty.QuickCheck

main :: IO ()
main = defaultMain $ testGroup "Tests"
  [ properties
  ]

properties :: TestTree
properties = testGroup "Properties"
  [ roundtripTest "contributor" renderElementContributor elementContributor
  , roundtripTest "coverage" renderElementCoverage elementCoverage
  , roundtripTest "creator" renderElementCreator elementCreator
  , roundtripTest' "date" renderElementDate elementDate genTime
  , roundtripTest "description" renderElementDescription elementDescription
  , roundtripTest "format" renderElementFormat elementFormat
  , roundtripTest "identifier" renderElementIdentifier elementIdentifier
  , roundtripTest "language" renderElementLanguage elementLanguage
  , roundtripTest "publisher" renderElementPublisher elementPublisher
  , roundtripTest "relation" renderElementRelation elementRelation
  , roundtripTest "rights" renderElementRights elementRights
  , roundtripTest "source" renderElementSource elementSource
  , roundtripTest "subject" renderElementSubject elementSubject
  , roundtripTest "title" renderElementTitle elementTitle
  , roundtripTest "type" renderElementType elementType
  ]

roundtripTest :: Eq a => Show a => Arbitrary a
              => TestName -> (a -> Source (Either e) Event) -> Consumer Event (Either e) (Maybe a) -> TestTree
roundtripTest name render parse = testProperty ("parse . render = id (" <> name <> ")") $ \t -> either (const False) (Just t ==) (runConduit $ render t =$= parse)

roundtripTest' :: Eq a => Show a
              => TestName -> (a -> Source (Either e) Event) -> Consumer Event (Either e) (Maybe a) -> Gen a -> TestTree
roundtripTest' name render parse gen = testProperty ("parse . render = id (" <> name <> ")") $ do
  a <- gen
  return $ either (const False) (Just a ==) $ runConduit (render a =$= parse)

-- | Generate 'UTCTime' with rounded seconds.
genTime :: Gen UTCTime
genTime = do
  (UTCTime d s) <- arbitrary
  return $ UTCTime d $ fromIntegral (round s :: Int)