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

    module Hedgehog.Classes.Functor (functorLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common

    -- | Tests the following 'Functor' laws:
    --
    -- [__Identity__]: @'fmap' 'id'@ ≡ @'id'@
    -- [__Composition__]: @'fmap' f '.' 'fmap' g@ ≡ @'fmap' (f '.' g)@
    -- [__Const__]: @'fmap' ('const' x)@ ≡ @x '<$'@
    functorLaws ::
      ( Functor f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Laws
    functorLaws :: forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Laws
    functorLaws forall x. Gen x -> Gen (f x)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Functor"
      [ (String
    "Identity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorIdentity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Composition", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorComposition Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Const", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorConst Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      ]

    functorIdentity ::
      ( Functor f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Property
    functorIdentity :: forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorIdentity forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      let lhs = (Integer -> Integer) -> f Integer -> f Integer
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> Integer
    forall a. a -> a
    id f Integer
    a
      let rhs = f Integer -> f Integer
    forall a. a -> a
    id f Integer
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Identity", lawContextTcName :: String
    lawContextTcName = String
    "Functor"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "fmap id" String -> String -> String
    `congruency` String
    "id"
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    a
                in [String] -> String
    lawWhere
                  [ String
    "fmap id a" String -> String -> String
    `congruency` String
    "id a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  ]
            , lawContextReduced :: String
    lawContextReduced = f Integer -> f Integer -> String
    forall a. Show a => a -> a -> String
    reduced f Integer
    lhs f Integer
    rhs
            }
      heqCtx lhs rhs ctx

    functorComposition ::
      ( Functor f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Property
    functorComposition :: forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorComposition forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      let f = (Integer, Integer) -> (Bool, Either Ordering Integer)
    func2; g = Integer -> (Integer, Integer)
    func1
      let lhs = ((Integer, Integer) -> (Bool, Either Ordering Integer))
    -> f (Integer, Integer) -> f (Bool, Either Ordering Integer)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer, Integer) -> (Bool, Either Ordering Integer)
    f ((Integer -> (Integer, Integer))
    -> f Integer -> f (Integer, Integer)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> (Integer, Integer)
    g f Integer
    a)
      let rhs = (Integer -> (Bool, Either Ordering Integer))
    -> f Integer -> f (Bool, Either Ordering Integer)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Integer, Integer) -> (Bool, Either Ordering Integer)
    f ((Integer, Integer) -> (Bool, Either Ordering Integer))
    -> (Integer -> (Integer, Integer))
    -> Integer
    -> (Bool, Either Ordering Integer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> (Integer, Integer)
    g) f Integer
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Composition", lawContextTcName :: String
    lawContextTcName = String
    "Functor"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "fmap f . fmap g" String -> String -> String
    `congruency` String
    "fmap (f . g)"
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    a
                    showF :: String
    showF = String
    "\\(a,b) -> (odd a, if even a then Left (compare a b) else Right (b + 2)"
                    showG :: String
    showG = String
    "\\i -> (div (i + 5) 3, i * i - 2 * i + 1)"
                in [String] -> String
    lawWhere
                  [ String
    "fmap f . fmap g $ a" String -> String -> String
    `congruency` String
    "fmap (f . g) a, where"
                  , String
    "f = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showF
                  , String
    "g = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showG
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  ]
            , lawContextReduced :: String
    lawContextReduced = f (Bool, Either Ordering Integer)
    -> f (Bool, Either Ordering Integer) -> String
    forall a. Show a => a -> a -> String
    reduced f (Bool, Either Ordering Integer)
    lhs f (Bool, Either Ordering Integer)
    rhs
            }
      heqCtx lhs rhs ctx

    functorConst ::
      ( Functor f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Property
    functorConst :: forall (f :: * -> *).
    (Functor f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Property
    functorConst forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      let x = Char
    'X'
      let lhs = (Integer -> Char) -> f Integer -> f Char
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Char -> Integer -> Char
    forall a b. a -> b -> a
    const Char
    x) f Integer
    a
      let rhs = Char
    x Char -> f Integer -> f Char
    forall a b. a -> f b -> f a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ f Integer
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Const", lawContextTcName :: String
    lawContextTcName = String
    "Functor"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "fmap (const x)" String -> String -> String
    `congruency` String
    "x <$"
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    a
                    showX :: String
    showX = Char -> String
    forall a. Show a => a -> String
    show Char
    x
                in [String] -> String
    lawWhere
                  [ String
    "fmap (const x) a" String -> String -> String
    `congruency` String
    "x <$ a, where"
                  , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  ]
            , lawContextReduced :: String
    lawContextReduced = f Char -> f Char -> String
    forall a. Show a => a -> a -> String
    reduced f Char
    lhs f Char
    rhs
            }
      heqCtx lhs rhs ctx