{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{- HLINT ignore "Redundant bracket" -}

-- |
-- Copyright: © 2022–2023 Jonathan Knowles
-- License: Apache-2.0
--
module Internal.Semigroup.Tuple
    where

import Data.Functor
    ( (<&>) )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import GHC.Generics
    ( Generic )
import Test.QuickCheck
    ( Arbitrary (..)
    , Gen
    , applyArbitrary2
    , applyArbitrary3
    , applyArbitrary4
    , choose
    , genericShrink
    , oneof
    , shuffle
    , suchThatMap
    )
import Text.Show.Pretty
    ( ppShow )

import qualified Data.Foldable as F
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup.Foldable as F1

--------------------------------------------------------------------------------
-- Variables
--------------------------------------------------------------------------------

data Variable = A | B | C | D
    deriving (Variable
forall a. a -> a -> Bounded a
maxBound :: Variable
$cmaxBound :: Variable
minBound :: Variable
$cminBound :: Variable
Bounded, Int -> Variable
Variable -> Int
Variable -> [Variable]
Variable -> Variable
Variable -> Variable -> [Variable]
Variable -> Variable -> Variable -> [Variable]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Variable -> Variable -> Variable -> [Variable]
$cenumFromThenTo :: Variable -> Variable -> Variable -> [Variable]
enumFromTo :: Variable -> Variable -> [Variable]
$cenumFromTo :: Variable -> Variable -> [Variable]
enumFromThen :: Variable -> Variable -> [Variable]
$cenumFromThen :: Variable -> Variable -> [Variable]
enumFrom :: Variable -> [Variable]
$cenumFrom :: Variable -> [Variable]
fromEnum :: Variable -> Int
$cfromEnum :: Variable -> Int
toEnum :: Int -> Variable
$ctoEnum :: Int -> Variable
pred :: Variable -> Variable
$cpred :: Variable -> Variable
succ :: Variable -> Variable
$csucc :: Variable -> Variable
Enum, Variable -> Variable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq, Eq Variable
Variable -> Variable -> Bool
Variable -> Variable -> Ordering
Variable -> Variable -> Variable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Variable -> Variable -> Variable
$cmin :: Variable -> Variable -> Variable
max :: Variable -> Variable -> Variable
$cmax :: Variable -> Variable -> Variable
>= :: Variable -> Variable -> Bool
$c>= :: Variable -> Variable -> Bool
> :: Variable -> Variable -> Bool
$c> :: Variable -> Variable -> Bool
<= :: Variable -> Variable -> Bool
$c<= :: Variable -> Variable -> Bool
< :: Variable -> Variable -> Bool
$c< :: Variable -> Variable -> Bool
compare :: Variable -> Variable -> Ordering
$ccompare :: Variable -> Variable -> Ordering
Ord, Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show)

bindVariable :: BindingSet s -> Variable -> s
bindVariable :: forall s. BindingSet s -> Variable -> s
bindVariable BindingSet {s
bindingForA :: forall s. BindingSet s -> s
bindingForA :: s
bindingForA} Variable
A = s
bindingForA
bindVariable BindingSet {s
bindingForB :: forall s. BindingSet s -> s
bindingForB :: s
bindingForB} Variable
B = s
bindingForB
bindVariable BindingSet {s
bindingForC :: forall s. BindingSet s -> s
bindingForC :: s
bindingForC} Variable
C = s
bindingForC
bindVariable BindingSet {s
bindingForD :: forall s. BindingSet s -> s
bindingForD :: s
bindingForD} Variable
D = s
bindingForD

--------------------------------------------------------------------------------
-- Variable sums
--------------------------------------------------------------------------------

newtype VariableSum = VariableSum (NonEmpty Variable)
    deriving (VariableSum -> VariableSum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableSum -> VariableSum -> Bool
$c/= :: VariableSum -> VariableSum -> Bool
== :: VariableSum -> VariableSum -> Bool
$c== :: VariableSum -> VariableSum -> Bool
Eq, Eq VariableSum
VariableSum -> VariableSum -> Bool
VariableSum -> VariableSum -> Ordering
VariableSum -> VariableSum -> VariableSum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VariableSum -> VariableSum -> VariableSum
$cmin :: VariableSum -> VariableSum -> VariableSum
max :: VariableSum -> VariableSum -> VariableSum
$cmax :: VariableSum -> VariableSum -> VariableSum
>= :: VariableSum -> VariableSum -> Bool
$c>= :: VariableSum -> VariableSum -> Bool
> :: VariableSum -> VariableSum -> Bool
$c> :: VariableSum -> VariableSum -> Bool
<= :: VariableSum -> VariableSum -> Bool
$c<= :: VariableSum -> VariableSum -> Bool
< :: VariableSum -> VariableSum -> Bool
$c< :: VariableSum -> VariableSum -> Bool
compare :: VariableSum -> VariableSum -> Ordering
$ccompare :: VariableSum -> VariableSum -> Ordering
Ord, NonEmpty VariableSum -> VariableSum
VariableSum -> VariableSum -> VariableSum
forall b. Integral b => b -> VariableSum -> VariableSum
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> VariableSum -> VariableSum
$cstimes :: forall b. Integral b => b -> VariableSum -> VariableSum
sconcat :: NonEmpty VariableSum -> VariableSum
$csconcat :: NonEmpty VariableSum -> VariableSum
<> :: VariableSum -> VariableSum -> VariableSum
$c<> :: VariableSum -> VariableSum -> VariableSum
Semigroup)

instance Arbitrary VariableSum where
    arbitrary :: Gen VariableSum
arbitrary = Gen VariableSum
genVariableSum

instance Show VariableSum where
    show :: VariableSum -> String
show (VariableSum NonEmpty Variable
vs) = forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => m -> t m -> m
F1.intercalate1 String
" <> " forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Variable
vs

a :: VariableSum
a = NonEmpty Variable -> VariableSum
VariableSum (Variable
A forall a. a -> [a] -> NonEmpty a
:| [])
b :: VariableSum
b = NonEmpty Variable -> VariableSum
VariableSum (Variable
B forall a. a -> [a] -> NonEmpty a
:| [])
c :: VariableSum
c = NonEmpty Variable -> VariableSum
VariableSum (Variable
C forall a. a -> [a] -> NonEmpty a
:| [])
d :: VariableSum
d = NonEmpty Variable -> VariableSum
VariableSum (Variable
D forall a. a -> [a] -> NonEmpty a
:| [])

genVariableSum :: Gen VariableSum
genVariableSum :: Gen VariableSum
genVariableSum =
    NonEmpty Variable -> VariableSum
VariableSum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Variable]
genVariableList forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
  where
    genVariableList :: Gen [Variable]
    genVariableList :: Gen [Variable]
