{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK hide #-}

-- | This module is exported, but it is not part of the stable
-- public API and is not subject to PVP. It is used by other
-- modules in @quickcheck-classes-base@ and by modules in the
-- @quickcheck-classes@ library as well. Functions and types
-- in this module are either auxiliary functions that are reused
-- by many different laws tests, or they are compatibility shims
-- that make it possible to build with older versions GHC and
-- transformers.
module Test.QuickCheck.Classes.Internal
  ( -- * Common Types and Functions
    Laws(..)
  , foldMapA
  , myForAllShrink
  -- Modifiers
  , SmallList(..)
  , VerySmallList(..)
  , ShowReadPrecedence(..)

  -- only used for higher-kinded types
  , Apply(..)
#if HAVE_BINARY_LAWS
  , Apply2(..)
#endif
  , Triple(..)
  , ChooseFirst(..)
  , ChooseSecond(..)
  , LastNothing(..)
  , Bottom(..)
  , LinearEquation(..)
#if HAVE_UNARY_LAWS
  , LinearEquationM(..)
#endif
  , QuadraticEquation(..)
  , LinearEquationTwo(..)
#if HAVE_UNARY_LAWS
  , nestedEq1
  , propNestedEq1
  , toSpecialApplicative
#endif
  , flipPair
#if HAVE_UNARY_LAWS
  , apTrans
#endif
  , func1
  , func2
  , func3
#if HAVE_UNARY_LAWS
  , func4
#endif
  , func5
  , func6
  , reverseTriple
  , runLinearEquation
#if HAVE_UNARY_LAWS
  , runLinearEquationM
#endif
  , runQuadraticEquation
  , runLinearEquationTwo
    -- * Compatibility Shims
  , isTrue#
#if HAVE_UNARY_LAWS
  , eq1
#endif
#if HAVE_BINARY_LAWS
  , eq2
  , eq1_2
#endif
  , readMaybe
  ) where

import Control.Applicative
import Control.Monad
import Data.Foldable
import Data.Traversable
import Data.Monoid
#if defined(HAVE_UNARY_LAWS)
import Data.Functor.Classes (Eq1(..),Show1(..),showsPrec1)
import Data.Functor.Compose
#endif
#if defined(HAVE_BINARY_LAWS)
import Data.Functor.Classes (Eq2(..),Show2(..),showsPrec2)
#endif
import Data.Semigroup (Semigroup)
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property(..))

import qualified Control.Monad.Trans.Writer.Lazy as WL
import qualified Data.List as L
import qualified Data.Monoid as MND
import qualified Data.Semigroup as SG
import qualified Data.Set as S

#if MIN_VERSION_base(4,6,0)
import Text.Read (readMaybe)
#else
import Text.ParserCombinators.ReadP (skipSpaces)
import Text.ParserCombinators.ReadPrec (lift, minPrec, readPrec_to_S)
import Text.Read (readPrec)
#endif

#if MIN_VERSION_base(4,7,0)
import GHC.Exts (isTrue#)
#endif

#if defined(HAVE_UNARY_LAWS) || defined(HAVE_BINARY_LAWS)
import qualified Data.Functor.Classes as C
#endif

-- | A set of laws associated with a typeclass.
--
--   /Note/: Most of the top-level functions provided
--   by this library have the shape
--   `forall a. (Ctx a) => Proxy a -> Laws`. You can just
--   as easily provide your own `Laws` in libraries/test suites
--   using regular QuickCheck machinery.
data Laws = Laws
  { Laws -> String
lawsTypeclass :: String
    -- ^ Name of the typeclass whose laws are tested
  , Laws -> [(String, Property)]
lawsProperties :: [(String,Property)]
    -- ^ Pairs of law name and property
  }

myForAllShrink :: (Arbitrary a, Show b, Eq b)
  => Bool -- Should we show the RHS. It's better not to show it
          -- if the RHS is equal to the input.
  -> (a -> Bool) -- is the value a valid input
  -> (a -> [String]) -- show the 'a' values
  -> String -- show the LHS
  -> (a -> b) -- the function that makes the LHS
  -> String -- show the RHS
  -> (a -> b) -- the function that makes the RHS
  -> Property
myForAllShrink :: Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
displayRhs a -> Bool
isValid a -> [String]
showInputs String
name1 a -> b
calc1 String
name2 a -> b
calc2 =
#if MIN_VERSION_QuickCheck(2,9,0)
  Property -> Property
forall prop. Testable prop => prop -> Property
again (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
#endif
  Gen Prop -> Property
MkProperty (Gen Prop -> Property) -> Gen Prop -> Property
forall a b. (a -> b) -> a -> b
$
  Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen a -> (a -> Gen Prop) -> Gen Prop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x ->
    Property -> Gen Prop
unProperty (Property -> Gen Prop) -> Property -> Gen Prop
forall a b. (a -> b) -> a -> b
$
    (a -> [a]) -> a -> (a -> Property) -> Property
forall prop a.
Testable prop =>
(a -> [a]) -> a -> (a -> prop) -> Property
shrinking a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
x' ->
      let b1 :: b
b1 = a -> b
calc1 a
x'
          b2 :: b
b2 = a -> b
calc2 a
x'
          sb1 :: String
sb1 = b -> String
forall a. Show a => a -> String
show b
b1
          sb2 :: String
sb2 = b -> String
forall a. Show a => a -> String
show b
b2
          description :: String
description = String
"  Description: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name2
          err :: String
err = String
description String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (a -> [String]
showInputs a
x')) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
displayRhs then String
"\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb2 else String
"")
       in a -> Bool
isValid a
x' Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
err (b
b1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b2)

#if HAVE_UNARY_LAWS
-- the Functor constraint is needed for transformers-0.4
#if HAVE_QUANTIFIED_CONSTRAINTS
nestedEq1 :: (forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) => f (g a) -> f (g a) -> Bool
nestedEq1 :: f (g a) -> f (g a) -> Bool
nestedEq1 = f (g a) -> f (g a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
nestedEq1 :: (Eq1 f, Eq1 g, Eq a, Functor f) => f (g a) -> f (g a) -> Bool
nestedEq1 x y = C.eq1 (Compose x) (Compose y)
#endif

#if HAVE_QUANTIFIED_CONSTRAINTS
propNestedEq1 :: (forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a, forall x. Show x => Show (f x), forall x. Show x => Show (g x), Show a)
  => f (g a) -> f (g a) -> Property
propNestedEq1 :: f (g a) -> f (g a) -> Property
propNestedEq1 = f (g a) -> f (g a) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
(===)
#else
propNestedEq1 :: (Eq1 f, Eq1 g, Eq a, Show1 f, Show1 g, Show a, Functor f)
  => f (g a) -> f (g a) -> Property
propNestedEq1 x y = Compose x === Compose y
#endif

toSpecialApplicative ::
     Compose Triple ((,) (S.Set Integer)) Integer
  -> Compose Triple (WL.Writer (S.Set Integer)) Integer
toSpecialApplicative :: Compose Triple ((,) (Set Integer)) Integer
-> Compose Triple (Writer (Set Integer)) Integer
toSpecialApplicative (Compose (Triple (Set Integer, Integer)
a (Set Integer, Integer)
b (Set Integer, Integer)
c)) =
  Triple (WriterT (Set Integer) Identity Integer)
-> Compose Triple (Writer (Set Integer)) Integer
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> Triple (WriterT (Set Integer) Identity Integer)
forall a. a -> a -> a -> Triple a
Triple ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
flipPair (Set Integer, Integer)
a)) ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
flipPair (Set Integer, Integer)
b)) ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer ((Set Integer, Integer) -> (Integer, Set Integer)
forall a b. (a, b) -> (b, a)
flipPair (Set Integer, Integer)
c)))
#endif

