applicative-fail-1.0.0: test/Test.hs

{-# OPTIONS -fno-warn-orphans #-}
module Main where

import Control.Applicative
import Control.Applicative.Fail
import Control.Monad.Fail
import Control.Monad.Identity
import Test.QuickCheck hiding ( Success )
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes
import Test.Tasty
import Test.Tasty.QuickCheck hiding ( Success )

tastyUnbatch :: String -> TestBatch -> TestTree
tastyUnbatch name b =
    let u = unbatch b
    in testGroup name $ map (uncurry testProperty) u

instance (Arbitrary e, Arbitrary a) => Arbitrary (Fail e a) where
    arbitrary = oneof
        [ Success <$> arbitrary
        , Fail <$> arbitrary <*> arbitrary ]

instance (Eq e, Eq a) => EqProp (Fail e a) where
    a =-= b = eq a b

instance Arbitrary a => Arbitrary (Identity a) where
    arbitrary = Identity <$> arbitrary

instance (Arbitrary e, Arbitrary a) => Arbitrary (FailT e Identity a) where
    arbitrary = FailT <$> arbitrary

instance (Eq e, Eq a) => EqProp (FailT e Identity a) where
    a =-= b = eq a b

prop_FunctorFail :: TestTree
prop_FunctorFail = tastyUnbatch "Functor"
    $ functor (undefined :: Fail [Int] (Int, Int, Int))

prop_ApplicativeFail :: TestTree
prop_ApplicativeFail  = tastyUnbatch "Applicative"
    $ applicative (undefined :: Fail [Int] (Int, Int, Int))

prop_MonoidFail :: TestTree
prop_MonoidFail = tastyUnbatch "Monoid"
    $ monoid (undefined :: Fail [Int] [Int])

prop_FunctorFailT :: TestTree
prop_FunctorFailT = tastyUnbatch "Function"
    $ functor (undefined :: FailT Int Identity (Int, Int, Int))

prop_ApplicativeFailT :: TestTree
prop_ApplicativeFailT  = tastyUnbatch "Applicative"
    $ applicative (undefined :: FailT [Int] Identity (Int, Int, Int))

prop_MonoidFailT :: TestTree
prop_MonoidFailT = tastyUnbatch "Monoid"
    $ monoid (undefined :: FailT [Int] Identity [Int])

prop_MonadFailT :: TestTree
prop_MonadFailT = tastyUnbatch "Monad"
    $ monad (undefined ::  FailT [Int] Identity (Int, Int, Int))

prop_MonadApplicativeFailT :: TestTree
prop_MonadApplicativeFailT = tastyUnbatch "Monad <-> Applicative"
    $ monadApplicative (undefined :: FailT [Int] Identity (Int, Int))

prop_MonadFunctorFailT :: TestTree
prop_MonadFunctorFailT = tastyUnbatch "Monad <-> Functor"
    $ monadFunctor (undefined :: FailT [Int] Identity (Int, Int))

main :: IO ()
main = defaultMain $ testGroup "properties"
    [ testGroup "Fail"
      [ prop_FunctorFail
      , prop_ApplicativeFail
      , prop_MonoidFail
      ]
    , testGroup "MFail"
      [ prop_FunctorFailT
      , prop_ApplicativeFailT
      , prop_MonoidFailT
      , prop_MonadFailT
      , prop_MonadFunctorFailT
      , prop_MonadApplicativeFailT
      ]
    ]