genVariableList = do
        Int
itemCount <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
4)
        forall a. Int -> [a] -> [a]
take Int
itemCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen [a]
shuffle forall a. (Bounded a, Enum a) => [a]
universe

bindVariableSum :: BindingSet s -> VariableSum -> NonEmpty s
bindVariableSum :: forall s. BindingSet s -> VariableSum -> NonEmpty s
bindVariableSum BindingSet s
tuple (VariableSum NonEmpty Variable
selectors) =
    forall s. BindingSet s -> Variable -> s
bindVariable BindingSet s
tuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Variable
selectors

evalVariableSum :: Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum :: forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum = (forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
F1.fold1 forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. BindingSet s -> VariableSum -> NonEmpty s
bindVariableSum

showVariableSum :: Show s => (BindingSet s) -> VariableSum -> String
showVariableSum :: forall s. Show s => BindingSet s -> VariableSum -> String
showVariableSum BindingSet s
tuple =
    forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
m -> (a -> m) -> t a -> m
F1.intercalateMap1 String
" <> " forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. BindingSet s -> VariableSum -> NonEmpty s
bindVariableSum BindingSet s
tuple

--------------------------------------------------------------------------------
-- Binding sets (for variables)
--------------------------------------------------------------------------------

data BindingSet s = BindingSet
    { forall s. BindingSet s -> s
bindingForA :: s
    , forall s. BindingSet s -> s
bindingForB :: s
    , forall s. BindingSet s -> s
bindingForC :: s
    , forall s. BindingSet s -> s
bindingForD :: s
    }
    deriving (BindingSet s -> BindingSet s -> Bool
forall s. Eq s => BindingSet s -> BindingSet s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingSet s -> BindingSet s -> Bool
$c/= :: forall s. Eq s => BindingSet s -> BindingSet s -> Bool
== :: BindingSet s -> BindingSet s -> Bool
$c== :: forall s. Eq s => BindingSet s -> BindingSet s -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (BindingSet s) x -> BindingSet s
forall s x. BindingSet s -> Rep (BindingSet s) x
$cto :: forall s x. Rep (BindingSet s) x -> BindingSet s
$cfrom :: forall s x. BindingSet s -> Rep (BindingSet s) x
Generic, BindingSet s -> BindingSet s -> Bool
BindingSet s -> BindingSet s -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (BindingSet s)
forall s. Ord s => BindingSet s -> BindingSet s -> Bool
forall s. Ord s => BindingSet s -> BindingSet s -> Ordering
forall s. Ord s => BindingSet s -> BindingSet s -> BindingSet s
min :: BindingSet s -> BindingSet s -> BindingSet s
$cmin :: forall s. Ord s => BindingSet s -> BindingSet s -> BindingSet s
max :: BindingSet s -> BindingSet s -> BindingSet s
$cmax :: forall s. Ord s => BindingSet s -> BindingSet s -> BindingSet s
>= :: BindingSet s -> BindingSet s -> Bool
$c>= :: forall s. Ord s => BindingSet s -> BindingSet s -> Bool
> :: BindingSet s -> BindingSet s -> Bool
$c> :: forall s. Ord s => BindingSet s -> BindingSet s -> Bool
<= :: BindingSet s -> BindingSet s -> Bool
$c<= :: forall s. Ord s => BindingSet s -> BindingSet s -> Bool
< :: BindingSet s -> BindingSet s -> Bool
$c< :: forall s. Ord s => BindingSet s -> BindingSet s -> Bool
compare :: BindingSet s -> BindingSet s -> Ordering
$ccompare :: forall s. Ord s => BindingSet s -> BindingSet s -> Ordering
Ord)

instance Show s => Show (BindingSet s) where
    show :: BindingSet s -> String
show (BindingSet s
va s
vb s
vc s
vd) = forall a. Monoid a => [a] -> a
mconcat
        [ String
"BindingSet {"
        , String
"a = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
va forall a. Semigroup a => a -> a -> a
<> String
", "
        , String
"b = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
vb forall a. Semigroup a => a -> a -> a
<> String
", "
        , String
"c = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
vc forall a. Semigroup a => a -> a -> a
<> String
", "
        , String
"d = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show s
vd
        , String
"}"
        ]

instance Arbitrary s => Arbitrary (BindingSet s) where
    arbitrary :: Gen (BindingSet s)
arbitrary = forall s. Arbitrary s => Gen (BindingSet s)
genBindingSet
    shrink :: BindingSet s -> [BindingSet s]
shrink = forall s. Arbitrary s => BindingSet s -> [BindingSet s]
shrinkBindingSet

genBindingSet :: Arbitrary s => Gen (BindingSet s)
genBindingSet :: forall s. Arbitrary s => Gen (BindingSet s)
genBindingSet = forall a b c d r.
(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =>
(a -> b -> c -> d -> r) -> Gen r
applyArbitrary4 forall s. s -> s -> s -> s -> BindingSet s
BindingSet

shrinkBindingSet :: Arbitrary s => BindingSet s -> [BindingSet s]
shrinkBindingSet :: forall s. Arbitrary s => BindingSet s -> [BindingSet s]
shrinkBindingSet = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

--------------------------------------------------------------------------------
-- Tuples
--------------------------------------------------------------------------------

data Tuple1 s = Tuple1 VariableSum (BindingSet s)
    deriving (Tuple1 s -> Tuple1 s -> Bool
forall s. Eq s => Tuple1 s -> Tuple1 s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuple1 s -> Tuple1 s -> Bool
$c/= :: forall s. Eq s => Tuple1 s -> Tuple1 s -> Bool
== :: Tuple1 s -> Tuple1 s -> Bool
$c== :: forall s. Eq s => Tuple1 s -> Tuple1 s -> Bool
Eq, Tuple1 s -> Tuple1 s -> Bool
Tuple1 s -> Tuple1 s -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (Tuple1 s)
forall s. Ord s => Tuple1 s -> Tuple1 s -> Bool
forall s. Ord s => Tuple1 s -> Tuple1 s -> Ordering
forall s. Ord s => Tuple1 s -> Tuple1 s -> Tuple1 s
min :: Tuple1 s -> Tuple1 s -> Tuple1 s
$cmin :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Tuple1 s
max :: Tuple1 s -> Tuple1 s -> Tuple1 s
$cmax :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Tuple1 s
>= :: Tuple1 s -> Tuple1 s -> Bool
$c>= :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Bool
> :: Tuple1 s -> Tuple1 s -> Bool
$c> :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Bool
<= :: Tuple1 s -> Tuple1 s -> Bool
$c<= :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Bool
< :: Tuple1 s -> Tuple1 s -> Bool
$c< :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Bool
compare :: Tuple1 s -> Tuple1 s -> Ordering
$ccompare :: forall s. Ord s => Tuple1 s -> Tuple1 s -> Ordering
Ord)

data Tuple2 s = Tuple2 VariableSum VariableSum (BindingSet s)
    deriving (Tuple2 s -> Tuple2 s -> Bool
forall s. Eq s => Tuple2 s -> Tuple2 s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuple2 s -> Tuple2 s -> Bool
$c/= :: forall s. Eq s => Tuple2 s -> Tuple2 s -> Bool
== :: Tuple2 s -> Tuple2 s -> Bool
$c== :: forall s. Eq s => Tuple2 s -> Tuple2 s -> Bool
Eq, Tuple2 s -> Tuple2 s -> Bool
Tuple2 s -> Tuple2 s -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (Tuple2 s)
forall s. Ord s => Tuple2 s -> Tuple2 s -> Bool
forall s. Ord s => Tuple2 s -> Tuple2 s -> Ordering
forall s. Ord s => Tuple2 s -> Tuple2 s -> Tuple2 s
min :: Tuple2 s -> Tuple2 s -> Tuple2 s
$cmin :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Tuple2 s
max :: Tuple2 s -> Tuple2 s -> Tuple2 s
$cmax :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Tuple2 s
>= :: Tuple2 s -> Tuple2 s -> Bool
$c>= :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Bool
> :: Tuple2 s -> Tuple2 s -> Bool
$c> :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Bool
<= :: Tuple2 s -> Tuple2 s -> Bool
$c<= :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Bool
< :: Tuple2 s -> Tuple2 s -> Bool
$c< :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Bool
compare :: Tuple2 s -> Tuple2 s -> Ordering
$ccompare :: forall s. Ord s => Tuple2 s -> Tuple2 s -> Ordering
Ord)

data Tuple3 s = Tuple3 VariableSum VariableSum VariableSum (BindingSet s)
    deriving (Tuple3 s -> Tuple3 s -> Bool
forall s. Eq s => Tuple3 s -> Tuple3 s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuple3 s -> Tuple3 s -> Bool
$c/= :: forall s. Eq s => Tuple3 s -> Tuple3 s -> Bool
== :: Tuple3 s -> Tuple3 s -> Bool
$c== :: forall s. Eq s => Tuple3 s -> Tuple3 s -> Bool
Eq, Tuple3 s -> Tuple3 s -> Bool
Tuple3 s -> Tuple3 s -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (Tuple3 s)
forall s. Ord s => Tuple3 s -> Tuple3 s -> Bool
forall s. Ord s => Tuple3 s -> Tuple3 s -> Ordering
forall s. Ord s => Tuple3 s -> Tuple3 s -> Tuple3 s
min :: Tuple3 s -> Tuple3 s -> Tuple3 s
$cmin :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Tuple3 s
max :: Tuple3 s -> Tuple3 s -> Tuple3 s
$cmax :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Tuple3 s
>= :: Tuple3 s -> Tuple3 s -> Bool
$c>= :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Bool
> :: Tuple3 s -> Tuple3 s -> Bool
$c> :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Bool
<= :: Tuple3 s -> Tuple3 s -> Bool
$c<= :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Bool
< :: Tuple3 s -> Tuple3 s -> Bool
$c< :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Bool
compare :: Tuple3 s -> Tuple3 s -> Ordering
$ccompare :: forall s. Ord s => Tuple3 s -> Tuple3 s -> Ordering
Ord)

instance Arbitrary a => Arbitrary (Tuple1 a) where
    arbitrary :: Gen (Tuple1 a)
arbitrary = forall a. Arbitrary a => Gen (Tuple1 a)
genTuple1
    shrink :: Tuple1 a -> [Tuple1 a]
shrink = forall a. Arbitrary a => Tuple1 a -> [Tuple1 a]
shrinkTuple1

instance Arbitrary a => Arbitrary (Tuple2 a) where
    arbitrary :: Gen (Tuple2 a)
arbitrary = forall a. Arbitrary a => Gen (Tuple2 a)
genTuple2
    shrink :: Tuple2 a -> [Tuple2 a]
shrink = forall a. Arbitrary a => Tuple2 a -> [Tuple2 a]
shrinkTuple2

instance Arbitrary a => Arbitrary (Tuple3 a) where
    arbitrary :: Gen (Tuple3 a)
arbitrary = forall a. Arbitrary a => Gen (Tuple3 a)
genTuple3
    shrink :: Tuple3 a -> [Tuple3 a]
shrink = forall a. Arbitrary a => Tuple3 a -> [Tuple3 a]
shrinkTuple3

instance (Show s, Semigroup s) => Show (Tuple1 s) where
    show :: Tuple1 s -> String
show = forall a. (Semigroup a, Show a) => Tuple1 a -> String
showTuple1

instance (Show s, Semigroup s) => Show (Tuple2 s) where
    show :: Tuple2 s -> String
show = forall a. (Semigroup a, Show a) => Tuple2 a -> String
showTuple2

instance (Show s, Semigroup s) => Show (Tuple3 s) where
    show :: Tuple3 s -> String
show = forall a. (Semigroup a, Show a) => Tuple3 a -> String
showTuple3

genTuple1 :: Arbitrary a => Gen (Tuple1 a)
genTuple1 :: forall a. Arbitrary a => Gen (Tuple1 a)
genTuple1 = forall a b r. (Arbitrary a, Arbitrary b) => (a -> b -> r) -> Gen r
applyArbitrary2 forall s. VariableSum -> BindingSet s -> Tuple1 s
Tuple1

genTuple2 :: forall a. Arbitrary a => Gen (Tuple2 a)
genTuple2 :: forall a. Arbitrary a => Gen (Tuple2 a)
genTuple2 = forall a. [Gen a] -> Gen a
oneof [Gen (Tuple2 a)
genRandom, Gen (Tuple2 a)
genHandChosen]
  where
    genRandom :: Gen (Tuple2 a)
    genRandom :: Gen (Tuple2 a)
genRandom = forall a b c r.
(Arbitrary a, Arbitrary b, Arbitrary c) =>
(a -> b -> c -> r) -> Gen r
applyArbitrary3 forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2

    genHandChosen :: Gen (Tuple2 a)
    genHandChosen :: Gen (Tuple2 a)
genHandChosen = forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>)
        [ -- All identical:
          forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 VariableSum
a VariableSum
a
        , -- All different:
          forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 VariableSum
a VariableSum
b
          -- Shared common prefix:
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
c)
          -- Shared common suffix:
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c)
          -- Shared common overlap (left to right):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c)
          -- Shared common overlap (right to left):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
c forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
a)
          -- Append to the RHS (from left to right):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b)
          -- Append to the RHS (from right to left):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
a)
          -- Append to the LHS (from left to right):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
b) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b)
          -- Append to the LHS (from right to left):
        , forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
b)
        ]

genTuple3 :: forall a. Arbitrary a => Gen (Tuple3 a)
genTuple3 :: forall a. Arbitrary a => Gen (Tuple3 a)
genTuple3 = forall a. [Gen a] -> Gen a
oneof [Gen (Tuple3 a)
genRandom, Gen (Tuple3 a)
genHandChosen]
  where
    genRandom :: Gen (Tuple3 a)
    genRandom :: Gen (Tuple3 a)
genRandom = forall a b c d r.
(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =>
(a -> b -> c -> d -> r) -> Gen r
applyArbitrary4 forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3

    genHandChosen :: Gen (Tuple3 a)
    genHandChosen :: Gen (Tuple3 a)
genHandChosen = forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>)
        [ -- All identical:
          forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 VariableSum
a VariableSum
a VariableSum
a
          -- All different:
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 VariableSum
a VariableSum
b VariableSum
c
          -- Shared common prefix:
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
d)
          -- Shared common suffix:
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
d) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
d) (VariableSum
c forall a. Semigroup a => a -> a -> a
<> VariableSum
d)
          -- Append to the RHS (from left to right):
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
a) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c)
          -- Append to the RHS (from right to left):
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b) (VariableSum
a)
          -- Append to the LHS (from left to right):
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
c) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c)
          -- Append to the LHS (from right to left):
        , forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 (VariableSum
a forall a. Semigroup a => a -> a -> a
<> VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
b forall a. Semigroup a => a -> a -> a
<> VariableSum
c) (VariableSum
c)
        ]