flipPair :: (a,b) -> (b,a)
flipPair :: (a, b) -> (b, a)
flipPair (a
x,b
y) = (b
y,a
x)

#if HAVE_UNARY_LAWS
-- Reverse the list and accumulate the writers. We cannot
-- use Sum or Product or else it wont actually be a valid
-- applicative transformation.
apTrans ::
     Compose Triple (WL.Writer (S.Set Integer)) a
  -> Compose (WL.Writer (S.Set Integer)) Triple a
apTrans :: Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans (Compose Triple (Writer (Set Integer) a)
xs) = WriterT (Set Integer) Identity (Triple a)
-> Compose (Writer (Set Integer)) Triple a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Triple (Writer (Set Integer) a)
-> WriterT (Set Integer) Identity (Triple a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Triple (Writer (Set Integer) a) -> Triple (Writer (Set Integer) a)
forall a. Triple a -> Triple a
reverseTriple Triple (Writer (Set Integer) a)
xs))
#endif

func1 :: Integer -> (Integer,Integer)
func1 :: Integer -> (Integer, Integer)
func1 Integer
i = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
5) Integer
3, Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)

func2 :: (Integer,Integer) -> (Bool,Either Ordering Integer)
func2 :: (Integer, Integer) -> (Bool, Either Ordering Integer)
func2 (Integer
a,Integer
b) = (Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
a, if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
a then Ordering -> Either Ordering Integer
forall a b. a -> Either a b
Left (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
a Integer
b) else Integer -> Either Ordering Integer
forall a b. b -> Either a b
Right (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2))

func3 :: Integer -> SG.Sum Integer
func3 :: Integer -> Sum Integer
func3 Integer
i = Integer -> Sum Integer
forall a. a -> Sum a
SG.Sum (Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
4)

#if HAVE_UNARY_LAWS
func4 :: Integer -> Compose Triple (WL.Writer (S.Set Integer)) Integer
func4 :: Integer -> Compose Triple (Writer (Set Integer)) Integer
func4 Integer
i = Triple (WriterT (Set Integer) Identity Integer)
-> Compose Triple (Writer (Set Integer)) Integer
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Triple (WriterT (Set Integer) Identity Integer)
 -> Compose Triple (Writer (Set Integer)) Integer)
-> Triple (WriterT (Set Integer) Identity Integer)
-> Compose Triple (Writer (Set Integer)) Integer
forall a b. (a -> b) -> a -> b
$ WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> WriterT (Set Integer) Identity Integer
-> Triple (WriterT (Set Integer) Identity Integer)
forall a. a -> a -> a -> Triple a
Triple
  ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i, Integer -> Set Integer
forall a. a -> Set a
S.singleton (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
5)))
  ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2, Integer -> Set Integer
forall a. a -> Set a
S.singleton (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3)))
  ((Integer, Set Integer) -> WriterT (Set Integer) Identity Integer
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
WL.writer (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7, Integer -> Set Integer
forall a. a -> Set a
S.singleton Integer
4))
#endif

func5 :: Integer -> Triple Integer
func5 :: Integer -> Triple Integer
func5 Integer
i = Integer -> Integer -> Integer -> Triple Integer
forall a. a -> a -> a -> Triple a
Triple (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2) (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
3) (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)

func6 :: Integer -> Triple Integer
func6 :: Integer -> Triple Integer
func6 Integer
i = Integer -> Integer -> Integer -> Triple Integer
forall a. a -> a -> a -> Triple a
Triple (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i) (Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
7) (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)

data Triple a = Triple a a a
  deriving (Int -> Triple a -> String -> String
[Triple a] -> String -> String
Triple a -> String
(Int -> Triple a -> String -> String)
-> (Triple a -> String)
-> ([Triple a] -> String -> String)
-> Show (Triple a)
forall a. Show a => Int -> Triple a -> String -> String
forall a. Show a => [Triple a] -> String -> String
forall a. Show a => Triple a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Triple a] -> String -> String
$cshowList :: forall a. Show a => [Triple a] -> String -> String
show :: Triple a -> String
$cshow :: forall a. Show a => Triple a -> String
showsPrec :: Int -> Triple a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Triple a -> String -> String
Show,Triple a -> Triple a -> Bool
(Triple a -> Triple a -> Bool)
-> (Triple a -> Triple a -> Bool) -> Eq (Triple a)
forall a. Eq a => Triple a -> Triple a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Triple a -> Triple a -> Bool
$c/= :: forall a. Eq a => Triple a -> Triple a -> Bool
== :: Triple a -> Triple a -> Bool
$c== :: forall a. Eq a => Triple a -> Triple a -> Bool
Eq)

