{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}

module Data.InstanceSpec
  ( spec
  ) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*>), pure)
import Data.Functor ((<$>))
#endif
import Data.Data
import Data.Int
#if MIN_VERSION_base(4,9,0)
import Data.List.NonEmpty (NonEmpty)
#endif
import Data.Fixed
import Data.Ratio
import Data.Word

import Control.Monad

import Test.Hspec
import Test.Hspec.Core.QuickCheck (modifyMaxSize, modifyMaxSuccess)
import Test.QuickCheck
#if MIN_VERSION_base(4,8,0)
import GHC.Natural
#endif
import Data.GenValidity

spec :: Spec
spec = do
  twoTests (Proxy :: Proxy ())
  twoTests (Proxy :: Proxy Bool)
  twoTests (Proxy :: Proxy Ordering)
  twoTests (Proxy :: Proxy Char)
  twoTests (Proxy :: Proxy Word)
  twoTests (Proxy :: Proxy Word8)
  twoTests (Proxy :: Proxy Word16)
  twoTests (Proxy :: Proxy Word32)
  twoTests (Proxy :: Proxy Word64)
  twoTests (Proxy :: Proxy Int)
  twoTests (Proxy :: Proxy Int8)
  twoTests (Proxy :: Proxy Int16)
  twoTests (Proxy :: Proxy Int32)
  twoTests (Proxy :: Proxy Int64)
  twoTests (Proxy :: Proxy Integer)
  twoTests (Proxy :: Proxy Float)
  twoTupleTests (Proxy :: Proxy Float)
  twoTests (Proxy :: Proxy Double)
  twoTupleTests (Proxy :: Proxy Double)
  threeTests (Proxy :: Proxy (Ratio Int))
  modifyMaxSuccess (`quot` 2) $
    modifyMaxSize (`quot` 2) $ twoTests (Proxy :: Proxy (Either Bool Ordering))
  twoTests (Proxy :: Proxy (Maybe Ordering))
  twoTests (Proxy :: Proxy (Maybe (Maybe (Ordering))))
  threeTests (Proxy :: Proxy (Ratio Integer))
    -- threeTupleTests (Proxy :: Proxy (Ratio Integer))
  threeTests (Proxy :: Proxy (Ratio Int))
    -- threeTupleTests (Proxy :: Proxy (Ratio Int))
  threeTests (Proxy :: Proxy (Ratio Int8))
  describe "shrinking (Ratio Int)" $
    it "can shrink this example" $
    let v = ((-9223372036854775808) % 9223372036854775761) :: Ratio Int
     in v `notElem` shrinkValid v
  describe "shrinking (Ratio Int8)" $
    it "can shrink this example" $
    let v = ((-128) % 113) :: Ratio Int8
     in v `notElem` shrinkValid v
  twoTests (Proxy :: Proxy Uni)
  twoTupleTests (Proxy :: Proxy Uni)
  twoTests (Proxy :: Proxy Deci)
  twoTupleTests (Proxy :: Proxy Deci)
  twoTests (Proxy :: Proxy Centi)
  twoTupleTests (Proxy :: Proxy Centi)
  twoTests (Proxy :: Proxy Milli)
  twoTupleTests (Proxy :: Proxy Milli)
  twoTests (Proxy :: Proxy Micro)
  twoTupleTests (Proxy :: Proxy Micro)
  twoTests (Proxy :: Proxy Nano)
  twoTupleTests (Proxy :: Proxy Nano)
  twoTests (Proxy :: Proxy Pico)
  twoTupleTests (Proxy :: Proxy Pico)
#if MIN_VERSION_base(4,8,0)
  twoTests (Proxy :: Proxy Natural)

  twoTupleTests (Proxy :: Proxy Natural)
#endif
#if MIN_VERSION_base(4,9,0)
  twoTests (Proxy :: Proxy (NonEmpty Ordering))
#endif
twoTupleTests ::
     forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a)
  => Proxy a
  -> Spec
twoTupleTests proxy = do
  modifyMaxSuccess (`quot` 2) $ modifyMaxSize (`quot` 2) $ twoTests $ (,) <$> proxy <*> proxy

twoTests ::
     forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a)
  => Proxy a
  -> Spec
twoTests proxy =
  describe (nameOf proxy) $ do
    genUncheckedTest proxy
    genValidTest proxy