evalTuple1 :: Semigroup s => Tuple1 s -> s
evalTuple1 :: forall s. Semigroup s => Tuple1 s -> s
evalTuple1 (Tuple1 VariableSum
c1 BindingSet s
t) =
    ( forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c1
    )

evalTuple2 :: Semigroup s => Tuple2 s -> (s, s)
evalTuple2 :: forall s. Semigroup s => Tuple2 s -> (s, s)
evalTuple2 (Tuple2 VariableSum
c1 VariableSum
c2 BindingSet s
t) =
    ( forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c1
    , forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c2
    )

evalTuple3 :: Semigroup s => Tuple3 s -> (s, s, s)
evalTuple3 :: forall s. Semigroup s => Tuple3 s -> (s, s, s)
evalTuple3 (Tuple3 VariableSum
c1 VariableSum
c2 VariableSum
c3 BindingSet s
t) =
    ( forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c1
    , forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c2
    , forall s. Semigroup s => BindingSet s -> VariableSum -> s
evalVariableSum BindingSet s
t VariableSum
c3
    )

showTuple1 :: (Semigroup a, Show a) => Tuple1 a -> String
showTuple1 :: forall a. (Semigroup a, Show a) => Tuple1 a -> String
showTuple1 (forall s. Semigroup s => Tuple1 s -> s
evalTuple1 -> a
va) = [String] -> String
unlines
    [ forall a. Monoid a => a
mempty, String
"a:", forall a. Show a => a -> String
showWrap a
va
    ]