tripleLiftEq :: (a -> b -> Bool) -> Triple a -> Triple b -> Bool
tripleLiftEq :: (a -> b -> Bool) -> Triple a -> Triple b -> Bool
tripleLiftEq a -> b -> Bool
p (Triple a
a1 a
b1 a
c1) (Triple b
a2 b
b2 b
c2) =
  a -> b -> Bool
p a
a1 b
a2 Bool -> Bool -> Bool
&& a -> b -> Bool
p a
b1 b
b2 Bool -> Bool -> Bool
&& a -> b -> Bool
p a
c1 b
c2

#if HAVE_UNARY_LAWS
instance Eq1 Triple where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftEq :: (a -> b -> Bool) -> Triple a -> Triple b -> Bool
liftEq = (a -> b -> Bool) -> Triple a -> Triple b -> Bool
forall a b. (a -> b -> Bool) -> Triple a -> Triple b -> Bool
tripleLiftEq
#else
  eq1 = tripleLiftEq (==)
#endif
#endif

tripleLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Triple a -> ShowS
tripleLiftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Triple a -> String -> String
tripleLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
_ Int
p (Triple a
a a
b a
c) = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
  ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"Triple "
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
elemShowsPrec Int
11 a
a
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" "
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
elemShowsPrec Int
11 a
b
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" "
  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
elemShowsPrec Int
11 a
c

