    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE QuantifiedConstraints #-}

    module Hedgehog.Classes.Arrow (arrowLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common

    import Control.Arrow(Arrow(..), (>>>))
    import Control.Category(Category(..))
    import Prelude hiding (id, (.))
    import qualified Prelude

    -- | Tests the following 'Arrow' laws:
    --
    -- [__Arr Identity__]: @'arr' 'id'@ ≡ @'id'@
    -- [__Arr Composition__]: @'arr' (f '>>>' g)@ ≡ @'arr' f '>>>' 'arr' g@
    -- [__Arr-First inverse__]: @'first' ('arr' f)@ ≡ @'arr' ('first' f)@
    -- [__First Composition__]: @'first' (f '>>>' g)@ ≡ @'first' f '>>>' 'first' g@
    -- [__Arrow Law 5__]: @'first' f '>>>' 'arr' 'fst'@ ≡ @'arr' 'fst' '>>>' f@
    -- [__Arrow Law 6__]: @'first' f '>>>' 'arr' ('id' '***' g)@ ≡ @'arr' ('id' '***' g) '>>>' 'first' f@
    -- [__Arrow Law 7__]: @'first' ('first' f) '>>>' 'arr' assoc@ ≡ @'arr' assoc '>>>' 'first' f, where assoc ((a,b),c) = (a,(b,c))@
    arrowLaws :: forall f.
      ( Arrow f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    arrowLaws :: forall (f :: * -> * -> *).
    (Arrow f, forall x y. (Eq x, Eq y) => Eq (f x y),
     forall x y. (Show x, Show y) => Show (f x y)) =>
    (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    arrowLaws forall x y. Gen x -> Gen y -> Gen (f x y)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Arrow"
      [ (String
    "Arr Identity", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw1 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Arr Composition", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw2 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Arr . First == First . Arr", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw3 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "First Composition", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw4 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Arrow Law 5", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw5 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Arrow Law 6", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw6 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Arrow Law 7", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). ArrowProp f
    arrowLaw7 Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      ]

    type ArrowProp f =
      ( Arrow f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property

    arrowLaw1 :: forall f. ArrowProp f
    arrowLaw1 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw1 forall x y. Gen x -> Gen y -> Gen (f x y)
    _ = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      (Integer -> Integer) -> f Integer Integer
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr Integer -> Integer
    forall a. a -> a
    Prelude.id f Integer Integer -> f Integer Integer -> PropertyT IO ()
    forall (m :: * -> *) a b (f :: * -> * -> *).
    (MonadTest m, HasCallStack, Eq a, Eq b, Show a, Show b,
     forall x y. (Eq x, Eq y) => Eq (f x y),
     forall x y. (Show x, Show y) => Show (f x y)) =>
    f a b -> f a b -> m ()
    `heq2` (f Integer Integer
    forall a. f a a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id :: f Integer Integer)

    arrowLaw2 :: forall f. ArrowProp f
    arrowLaw2 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw2 forall x y. Gen x -> Gen y -> Gen (f x y)
    _ = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f' <- Gen QuadraticEquation -> PropertyT IO QuadraticEquation
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen QuadraticEquation
    genQuadraticEquation
      g' <- forAll genQuadraticEquation
      let f = QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    f'
          g = QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    g'
      (arr (f >>> g) :: f Integer Integer) `heq2` (arr f >>> arr g)

    arrowLaw3 :: forall f. ArrowProp f
    arrowLaw3 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw3 forall x y. Gen x -> Gen y -> Gen (f x y)
    _ = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f' <- Gen QuadraticEquation -> PropertyT IO QuadraticEquation
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen QuadraticEquation
    genQuadraticEquation
      let f = QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    f'
      let x = f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Integer -> Integer) -> f Integer Integer
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr Integer -> Integer
    f) :: f (Integer, Integer) (Integer, Integer)
      let y = ((Integer, Integer) -> (Integer, Integer))
    -> f (Integer, Integer) (Integer, Integer)
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((Integer -> Integer) -> (Integer, Integer) -> (Integer, Integer)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Integer -> Integer
    f) :: f (Integer, Integer) (Integer, Integer)
      x `heq2` y

    arrowLaw4 :: forall f. ArrowProp f
    arrowLaw4 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw4 forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      g <- forAll $ fgen genSmallInteger genSmallInteger
      let x = f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (f Integer Integer
    f f Integer Integer -> f Integer Integer -> f Integer Integer
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> f Integer Integer
    g) :: f (Integer, Integer) (Integer, Integer)
      let y = f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    g :: f (Integer, Integer) (Integer, Integer)
      x `heq2` y

    arrowLaw5 :: forall f. ArrowProp f
    arrowLaw5 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw5 forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      let x = f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) Integer -> f (Integer, Integer) Integer
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((Integer, Integer) -> Integer) -> f (Integer, Integer) Integer
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Integer, Integer) -> Integer
    forall a b. (a, b) -> a
    fst :: f (Integer, Integer) Integer
      let y = ((Integer, Integer) -> Integer) -> f (Integer, Integer) Integer
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Integer, Integer) -> Integer
    forall a b. (a, b) -> a
    fst f (Integer, Integer) Integer
    -> f Integer Integer -> f (Integer, Integer) Integer
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> f Integer Integer
    f :: f (Integer, Integer) Integer
      x `heq2` y

    arrowLaw6 :: forall f. ArrowProp f
    arrowLaw6 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw6 forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      g' <- forAll genQuadraticEquation
      let g = QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    g'
      let x = ((f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f) f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (((Integer, Integer) -> (Integer, Integer))
    -> f (Integer, Integer) (Integer, Integer)
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Integer -> Integer
    forall a. a -> a
    Prelude.id (Integer -> Integer)
    -> (Integer -> Integer) -> (Integer, Integer) -> (Integer, Integer)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Integer -> Integer
    g))) :: f (Integer, Integer) (Integer, Integer)
      let y = ((Integer, Integer) -> (Integer, Integer))
    -> f (Integer, Integer) (Integer, Integer)
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Integer -> Integer
    forall a. a -> a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id (Integer -> Integer)
    -> (Integer -> Integer) -> (Integer, Integer) -> (Integer, Integer)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Integer -> Integer
    g) f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    -> f (Integer, Integer) (Integer, Integer)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f :: f (Integer, Integer) (Integer, Integer)
      x `heq2` y

    arrowLaw7 :: forall f. ArrowProp f
    arrowLaw7 :: forall (f :: * -> * -> *). ArrowProp f
    arrowLaw7 forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      let assoc :: ((a, a), b) -> (a, (a, b))
    assoc ((a
    a,a
    b),b
    c) = (a
    a,(a
    b,b
    c))
      f <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      let x = f (Integer, Integer) (Integer, Integer)
    -> f ((Integer, Integer), Integer) ((Integer, Integer), Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (f Integer Integer -> f (Integer, Integer) (Integer, Integer)
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f) f ((Integer, Integer), Integer) ((Integer, Integer), Integer)
    -> f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    -> f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (((Integer, Integer), Integer) -> (Integer, (Integer, Integer)))
    -> f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((Integer, Integer), Integer) -> (Integer, (Integer, Integer))
    forall {a} {a} {b}. ((a, a), b) -> (a, (a, b))
    assoc :: f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
      let y = (((Integer, Integer), Integer) -> (Integer, (Integer, Integer)))
    -> f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    forall b c. (b -> c) -> f b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((Integer, Integer), Integer) -> (Integer, (Integer, Integer))
    forall {a} {a} {b}. ((a, a), b) -> (a, (a, b))
    assoc f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    -> f (Integer, (Integer, Integer)) (Integer, (Integer, Integer))
    -> f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> f Integer Integer
    -> f (Integer, (Integer, Integer)) (Integer, (Integer, Integer))
    forall b c d. f b c -> f (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first f Integer Integer
    f :: f ((Integer, Integer), Integer) (Integer, (Integer, Integer))
      x `heq2` y