showTuple2 :: (Semigroup a, Show a) => Tuple2 a -> String
showTuple2 :: forall a. (Semigroup a, Show a) => Tuple2 a -> String
showTuple2 (forall s. Semigroup s => Tuple2 s -> (s, s)
evalTuple2 -> (a
va, a
vb)) = [String] -> String
unlines
    [ forall a. Monoid a => a
mempty, String
"a:", forall a. Show a => a -> String
showWrap a
va
    , forall a. Monoid a => a
mempty, String
"b:", forall a. Show a => a -> String
showWrap a
vb
    ]

showTuple3 :: (Semigroup a, Show a) => Tuple3 a -> String
showTuple3 :: forall a. (Semigroup a, Show a) => Tuple3 a -> String
showTuple3 (forall s. Semigroup s => Tuple3 s -> (s, s, s)
evalTuple3 -> (a
va, a
vb, a
vc)) = [String] -> String
unlines
    [ forall a. Monoid a => a
mempty, String
"a:", forall a. Show a => a -> String
showWrap a
va
    , forall a. Monoid a => a
mempty, String
"b:", forall a. Show a => a -> String
showWrap a
vb
    , forall a. Monoid a => a
mempty, String
"c:", forall a. Show a => a -> String
showWrap a
vc
    ]

shrinkTuple1 :: Arbitrary a => Tuple1 a -> [Tuple1 a]
shrinkTuple1 :: forall a. Arbitrary a => Tuple1 a -> [Tuple1 a]
shrinkTuple1 (Tuple1 VariableSum
c1 BindingSet a
t) = forall s. VariableSum -> BindingSet s -> Tuple1 s
Tuple1 VariableSum
c1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink BindingSet a
t