#if HAVE_UNARY_LAWS
instance Show1 Triple where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Triple a -> String -> String
liftShowsPrec = (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Triple a -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Triple a -> String -> String
tripleLiftShowsPrec
#else
  showsPrec1 = tripleLiftShowsPrec showsPrec showList
#endif
#endif

#if HAVE_UNARY_LAWS
instance Arbitrary1 Triple where
  liftArbitrary :: Gen a -> Gen (Triple a)
liftArbitrary Gen a
x = a -> a -> a -> Triple a
forall a. a -> a -> a -> Triple a
Triple (a -> a -> a -> Triple a) -> Gen a -> Gen (a -> a -> Triple a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
x Gen (a -> a -> Triple a) -> Gen a -> Gen (a -> Triple a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
x Gen (a -> Triple a) -> Gen a -> Gen (Triple a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
x

instance Arbitrary a => Arbitrary (Triple a) where
  arbitrary :: Gen (Triple a)
arbitrary = Gen a -> Gen (Triple a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
forall a. Arbitrary a => Gen a
arbitrary
#else
instance Arbitrary a => Arbitrary (Triple a) where
  arbitrary = Triple <$> arbitrary <*> arbitrary <*> arbitrary
#endif

instance Functor Triple where
  fmap :: (a -> b) -> Triple a -> Triple b
fmap a -> b
f (Triple a
a a
b a
c) = b -> b -> b -> Triple b
forall a. a -> a -> a -> Triple a
Triple (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

instance Applicative Triple where
  pure :: a -> Triple a
pure a
a = a -> a -> a -> Triple a
forall a. a -> a -> a -> Triple a
Triple a
a a
a a
a
  Triple a -> b
f a -> b
g a -> b
h <*> :: Triple (a -> b) -> Triple a -> Triple b
<*> Triple a
a a
b a
c = b -> b -> b -> Triple b
forall a. a -> a -> a -> Triple a
Triple (a -> b
f a
a) (a -> b
g a
b) (a -> b
h a
c)

instance Foldable Triple where
  foldMap :: (a -> m) -> Triple a -> m
foldMap a -> m
f (Triple a
a a
b a
c) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
MND.<> a -> m
f a
b m -> m -> m
forall a. Semigroup a => a -> a -> a
MND.<> a -> m
f a
c

instance Traversable Triple where
  traverse :: (a -> f b) -> Triple a -> f (Triple b)
traverse a -> f b
f (Triple a
a a
b a
c) = b -> b -> b -> Triple b
forall a. a -> a -> a -> Triple a
Triple (b -> b -> b -> Triple b) -> f b -> f (b -> b -> Triple b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> b -> Triple b) -> f b -> f (b -> Triple b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b f (b -> Triple b) -> f b -> f (Triple b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
c

reverseTriple :: Triple a -> Triple a
reverseTriple :: Triple a -> Triple a
reverseTriple (Triple a
a a
b a
c) = a -> a -> a -> Triple a
forall a. a -> a -> a -> Triple a
Triple a
c a
b a
a

data ChooseSecond = ChooseSecond
  deriving (ChooseSecond -> ChooseSecond -> Bool
(ChooseSecond -> ChooseSecond -> Bool)
-> (ChooseSecond -> ChooseSecond -> Bool) -> Eq ChooseSecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChooseSecond -> ChooseSecond -> Bool
$c/= :: ChooseSecond -> ChooseSecond -> Bool
== :: ChooseSecond -> ChooseSecond -> Bool
$c== :: ChooseSecond -> ChooseSecond -> Bool
Eq)

data ChooseFirst = ChooseFirst
  deriving (ChooseFirst -> ChooseFirst -> Bool
(ChooseFirst -> ChooseFirst -> Bool)
-> (ChooseFirst -> ChooseFirst -> Bool) -> Eq ChooseFirst
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChooseFirst -> ChooseFirst -> Bool
$c/= :: ChooseFirst -> ChooseFirst -> Bool
== :: ChooseFirst -> ChooseFirst -> Bool
$c== :: ChooseFirst -> ChooseFirst -> Bool
Eq)

data LastNothing = LastNothing
  deriving (LastNothing -> LastNothing -> Bool
(LastNothing -> LastNothing -> Bool)
-> (LastNothing -> LastNothing -> Bool) -> Eq LastNothing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LastNothing -> LastNothing -> Bool
$c/= :: LastNothing -> LastNothing -> Bool
== :: LastNothing -> LastNothing -> Bool
$c== :: LastNothing -> LastNothing -> Bool
Eq)

data Bottom a = BottomUndefined | BottomValue a
  deriving (Bottom a -> Bottom a -> Bool
(Bottom a -> Bottom a -> Bool)
-> (Bottom a -> Bottom a -> Bool) -> Eq (Bottom a)
forall a. Eq a => Bottom a -> Bottom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bottom a -> Bottom a -> Bool
$c/= :: forall a. Eq a => Bottom a -> Bottom a -> Bool
== :: Bottom a -> Bottom a -> Bool
$c== :: forall a. Eq a => Bottom a -> Bottom a -> Bool
Eq)

instance Show ChooseFirst where
  show :: ChooseFirst -> String
show ChooseFirst
ChooseFirst = String
"\\a b -> if even a then a else b"

instance Show ChooseSecond where
  show :: ChooseSecond -> String
show ChooseSecond
ChooseSecond = String
"\\a b -> if even b then a else b"

instance Show LastNothing where
  show :: LastNothing -> String
show LastNothing
LastNothing = String
"0"

instance Show a => Show (Bottom a) where
  show :: Bottom a -> String
show Bottom a
x = case Bottom a
x of
    Bottom a
BottomUndefined -> String
"undefined"
    BottomValue a
a -> a -> String
forall a. Show a => a -> String
show a
a

instance Arbitrary ChooseSecond where
  arbitrary :: Gen ChooseSecond
arbitrary = ChooseSecond -> Gen ChooseSecond
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChooseSecond
ChooseSecond

instance Arbitrary ChooseFirst where
  arbitrary :: Gen ChooseFirst
arbitrary = ChooseFirst -> Gen ChooseFirst
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChooseFirst
ChooseFirst

instance Arbitrary LastNothing where
  arbitrary :: Gen LastNothing
arbitrary = LastNothing -> Gen LastNothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure LastNothing
LastNothing

instance Arbitrary a => Arbitrary (Bottom a) where
  arbitrary :: Gen (Bottom a)
arbitrary = (Maybe a -> Bottom a) -> Gen (Maybe a) -> Gen (Bottom a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Bottom a
forall a. Maybe a -> Bottom a
maybeToBottom Gen (Maybe a)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Bottom a -> [Bottom a]
shrink Bottom a
x = (Maybe a -> Bottom a) -> [Maybe a] -> [Bottom a]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> Bottom a
forall a. Maybe a -> Bottom a
maybeToBottom (Maybe a -> [Maybe a]
forall a. Arbitrary a => a -> [a]
shrink (Bottom a -> Maybe a
forall a. Bottom a -> Maybe a
bottomToMaybe Bottom a
x))

bottomToMaybe :: Bottom a -> Maybe a
bottomToMaybe :: Bottom a -> Maybe a
bottomToMaybe Bottom a
BottomUndefined = Maybe a
forall a. Maybe a
Nothing
bottomToMaybe (BottomValue a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

maybeToBottom :: Maybe a -> Bottom a
maybeToBottom :: Maybe a -> Bottom a
maybeToBottom Maybe a
Nothing = Bottom a
forall a. Bottom a
BottomUndefined
maybeToBottom (Just a
a) = a -> Bottom a
forall a. a -> Bottom a
BottomValue a
a

newtype Apply f a = Apply { Apply f a -> f a
getApply :: f a }

instance (Applicative f, Monoid a) => Semigroup (Apply f a) where
  Apply f a
x <> :: Apply f a -> Apply f a -> Apply f a
<> Apply f a
y = f a -> Apply f a
forall (f :: * -> *) a. f a -> Apply f a
Apply (f a -> Apply f a) -> f a -> Apply f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend f a
x f a
y

instance (Applicative f, Monoid a) => Monoid (Apply f a) where
  mempty :: Apply f a
mempty = f a -> Apply f a
forall (f :: * -> *) a. f a -> Apply f a
Apply (f a -> Apply f a) -> f a -> Apply f a
forall a b. (a -> b) -> a -> b
$ a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mappend :: Apply f a -> Apply f a -> Apply f a
mappend = Apply f a -> Apply f a -> Apply f a
forall a. Semigroup a => a -> a -> a
(SG.<>)

#if HAVE_UNARY_LAWS
#if HAVE_QUANTIFIED_CONSTRAINTS
deriving instance (forall x. Eq x => Eq (f x), Eq a) => Eq (Apply f a)
deriving instance (forall x. Arbitrary x => Arbitrary (f x), Arbitrary a) => Arbitrary (Apply f a)
deriving instance (forall x. Show x => Show (f x), Show a) => Show (Apply f a)
#else
instance (Eq1 f, Eq a) => Eq (Apply f a) where
  Apply a == Apply b = eq1 a b

-- This show instance is intentionally a little bit wrong.
-- We don't wrap the result in Apply since the end user
-- should not be made aware of the Apply wrapper anyway.
instance (Show1 f, Show a) => Show (Apply f a) where
  showsPrec p = showsPrec1 p . getApply

instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Apply f a) where
  arbitrary = fmap Apply arbitrary1
  shrink = map Apply . shrink1 . getApply
#endif
#endif

foldMapA :: (Foldable t, Monoid m, Semigroup m, Applicative f) => (a -> f m) -> t a -> f m
foldMapA :: (a -> f m) -> t a -> f m
foldMapA a -> f m
f = Apply f m -> f m
forall (f :: * -> *) a. Apply f a -> f a
getApply (Apply f m -> f m) -> (t a -> Apply f m) -> t a -> f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Apply f m) -> t a -> Apply f m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (f m -> Apply f m
forall (f :: * -> *) a. f a -> Apply f a
Apply (f m -> Apply f m) -> (a -> f m) -> a -> Apply f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f m
f)


#if HAVE_BINARY_LAWS
newtype Apply2 f a b = Apply2 { Apply2 f a b -> f a b
getApply2 :: f a b }

#if HAVE_QUANTIFIED_CONSTRAINTS
deriving instance (forall x y. (Eq x, Eq y) => Eq (f x y), Eq a, Eq b) => Eq (Apply2 f a b)
deriving instance (forall x y. (Arbitrary x, Arbitrary y) => Arbitrary (f x y), Arbitrary a, Arbitrary b) => Arbitrary (Apply2 f a b)
deriving instance (forall x y. (Show x, Show y) => Show (f x y), Show a, Show b) => Show (Apply2 f a b)
#else
instance (Eq2 f, Eq a, Eq b) => Eq (Apply2 f a b) where
  Apply2 a == Apply2 b = C.eq2 a b

instance (Show2 f, Show a, Show b) => Show (Apply2 f a b) where
  showsPrec p = showsPrec2 p . getApply2

instance (Arbitrary2 f, Arbitrary a, Arbitrary b) => Arbitrary (Apply2 f a b) where
  arbitrary = fmap Apply2 arbitrary2
  shrink = fmap Apply2 . shrink2 . getApply2
#endif
#endif

data LinearEquation = LinearEquation
  { LinearEquation -> Integer
_linearEquationLinear :: Integer
  , LinearEquation -> Integer
_linearEquationConstant :: Integer
  } deriving (LinearEquation -> LinearEquation -> Bool
(LinearEquation -> LinearEquation -> Bool)
-> (LinearEquation -> LinearEquation -> Bool) -> Eq LinearEquation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearEquation -> LinearEquation -> Bool
$c/= :: LinearEquation -> LinearEquation -> Bool
== :: LinearEquation -> LinearEquation -> Bool
$c== :: LinearEquation -> LinearEquation -> Bool
Eq)

instance Show LinearEquation where
  showsPrec :: Int -> LinearEquation -> String -> String
showsPrec = Int -> LinearEquation -> String -> String
showLinear
  showList :: [LinearEquation] -> String -> String
showList = [LinearEquation] -> String -> String
showLinearList

runLinearEquation :: LinearEquation -> Integer -> Integer
runLinearEquation :: LinearEquation -> Integer -> Integer
runLinearEquation (LinearEquation Integer
a Integer
b) Integer
x = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b

showLinear :: Int -> LinearEquation -> ShowS
showLinear :: Int -> LinearEquation -> String -> String
showLinear Int
_ (LinearEquation Integer
a Integer
b) = Integer -> String -> String
forall a. Show a => a -> String -> String
shows Integer
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" * x + " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> String
forall a. Show a => a -> String -> String
shows Integer
b

showLinearList :: [LinearEquation] -> ShowS
showLinearList :: [LinearEquation] -> String -> String
showLinearList [LinearEquation]
xs = Endo String -> String -> String
forall a. Endo a -> a -> a
SG.appEndo (Endo String -> String -> String)
-> Endo String -> String -> String
forall a b. (a -> b) -> a -> b
$ [Endo String] -> Endo String
forall a. Monoid a => [a] -> a
mconcat
   ([Endo String] -> Endo String) -> [Endo String] -> Endo String
forall a b. (a -> b) -> a -> b
$ [(String -> String) -> Endo String
forall a. (a -> a) -> Endo a
SG.Endo (Char -> String -> String
showChar Char
'[')]
  [Endo String] -> [Endo String] -> [Endo String]
forall a. [a] -> [a] -> [a]
++ Endo String -> [Endo String] -> [Endo String]
forall a. a -> [a] -> [a]
L.intersperse ((String -> String) -> Endo String
forall a. (a -> a) -> Endo a
SG.Endo (Char -> String -> String
showChar Char
',')) ((LinearEquation -> Endo String)
-> [LinearEquation] -> [Endo String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> Endo String
forall a. (a -> a) -> Endo a
SG.Endo ((String -> String) -> Endo String)
-> (LinearEquation -> String -> String)
-> LinearEquation
-> Endo String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LinearEquation -> String -> String
showLinear Int
0) [LinearEquation]
xs)
  [Endo String] -> [Endo String] -> [Endo String]
forall a. [a] -> [a] -> [a]
++ [(String -> String) -> Endo String
forall a. (a -> a) -> Endo a
SG.Endo (Char -> String -> String
showChar Char
']')]

#if HAVE_UNARY_LAWS
data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation)

runLinearEquationM :: Monad m => LinearEquationM m -> Integer -> m Integer
runLinearEquationM :: LinearEquationM m -> Integer -> m Integer
runLinearEquationM (LinearEquationM m LinearEquation
e1 m LinearEquation
e2) Integer
i = if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
i
  then (LinearEquation -> Integer) -> m LinearEquation -> m Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((LinearEquation -> Integer -> Integer)
-> Integer -> LinearEquation -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip LinearEquation -> Integer -> Integer
runLinearEquation Integer
i) m LinearEquation
e1
  else (LinearEquation -> Integer) -> m LinearEquation -> m Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((LinearEquation -> Integer -> Integer)
-> Integer -> LinearEquation -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip LinearEquation -> Integer -> Integer
runLinearEquation Integer
i) m LinearEquation
e2

#if HAVE_QUANTIFIED_CONSTRAINTS
deriving instance (forall x. Eq x => Eq (m x)) => Eq (LinearEquationM m)
instance (forall a. Show a => Show (m a)) => Show (LinearEquationM m) where
  show :: LinearEquationM m -> String
show (LinearEquationM m LinearEquation
a m LinearEquation
b) = (\String -> String
f -> String -> String
f String
"")
    ((String -> String) -> String) -> (String -> String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"\\x -> if odd x then "
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m LinearEquation -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
0 m LinearEquation
a
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" else "
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m LinearEquation -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
0 m LinearEquation
b
instance (forall a. Arbitrary a => Arbitrary (m a)) => Arbitrary (LinearEquationM m) where
  arbitrary :: Gen (LinearEquationM m)
arbitrary = (m LinearEquation -> m LinearEquation -> LinearEquationM m)
-> Gen (m LinearEquation)
-> Gen (m LinearEquation)
-> Gen (LinearEquationM m)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m LinearEquation -> m LinearEquation -> LinearEquationM m
forall (m :: * -> *).
m LinearEquation -> m LinearEquation -> LinearEquationM m
LinearEquationM Gen (m LinearEquation)
forall a. Arbitrary a => Gen a
arbitrary Gen (m LinearEquation)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: LinearEquationM m -> [LinearEquationM m]
shrink (LinearEquationM m LinearEquation
a m LinearEquation
b) = [[LinearEquationM m]] -> [LinearEquationM m]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat
    [ (m LinearEquation -> LinearEquationM m)
-> [m LinearEquation] -> [LinearEquationM m]
forall a b. (a -> b) -> [a] -> [b]
map (\m LinearEquation
x -> m LinearEquation -> m LinearEquation -> LinearEquationM m
forall (m :: * -> *).
m LinearEquation -> m LinearEquation -> LinearEquationM m
LinearEquationM m LinearEquation
x m LinearEquation
b) (m LinearEquation -> [m LinearEquation]
forall a. Arbitrary a => a -> [a]
shrink m LinearEquation
a)
    , (m LinearEquation -> LinearEquationM m)
-> [m LinearEquation] -> [LinearEquationM m]
forall a b. (a -> b) -> [a] -> [b]
map (\m LinearEquation
x -> m LinearEquation -> m LinearEquation -> LinearEquationM m
forall (m :: * -> *).
m LinearEquation -> m LinearEquation -> LinearEquationM m
LinearEquationM m LinearEquation
a m LinearEquation
x) (m LinearEquation -> [m LinearEquation]
forall a. Arbitrary a => a -> [a]
shrink m LinearEquation
b)
    ]
#else
instance Eq1 m => Eq (LinearEquationM m) where
  LinearEquationM a1 b1 == LinearEquationM a2 b2 = eq1 a1 a2 && eq1 b1 b2

instance Show1 m => Show (LinearEquationM m) where
  show (LinearEquationM a b) = (\f -> f "")
    $ showString "\\x -> if odd x then "
    . showsPrec1 0 a
    . showString " else "
    . showsPrec1 0 b

instance Arbitrary1 m => Arbitrary (LinearEquationM m) where
  arbitrary = liftA2 LinearEquationM arbitrary1 arbitrary1
  shrink (LinearEquationM a b) = L.concat
    [ map (\x -> LinearEquationM x b) (shrink1 a)
    , map (\x -> LinearEquationM a x) (shrink1 b)
    ]
#endif
#endif

instance Arbitrary LinearEquation where
  arbitrary :: Gen LinearEquation
arbitrary = do
    (Integer
a,Integer
b) <- Gen (Integer, Integer)
forall a. Arbitrary a => Gen a
arbitrary
    LinearEquation -> Gen LinearEquation
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer -> LinearEquation
LinearEquation (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
b))
  shrink :: LinearEquation -> [LinearEquation]
shrink (LinearEquation Integer
a Integer
b) =
    let xs :: [(Integer, Integer)]
xs = (Integer, Integer) -> [(Integer, Integer)]
forall a. Arbitrary a => a -> [a]
shrink (Integer
a,Integer
b)
     in ((Integer, Integer) -> LinearEquation)
-> [(Integer, Integer)] -> [LinearEquation]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
x,Integer
y) -> Integer -> Integer -> LinearEquation
LinearEquation (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
y)) [(Integer, Integer)]
xs

-- this is a quadratic equation
data QuadraticEquation = QuadraticEquation
  { QuadraticEquation -> Integer
_quadraticEquationQuadratic :: Integer
  , QuadraticEquation -> Integer
_quadraticEquationLinear :: Integer
  , QuadraticEquation -> Integer
_quadraticEquationConstant :: Integer
  }
  deriving (QuadraticEquation -> QuadraticEquation -> Bool
(QuadraticEquation -> QuadraticEquation -> Bool)
-> (QuadraticEquation -> QuadraticEquation -> Bool)
-> Eq QuadraticEquation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadraticEquation -> QuadraticEquation -> Bool
$c/= :: QuadraticEquation -> QuadraticEquation -> Bool
== :: QuadraticEquation -> QuadraticEquation -> Bool
$c== :: QuadraticEquation -> QuadraticEquation -> Bool
Eq)

-- This show instance is does not actually provide a
-- way to create an equation. Instead, it makes it look
-- like a lambda.
instance Show QuadraticEquation where
  show :: QuadraticEquation -> String
show (QuadraticEquation Integer
a Integer
b Integer
c) = String
"\\x -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * x ^ 2 + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * x + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
c

instance Arbitrary QuadraticEquation where
  arbitrary :: Gen QuadraticEquation
arbitrary = do
    (Integer
a,Integer
b,Integer
c) <- Gen (Integer, Integer, Integer)
forall a. Arbitrary a => Gen a
arbitrary
    QuadraticEquation -> Gen QuadraticEquation
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer -> Integer -> QuadraticEquation
QuadraticEquation (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
b) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
c))
  shrink :: QuadraticEquation -> [QuadraticEquation]
shrink (QuadraticEquation Integer
a Integer
b Integer
c) =
    let xs :: [(Integer, Integer, Integer)]
xs = (Integer, Integer, Integer) -> [(Integer, Integer, Integer)]
forall a. Arbitrary a => a -> [a]
shrink (Integer
a,Integer
b,Integer
c)
     in ((Integer, Integer, Integer) -> QuadraticEquation)
-> [(Integer, Integer, Integer)] -> [QuadraticEquation]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
x,Integer
y,Integer
z) -> Integer -> Integer -> Integer -> QuadraticEquation
QuadraticEquation (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
y) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
z)) [(Integer, Integer, Integer)]
xs

