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

    module Hedgehog.Classes.Alternative (alternativeLaws) where

    import Control.Applicative (Alternative(..))

    import Hedgehog
    import Hedgehog.Classes.Common

    -- | Tests the following 'Alternative' laws:
    --
    -- [__Left Identity__]: @'empty' '<|>' a@ ≡ @a@
    -- [__Right Identity__]: @a '<|>' 'empty'@ ≡ @a@
    -- [__Associativity__]: @a '<|>' (b '<|>' c)@ ≡ @(a '<|>' b) '<|>' c@
    alternativeLaws ::
      ( Alternative f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Laws
    alternativeLaws :: forall (f :: * -> *).
    (Alternative f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Laws
    alternativeLaws forall x. Gen x -> Gen (f x)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Alternative"
      [ (String
    "Left Identity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). AlternativeProp f
    alternativeLeftIdentity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Right Identity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). AlternativeProp f
    alternativeRightIdentity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Associativity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). AlternativeProp f
    alternativeAssociativity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      ]

    type AlternativeProp f =
      ( Alternative f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Property

    alternativeLeftIdentity :: forall f. AlternativeProp f
    alternativeLeftIdentity :: forall (f :: * -> *). AlternativeProp f
    alternativeLeftIdentity 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 = f Integer
    forall a. f a
    forall (f :: * -> *) a. Alternative f => f a
    empty f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f Integer
    a
      let rhs = f Integer
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Left Identity", lawContextLawBody :: String
    lawContextLawBody = String
    "empty <|> a" String -> String -> String
    `congruency` String
    "a"
            , lawContextTcName :: String
    lawContextTcName = String
    "Alternative", 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
    "empty <|> a" String -> String -> String
    `congruency` String
    "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
            }
      heqCtx1 lhs rhs ctx

    alternativeRightIdentity :: forall f. AlternativeProp f
    alternativeRightIdentity :: forall (f :: * -> *). AlternativeProp f
    alternativeRightIdentity 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 = f Integer
    a f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f Integer
    forall a. f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      let rhs = f Integer
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Right Identity", lawContextLawBody :: String
    lawContextLawBody = String
    "a <|> empty" String -> String -> String
    `congruency` String
    "a"
            , lawContextTcName :: String
    lawContextTcName = String
    "Alternative", 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
    "a <|> empty" String -> String -> String
    `congruency` String
    "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
            }
      heqCtx1 lhs rhs ctx

    alternativeAssociativity :: forall f. AlternativeProp f
    alternativeAssociativity :: forall (f :: * -> *). AlternativeProp f
    alternativeAssociativity 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
      b <- forAll $ fgen genSmallInteger
      c <- forAll $ fgen genSmallInteger
      let lhs = (f Integer
    a f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (f Integer
    b f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f Integer
    c))
      let rhs = ((f Integer
    a f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f Integer
    b) f Integer -> f Integer -> f Integer
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> f Integer
    c)
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Associativity", lawContextLawBody :: String
    lawContextLawBody = String
    "a <|> (b <|> c)" String -> String -> String
    `congruency` String
    "(a <|> b) <|> c"
            , lawContextTcName :: String
    lawContextTcName = String
    "Alternative", lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    a; showB :: String
    showB = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    b; showC :: String
    showC = f Integer -> String
    forall a. Show a => a -> String
    show f Integer
    c;
                in [String] -> String
    lawWhere
                     [ String
    "a <|> (b <|> c)" String -> String -> String
    `congruency` String
    "(a <|> b) <|> c), where"
                     , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                     , String
    "b = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showB
                     , String
    "c = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showC
                     ]
            , lawContextReduced :: String
    lawContextReduced = f Integer -> f Integer -> String
    forall a. Show a => a -> a -> String
    reduced f Integer
    lhs f Integer
    rhs
            }
      heqCtx1 lhs rhs ctx