{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Unsafe #-}

module Yaya.Hedgehog.Expr
  ( Expr (Add, Lit, Mult),
    expression,
    genCofixExpr,
    genExpr,
    genExprLit,
    genExprOp,
    genFixExpr,
    genMuExpr,
    genNuExpr,
  )
where

import safe "base" Control.Applicative (Applicative ((<*>)))
import safe "base" Data.Eq (Eq)
import safe "base" Data.Foldable (Foldable)
import safe "base" Data.Functor (Functor, (<$>))
import safe "base" Data.Int (Int)
import safe "base" Data.Traversable (Traversable)
import safe "base" Text.Show (Show)
import safe "deriving-compat" Data.Eq.Deriving (deriveEq1)
import safe "deriving-compat" Text.Show.Deriving (deriveShow1)
import safe "hedgehog" Hedgehog (Gen, Size)
import safe qualified "hedgehog" Hedgehog.Gen as Gen
import safe qualified "hedgehog" Hedgehog.Range as Range
import safe "yaya" Yaya.Fold (Mu, Nu, Steppable)
import safe "yaya" Yaya.Fold.Native (Cofix, Fix)
import safe "this" Yaya.Hedgehog.Fold (embeddableOfHeight)

data Expr a
  = Lit Int
  | Add a a
  | Mult a a
  deriving stock (Expr a -> Expr a -> Bool
(Expr a -> Expr a -> Bool)
-> (Expr a -> Expr a -> Bool) -> Eq (Expr a)
forall a. Eq a => Expr a -> Expr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Expr a -> Expr a -> Bool
== :: Expr a -> Expr a -> Bool
$c/= :: forall a. Eq a => Expr a -> Expr a -> Bool
/= :: Expr a -> Expr a -> Bool
Eq, Int -> Expr a -> ShowS
[Expr a] -> ShowS
Expr a -> String
(Int -> Expr a -> ShowS)
-> (Expr a -> String) -> ([Expr a] -> ShowS) -> Show (Expr a)
forall a. Show a => Int -> Expr a -> ShowS
forall a. Show a => [Expr a] -> ShowS
forall a. Show a => Expr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Expr a -> ShowS
showsPrec :: Int -> Expr a -> ShowS
$cshow :: forall a. Show a => Expr a -> String
show :: Expr a -> String
$cshowList :: forall a. Show a => [Expr a] -> ShowS
showList :: [Expr a] -> ShowS
Show, (forall a b. (a -> b) -> Expr a -> Expr b)
-> (forall a b. a -> Expr b -> Expr a) -> Functor Expr
forall a b. a -> Expr b -> Expr a
forall a b. (a -> b) -> Expr a -> Expr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Expr a -> Expr b
fmap :: forall a b. (a -> b) -> Expr a -> Expr b
$c<$ :: forall a b. a -> Expr b -> Expr a
<$ :: forall a b. a -> Expr b -> Expr a
Functor, (forall m. Monoid m => Expr m -> m)
-> (forall m a. Monoid m => (a -> m) -> Expr a -> m)
-> (forall m a. Monoid m => (a -> m) -> Expr a -> m)
-> (forall a b. (a -> b -> b) -> b -> Expr a -> b)
-> (forall a b. (a -> b -> b) -> b -> Expr a -> b)
-> (forall b a. (b -> a -> b) -> b -> Expr a -> b)
-> (forall b a. (b -> a -> b) -> b -> Expr a -> b)
-> (forall a. (a -> a -> a) -> Expr a -> a)
-> (forall a. (a -> a -> a) -> Expr a -> a)
-> (forall a. Expr a -> [a])
-> (forall a. Expr a -> Bool)
-> (forall a. Expr a -> Int)
-> (forall a. Eq a => a -> Expr a -> Bool)
-> (forall a. Ord a => Expr a -> a)
-> (forall a. Ord a => Expr a -> a)
-> (forall a. Num a => Expr a -> a)
-> (forall a. Num a => Expr a -> a)
-> Foldable Expr
forall a. Eq a => a -> Expr a -> Bool
forall a. Num a => Expr a -> a
forall a. Ord a => Expr a -> a
forall m. Monoid m => Expr m -> m
forall a. Expr a -> Bool
forall a. Expr a -> Int
forall a. Expr a -> [a]
forall a. (a -> a -> a) -> Expr a -> a
forall m a. Monoid m => (a -> m) -> Expr a -> m
forall b a. (b -> a -> b) -> b -> Expr a -> b
forall a b. (a -> b -> b) -> b -> Expr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Expr m -> m
fold :: forall m. Monoid m => Expr m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Expr a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Expr a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Expr a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Expr a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Expr a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Expr a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Expr a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Expr a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Expr a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Expr a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Expr a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Expr a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Expr a -> a
foldr1 :: forall a. (a -> a -> a) -> Expr a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Expr a -> a
foldl1 :: forall a. (a -> a -> a) -> Expr a -> a
$ctoList :: forall a. Expr a -> [a]
toList :: forall a. Expr a -> [a]
$cnull :: forall a. Expr a -> Bool
null :: forall a. Expr a -> Bool
$clength :: forall a. Expr a -> Int
length :: forall a. Expr a -> Int
$celem :: forall a. Eq a => a -> Expr a -> Bool
elem :: forall a. Eq a => a -> Expr a -> Bool
$cmaximum :: forall a. Ord a => Expr a -> a
maximum :: forall a. Ord a => Expr a -> a
$cminimum :: forall a. Ord a => Expr a -> a
minimum :: forall a. Ord a => Expr a -> a
$csum :: forall a. Num a => Expr a -> a
sum :: forall a. Num a => Expr a -> a
$cproduct :: forall a. Num a => Expr a -> a
product :: forall a. Num a => Expr a -> a
Foldable, Functor Expr
Foldable Expr
(Functor Expr, Foldable Expr) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Expr a -> f (Expr b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Expr (f a) -> f (Expr a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Expr a -> m (Expr b))
-> (forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a))
-> Traversable Expr
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
forall (f :: * -> *) a. Applicative f => Expr (f a) -> f (Expr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Expr a -> m (Expr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Expr a -> f (Expr b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Expr a -> f (Expr b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Expr a -> f (Expr b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Expr (f a) -> f (Expr a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Expr (f a) -> f (Expr a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Expr a -> m (Expr b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Expr a -> m (Expr b)
$csequence :: forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
sequence :: forall (m :: * -> *) a. Monad m => Expr (m a) -> m (Expr a)
Traversable)

deriveEq1 ''Expr
deriveShow1 ''Expr

genExprLit :: Gen (Expr a)
genExprLit :: forall a. Gen (Expr a)
genExprLit = Int -> Expr a
forall a. Int -> Expr a
Lit (Int -> Expr a) -> GenT Identity Int -> GenT Identity (Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear (Int
-1000) Int
1000)

genExprOp :: Gen a -> Gen (Expr a)
genExprOp :: forall a. Gen a -> Gen (Expr a)
genExprOp Gen a
a = [GenT Identity (Expr a)] -> GenT Identity (Expr a)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [a -> a -> Expr a
forall a. a -> a -> Expr a
Add (a -> a -> Expr a) -> Gen a -> GenT Identity (a -> Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
a GenT Identity (a -> Expr a) -> Gen a -> GenT Identity (Expr a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
a, a -> a -> Expr a
forall a. a -> a -> Expr a
Mult (a -> a -> Expr a) -> Gen a -> GenT Identity (a -> Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
a GenT Identity (a -> Expr a) -> Gen a -> GenT Identity (Expr a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
a]

genExpr :: Gen a -> Gen (Expr a)
genExpr :: forall a. Gen a -> Gen (Expr a)
genExpr Gen a
a = [(Int, GenT Identity (Expr a))] -> GenT Identity (Expr a)
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency [(Int
3, GenT Identity (Expr a)
forall a. Gen (Expr a)
genExprLit), (Int
2, Gen a -> GenT Identity (Expr a)
forall a. Gen a -> Gen (Expr a)
genExprOp Gen a
a)]

expression :: (Steppable (->) t Expr) => Size -> Gen t
expression :: forall t. Steppable (->) t Expr => Size -> Gen t
expression = Gen (Expr Void) -> (Gen t -> Gen (Expr t)) -> Size -> Gen t
forall t (f :: * -> *).
(Steppable (->) t f, Functor f) =>
Gen (f Void) -> (Gen t -> Gen (f t)) -> Size -> Gen t
embeddableOfHeight Gen (Expr Void)
forall a. Gen (Expr a)
genExprLit Gen t -> Gen (Expr t)
forall a. Gen a -> Gen (Expr a)
genExpr

genMuExpr :: Size -> Gen (Mu Expr)
genMuExpr :: Size -> Gen (Mu Expr)
genMuExpr = Size -> Gen (Mu Expr)
forall t. Steppable (->) t Expr => Size -> Gen t
expression

genNuExpr :: Size -> Gen (Nu Expr)
genNuExpr :: Size -> Gen (Nu Expr)
genNuExpr = Size -> Gen (Nu Expr)
forall t. Steppable (->) t Expr => Size -> Gen t
expression

genFixExpr :: Size -> Gen (Fix Expr)
genFixExpr :: Size -> Gen (Fix Expr)
genFixExpr = Size -> Gen (Fix Expr)
forall t. Steppable (->) t Expr => Size -> Gen t
expression

genCofixExpr :: Size -> Gen (Cofix Expr)
genCofixExpr :: Size -> Gen (Cofix Expr)
genCofixExpr = Size -> Gen (Cofix Expr)
forall t. Steppable (->) t Expr => Size -> Gen t
expression