runQuadraticEquation :: QuadraticEquation -> Integer -> Integer
runQuadraticEquation :: QuadraticEquation -> Integer -> Integer
runQuadraticEquation (QuadraticEquation Integer
a Integer
b Integer
c) Integer
x = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c

data LinearEquationTwo = LinearEquationTwo
  { LinearEquationTwo -> Integer
_linearEquationTwoX :: Integer
  , LinearEquationTwo -> Integer
_linearEquationTwoY :: Integer
  }
  deriving (LinearEquationTwo -> LinearEquationTwo -> Bool
(LinearEquationTwo -> LinearEquationTwo -> Bool)
-> (LinearEquationTwo -> LinearEquationTwo -> Bool)
-> Eq LinearEquationTwo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearEquationTwo -> LinearEquationTwo -> Bool
$c/= :: LinearEquationTwo -> LinearEquationTwo -> Bool
== :: LinearEquationTwo -> LinearEquationTwo -> Bool
$c== :: LinearEquationTwo -> LinearEquationTwo -> Bool
Eq)

-- This show instance does not actually provide a
-- way to create a LinearEquationTwo. Instead, it makes it look
-- like a lambda that takes two variables.
instance Show LinearEquationTwo where
  show :: LinearEquationTwo -> String
show (LinearEquationTwo Integer
a Integer
b) = String
"\\x y -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * x + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * y"