threeTests ::
     forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a, GenInvalid a)
  => Proxy a
  -> Spec
threeTests proxy =
  describe (nameOf proxy) $ do
    genUncheckedTest proxy
    genValidTest proxy
    genInvalidTest proxy

genUncheckedTest ::
     forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a)
  => Proxy a
  -> Spec
genUncheckedTest proxy = do
  it (unwords ["genUnchecked of", nameOf proxy, "does not crash while validating"]) $
    forAll genUnchecked $ \a ->
      case prettyValidate (a :: a) of
        Right v -> seq v True
        Left err -> seq err True
  modifyMaxSuccess (`quot` 5) $
    it
      (unwords
         [ "shrinkUnchecked of"
         , nameOf proxy
         , "only produces values that do not crash while validating"
         ]) $
    forAll genUnchecked $ \a ->
      forM_ (shrinkUnchecked a) $ \v ->
        case prettyValidate (v :: a) of
          Right v_ -> seq v_ $ pure () :: IO ()
          Left err -> seq err $ pure ()
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkUnchecked of", nameOf proxy, "does not shrink to itself"]) $
    forAll genValid $ \a ->
      forM_ (shrinkUnchecked a) $ \a' ->
        unless (a /= a') $
        expectationFailure $ unlines ["The value", show (a :: a), "was shrunk to itself"]

genValidTest ::
     forall a. (Show a, Eq a, Typeable a, GenValid a)
  => Proxy a
  -> Spec
genValidTest proxy = do
  it (unwords ["genValid of", nameOf proxy, "generates only valid values"]) $
    forAll genValid $ \a ->
      case prettyValidate (a :: a) of
        Right v -> seq v $ pure ()
        Left err ->
          expectationFailure $
          unlines ["'validate' reported this value to be invalid:", show a, err, ""]
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkValid of", nameOf proxy, "shrinks to only valid values"]) $
    forAll genValid $ \a ->
      forM_ (shrinkValid a) $ \v ->
        case prettyValidate (v :: a) of
          Right v_ -> seq v_ $ pure ()
          Left err ->
            expectationFailure $
            unlines ["'validate' reported this value to be invalid:", show v, err, ""]
  modifyMaxSuccess (`quot` 5) $
    it
      (unwords
         ["shrinkValid of", nameOf proxy, "only produces values that do not crash while validating"]) $
    forAll genValid $ \a ->
      forM_ (shrinkValid a) $ \v ->
        case prettyValidate (v :: a) of
          Right v_ -> seq v_ $ pure () :: IO ()
          Left err -> seq err $ pure ()
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkValid of", nameOf proxy, "does not shrink to itself"]) $
    forAll genValid $ \a ->
      forM_ (shrinkValid a) $ \a' ->
        unless (a /= a') $
        expectationFailure $ unlines ["The value", show (a :: a), "was shrunk to itself"]

genInvalidTest ::
     forall a. (Show a, Typeable a, GenInvalid a)
  => Proxy a
  -> Spec
genInvalidTest proxy = do
  it (unwords ["genInvalid of", nameOf proxy, "generates only invalid values"]) $
    forAll genInvalid $ \a ->
      case prettyValidate (a :: a) of
        Right _ ->
          expectationFailure $ unlines ["'validate' reported this value to be valid: ", show a]
        Left e -> seq e $ pure ()
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkInvalid of", nameOf proxy, "shrinks to only invalid values"]) $
    forAll genInvalid $ \a ->
      forM_ (shrinkInvalid a) $ \v ->
        case prettyValidate (v :: a) of
          Right _ ->
            expectationFailure $ unlines ["'validate' reported this value to be valid: ", show v]
          Left e -> seq e $ pure ()
  modifyMaxSuccess (`quot` 5) $
    it
      (unwords
         [ "shrinkInvalid of"
         , nameOf proxy
         , "only produces values that do not crash while validating"
         ]) $
    forAll genInvalid $ \a ->
      forM_ (shrinkInvalid a) $ \v ->
        case prettyValidate (v :: a) of
          Right _ ->
            expectationFailure $ unlines ["'validate' reported this value to be valid: ", show v]
          Left e -> seq e $ pure ()

nameOf ::
     forall a. Typeable a
  => Proxy a
  -> String
nameOf = show . typeRep