dublincore-xml-conduit-0.1.0.3: 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 -> ConduitT () Event (Either e) ())
  -> ConduitT Event Void (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 -> ConduitT () Event (Either e) ())
  -> ConduitT Event Void (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)