instance Arbitrary LinearEquationTwo where
  arbitrary :: Gen LinearEquationTwo
arbitrary = do
    (Integer
a,Integer
b) <- Gen (Integer, Integer)
forall a. Arbitrary a => Gen a
arbitrary
    LinearEquationTwo -> Gen LinearEquationTwo
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer -> LinearEquationTwo
LinearEquationTwo (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
b))
  shrink :: LinearEquationTwo -> [LinearEquationTwo]
shrink (LinearEquationTwo Integer
a Integer
b) =
    let xs :: [(Integer, Integer)]
xs = (Integer, Integer) -> [(Integer, Integer)]
forall a. Arbitrary a => a -> [a]
shrink (Integer
a,Integer
b)
     in ((Integer, Integer) -> LinearEquationTwo)
-> [(Integer, Integer)] -> [LinearEquationTwo]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
x,Integer
y) -> Integer -> Integer -> LinearEquationTwo
LinearEquationTwo (Integer -> Integer
forall a. Num a => a -> a
abs Integer
x) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
y)) [(Integer, Integer)]
xs

runLinearEquationTwo :: LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo :: LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo (LinearEquationTwo Integer
a Integer
b) Integer
x Integer
y = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y

newtype SmallList a = SmallList { SmallList a -> [a]
getSmallList :: [a] }
  deriving (SmallList a -> SmallList a -> Bool
(SmallList a -> SmallList a -> Bool)
-> (SmallList a -> SmallList a -> Bool) -> Eq (SmallList a)
forall a. Eq a => SmallList a -> SmallList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmallList a -> SmallList a -> Bool
$c/= :: forall a. Eq a => SmallList a -> SmallList a -> Bool
== :: SmallList a -> SmallList a -> Bool
$c== :: forall a. Eq a => SmallList a -> SmallList a -> Bool
Eq,Int -> SmallList a -> String -> String
[SmallList a] -> String -> String
SmallList a -> String
(Int -> SmallList a -> String -> String)
-> (SmallList a -> String)
-> ([SmallList a] -> String -> String)
-> Show (SmallList a)
forall a. Show a => Int -> SmallList a -> String -> String
forall a. Show a => [SmallList a] -> String -> String
forall a. Show a => SmallList a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SmallList a] -> String -> String
$cshowList :: forall a. Show a => [SmallList a] -> String -> String
show :: SmallList a -> String
$cshow :: forall a. Show a => SmallList a -> String
showsPrec :: Int -> SmallList a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> SmallList a -> String -> String
Show)

