dublincore-xml-conduit-0.1.0.0: 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 qualified Language.Haskell.HLint             as HLint (hlint)
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
  , hlint
  ]

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)

hlint :: TestTree
hlint = testCase "HLint check" $ do
  result <- HLint.hlint [ "test/", "src/" ]
  Prelude.null result @?= True

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