shrinkTuple2 :: Arbitrary a => Tuple2 a -> [Tuple2 a]
shrinkTuple2 :: forall a. Arbitrary a => Tuple2 a -> [Tuple2 a]
shrinkTuple2 (Tuple2 VariableSum
c1 VariableSum
c2 BindingSet a
t) = forall s. VariableSum -> VariableSum -> BindingSet s -> Tuple2 s
Tuple2 VariableSum
c1 VariableSum
c2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink BindingSet a
t

shrinkTuple3 :: Arbitrary a => Tuple3 a -> [Tuple3 a]
shrinkTuple3 :: forall a. Arbitrary a => Tuple3 a -> [Tuple3 a]
shrinkTuple3 (Tuple3 VariableSum
c1 VariableSum
c2 VariableSum
c3 BindingSet a
t) = forall s.
VariableSum
-> VariableSum -> VariableSum -> BindingSet s -> Tuple3 s
Tuple3 VariableSum
c1 VariableSum
c2 VariableSum
c3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink BindingSet a
t

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

showWrap :: Show a => a -> String
showWrap :: forall a. Show a => a -> String
showWrap a
x
    | Bool
singleLineMaxLengthExceeded =
        String
multiLine
    | Bool
otherwise =
        String
singleLine
  where
    multiLine :: String
multiLine = forall a. Show a => a -> String
ppShow a
x
    singleLine :: String
singleLine = forall a. Show a => a -> String
show a
x
    singleLineMaxLength :: Int
singleLineMaxLength = Int
80
    singleLineMaxLengthExceeded :: Bool
singleLineMaxLengthExceeded = forall (t :: * -> *) a. Foldable t => t a -> Int
F.length String
singleLine forall a. Ord a => a -> a -> Bool
> Int
singleLineMaxLength

universe :: (Bounded a, Enum a) => [a]
universe :: forall a. (Bounded a, Enum a) => [a]
universe = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]