instance Arbitrary a => Arbitrary (SmallList a) where
  arbitrary :: Gen (SmallList a)
arbitrary = do
    Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
6)
    [a]
xs <- Int -> Gen [a]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
n
    SmallList a -> Gen (SmallList a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> SmallList a
forall a. [a] -> SmallList a
SmallList [a]
xs)
  shrink :: SmallList a -> [SmallList a]
shrink = ([a] -> SmallList a) -> [[a]] -> [SmallList a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> SmallList a
forall a. [a] -> SmallList a
SmallList ([[a]] -> [SmallList a])
-> (SmallList a -> [[a]]) -> SmallList a -> [SmallList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink ([a] -> [[a]]) -> (SmallList a -> [a]) -> SmallList a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmallList a -> [a]
forall a. SmallList a -> [a]
getSmallList

newtype VerySmallList a = VerySmallList { VerySmallList a -> [a]
getVerySmallList :: [a] }
  deriving (VerySmallList a -> VerySmallList a -> Bool
(VerySmallList a -> VerySmallList a -> Bool)
-> (VerySmallList a -> VerySmallList a -> Bool)
-> Eq (VerySmallList a)
forall a. Eq a => VerySmallList a -> VerySmallList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerySmallList a -> VerySmallList a -> Bool
$c/= :: forall a. Eq a => VerySmallList a -> VerySmallList a -> Bool
== :: VerySmallList a -> VerySmallList a -> Bool
$c== :: forall a. Eq a => VerySmallList a -> VerySmallList a -> Bool
Eq, Int -> VerySmallList a -> String -> String
[VerySmallList a] -> String -> String
VerySmallList a -> String
(Int -> VerySmallList a -> String -> String)
-> (VerySmallList a -> String)
-> ([VerySmallList a] -> String -> String)
-> Show (VerySmallList a)
forall a. Show a => Int -> VerySmallList a -> String -> String
forall a. Show a => [VerySmallList a] -> String -> String
forall a. Show a => VerySmallList a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VerySmallList a] -> String -> String
$cshowList :: forall a. Show a => [VerySmallList a] -> String -> String
show :: VerySmallList a -> String
$cshow :: forall a. Show a => VerySmallList a -> String
showsPrec :: Int -> VerySmallList a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> VerySmallList a -> String -> String
Show, b -> VerySmallList a -> VerySmallList a
NonEmpty (VerySmallList a) -> VerySmallList a
VerySmallList a -> VerySmallList a -> VerySmallList a
(VerySmallList a -> VerySmallList a -> VerySmallList a)
-> (NonEmpty (VerySmallList a) -> VerySmallList a)
-> (forall b.
    Integral b =>
    b -> VerySmallList a -> VerySmallList a)
-> Semigroup (VerySmallList a)
forall b. Integral b => b -> VerySmallList a -> VerySmallList a
forall a. NonEmpty (VerySmallList a) -> VerySmallList a
forall a. VerySmallList a -> VerySmallList a -> VerySmallList a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> VerySmallList a -> VerySmallList a
stimes :: b -> VerySmallList a -> VerySmallList a
$cstimes :: forall a b. Integral b => b -> VerySmallList a -> VerySmallList a
sconcat :: NonEmpty (VerySmallList a) -> VerySmallList a
$csconcat :: forall a. NonEmpty (VerySmallList a) -> VerySmallList a
<> :: VerySmallList a -> VerySmallList a -> VerySmallList a
$c<> :: forall a. VerySmallList a -> VerySmallList a -> VerySmallList a
Semigroup, Semigroup (VerySmallList a)
VerySmallList a
Semigroup (VerySmallList a)
-> VerySmallList a
-> (VerySmallList a -> VerySmallList a -> VerySmallList a)
-> ([VerySmallList a] -> VerySmallList a)
-> Monoid (VerySmallList a)
[VerySmallList a] -> VerySmallList a
VerySmallList a -> VerySmallList a -> VerySmallList a
forall a. Semigroup (VerySmallList a)
forall a. VerySmallList a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [VerySmallList a] -> VerySmallList a
forall a. VerySmallList a -> VerySmallList a -> VerySmallList a
mconcat :: [VerySmallList a] -> VerySmallList a
$cmconcat :: forall a. [VerySmallList a] -> VerySmallList a
mappend :: VerySmallList a -> VerySmallList a -> VerySmallList a
$cmappend :: forall a. VerySmallList a -> VerySmallList a -> VerySmallList a
mempty :: VerySmallList a
$cmempty :: forall a. VerySmallList a
$cp1Monoid :: forall a. Semigroup (VerySmallList a)
Monoid)

instance Arbitrary a => Arbitrary (VerySmallList a) where
  arbitrary :: Gen (VerySmallList a)
arbitrary = do
    Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
2)
    [a]
