{-# 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)