xs <- Int -> Gen [a]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
n
    VerySmallList a -> Gen (VerySmallList a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> VerySmallList a
forall a. [a] -> VerySmallList a
VerySmallList [a]
xs)
  shrink :: VerySmallList a -> [VerySmallList a]
shrink = ([a] -> VerySmallList a) -> [[a]] -> [VerySmallList a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> VerySmallList a
forall a. [a] -> VerySmallList a
VerySmallList ([[a]] -> [VerySmallList a])
-> (VerySmallList a -> [[a]])
-> VerySmallList a
-> [VerySmallList a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink ([a] -> [[a]])
-> (VerySmallList a -> [a]) -> VerySmallList a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerySmallList a -> [a]
forall a. VerySmallList a -> [a]
getVerySmallList

-- Haskell uses the operator precedences 0..9, the special function application
-- precedence 10 and the precedence 11 for function arguments. Both show and
-- read instances have to accept this range. According to the Haskell Language
-- Report, the output of derived show instances in precedence context 11 has to
-- be an atomic expression.
showReadPrecedences :: [Int]
showReadPrecedences :: [Int]
showReadPrecedences = [Int
0..Int
11]

newtype ShowReadPrecedence = ShowReadPrecedence Int
  deriving (ShowReadPrecedence -> ShowReadPrecedence -> Bool
(ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> (ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> Eq ShowReadPrecedence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c/= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
== :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c== :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
Eq,Eq ShowReadPrecedence
Eq ShowReadPrecedence
-> (ShowReadPrecedence -> ShowReadPrecedence -> Ordering)
-> (ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> (ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> (ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> (ShowReadPrecedence -> ShowReadPrecedence -> Bool)
-> (ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence)
-> (ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence)
-> Ord ShowReadPrecedence
ShowReadPrecedence -> ShowReadPrecedence -> Bool
ShowReadPrecedence -> ShowReadPrecedence -> Ordering
ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence
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 :: ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence
$cmin :: ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence
max :: ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence
$cmax :: ShowReadPrecedence -> ShowReadPrecedence -> ShowReadPrecedence
>= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c>= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
> :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c> :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
<= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c<= :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
< :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
$c< :: ShowReadPrecedence -> ShowReadPrecedence -> Bool
compare :: ShowReadPrecedence -> ShowReadPrecedence -> Ordering
$ccompare :: ShowReadPrecedence -> ShowReadPrecedence -> Ordering
$cp1Ord :: Eq ShowReadPrecedence
Ord,Int -> ShowReadPrecedence -> String -> String
[ShowReadPrecedence] -> String -> String
ShowReadPrecedence -> String
(Int -> ShowReadPrecedence -> String -> String)
-> (ShowReadPrecedence -> String)
-> ([ShowReadPrecedence] -> String -> String)
-> Show ShowReadPrecedence
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ShowReadPrecedence] -> String -> String
$cshowList :: [ShowReadPrecedence] -> String -> String
show :: ShowReadPrecedence -> String
$cshow :: ShowReadPrecedence -> String
showsPrec :: Int -> ShowReadPrecedence -> String -> String
$cshowsPrec :: Int -> ShowReadPrecedence -> String -> String
Show)
instance Arbitrary ShowReadPrecedence where
  arbitrary :: Gen ShowReadPrecedence
arbitrary = Int -> ShowReadPrecedence
ShowReadPrecedence (Int -> ShowReadPrecedence) -> Gen Int -> Gen ShowReadPrecedence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Gen Int
forall a. [a] -> Gen a
elements [Int]
showReadPrecedences
  shrink :: ShowReadPrecedence -> [ShowReadPrecedence]
shrink (ShowReadPrecedence Int
p) =
    [ Int -> ShowReadPrecedence
ShowReadPrecedence Int
p' | Int
p' <- [Int]
showReadPrecedences, Int
p' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p ]

#if !MIN_VERSION_base(4,6,0)
readMaybe :: Read a => String -> Maybe a
readMaybe s =
  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
    [x] -> Just x
    _   -> Nothing
 where
  read' =
    do x <- readPrec
       lift skipSpaces
       return x
#endif

#if !MIN_VERSION_base(4,7,0)
isTrue# :: Bool -> Bool
isTrue# b = b
#endif

#if HAVE_UNARY_LAWS
#if HAVE_QUANTIFIED_CONSTRAINTS
eq1 :: (forall x. Eq x => Eq (f x), Eq a) => f a -> f a -> Bool
eq1 :: f a -> f a -> Bool
eq1 = f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
eq1 :: (C.Eq1 f, Eq a) => f a -> f a -> Bool
eq1 = C.eq1
#endif
#endif

#if HAVE_UNARY_LAWS
#if HAVE_QUANTIFIED_CONSTRAINTS
eq1_2 :: (forall a. Eq a => Eq (f a), forall a b. (Eq a, Eq b) => Eq (g a b), Eq x, Eq y)
  => f (g x y) -> f (g x y) -> Bool
eq1_2 :: f (g x y) -> f (g x y) -> Bool
eq1_2 = f (g x y) -> f (g x y) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
eq1_2 :: (C.Eq1 f, C.Eq2 g, Eq a, Eq b) => f (g a b) -> f (g a b) -> Bool
eq1_2 = C.liftEq C.eq2
#endif
#endif

#if HAVE_BINARY_LAWS
#if HAVE_QUANTIFIED_CONSTRAINTS
eq2 :: (forall a. (Eq a, Eq b) => Eq (f a b), Eq a, Eq b) => f a b -> f a b -> Bool
eq2 :: f a b -> f a b -> Bool
eq2 = f a b -> f a b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
eq2 :: (C.Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
eq2 = C.eq2
#endif
#endif