{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Hedgehog.Classes.Common.Equation
  ( LinearEquation(..), runLinearEquation, genLinearEquation
  , LinearEquationTwo(..), runLinearEquationTwo, genLinearEquationTwo
  , LinearEquationM(..), runLinearEquationM, genLinearEquationM
  , QuadraticEquation(..), runQuadraticEquation, genQuadraticEquation
  , CubicEquation(..), runCubicEquation, genCubicEquation

#ifdef HAVE_COMONAD
  , LinearEquationW(..), runLinearEquationW, genLinearEquationW
#endif
  ) where

import Hedgehog
import Hedgehog.Classes.Common.Gen
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified Data.List as List

import Data.Monoid (Endo(..))

#ifdef HAVE_COMONAD
import Control.Comonad
#endif

data QuadraticEquation = QuadraticEquation
  { QuadraticEquation -> Integer
_quadraticEquationQuadratic :: Integer
  , QuadraticEquation -> Integer
_quadraticEquationLinear :: Integer
  , QuadraticEquation -> Integer
_quadraticEquationConstant :: Integer
  }
  deriving (QuadraticEquation -> QuadraticEquation -> Bool
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 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 -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
a forall a. [a] -> [a] -> [a]
++ String
" * x ^ 2 + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
b forall a. [a] -> [a] -> [a]
++ String
" * x + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
c

genQuadraticEquation :: Gen QuadraticEquation
genQuadraticEquation :: Gen QuadraticEquation
genQuadraticEquation = do
  Integer
a <- forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
  Integer
b <- forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
  Integer
c <- forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer -> Integer -> QuadraticEquation
QuadraticEquation Integer
a Integer
b Integer
c)

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

data LinearEquation = LinearEquation
  { LinearEquation -> Integer
_linearEquationLinear :: Integer
  , LinearEquation -> Integer
_linearEquationConstant :: Integer
  }
  deriving (LinearEquation -> LinearEquation -> Bool
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 -> ShowS
showsPrec Int
_ (LinearEquation Integer
a Integer
b) = forall a. Show a => a -> ShowS
shows Integer
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" * x + " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Integer
b
  showList :: [LinearEquation] -> ShowS
showList [LinearEquation]
xs = forall a. Endo a -> a -> a
appEndo
    forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    forall a b. (a -> b) -> a -> b
$  [forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
'[')]
    forall a. [a] -> [a] -> [a]
++ forall a. a -> [a] -> [a]
List.intersperse (forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
',')) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0) [LinearEquation]
xs)
    forall a. [a] -> [a] -> [a]
++ [forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
']')]

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

genLinearEquation :: Gen LinearEquation
genLinearEquation :: Gen LinearEquation
genLinearEquation = Integer -> Integer -> LinearEquation
LinearEquation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genSmallInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
genSmallInteger
#ifdef HAVE_COMONAD
data LinearEquationW w = LinearEquationW (w LinearEquation) (w LinearEquation)

deriving instance (forall x. Eq x => Eq (w x)) => Eq (LinearEquationW w)
instance (forall x. Show x => Show (w x)) => Show (LinearEquationW w) where
  show :: LinearEquationW w -> String
show (LinearEquationW w LinearEquation
a w LinearEquation
b) = (\ShowS
f -> ShowS
f String
"")
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"\\x -> if odd x then "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 w LinearEquation
a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" else "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 w LinearEquation
b

runLinearEquationW :: Comonad w
  => LinearEquationW w -> w Integer -> Integer
runLinearEquationW :: forall (w :: * -> *).
Comonad w =>
LinearEquationW w -> w Integer -> Integer
runLinearEquationW (LinearEquationW w LinearEquation
e1 w LinearEquation
e2) (forall (w :: * -> *) a. Comonad w => w a -> a
extract -> Integer
i) = if forall a. Integral a => a -> Bool
odd Integer
i
  then LinearEquation -> Integer -> Integer
runLinearEquation (forall (w :: * -> *) a. Comonad w => w a -> a
extract w LinearEquation
e1) Integer
i
  else LinearEquation -> Integer -> Integer
runLinearEquation (forall (w :: * -> *) a. Comonad w => w a -> a
extract w LinearEquation
e2) Integer
i

genLinearEquationW :: Comonad w
  => (forall x. Gen x -> Gen (w x))
  -> Gen (LinearEquationW w)
genLinearEquationW :: forall (w :: * -> *).
Comonad w =>
(forall x. Gen x -> Gen (w x)) -> Gen (LinearEquationW w)
genLinearEquationW forall x. Gen x -> Gen (w x)
fgen = forall (w :: * -> *).
w LinearEquation -> w LinearEquation -> LinearEquationW w
LinearEquationW
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. Gen x -> Gen (w x)
fgen Gen LinearEquation
genLinearEquation
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x. Gen x -> Gen (w x)
fgen Gen LinearEquation
genLinearEquation
#endif

data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation)

deriving instance (forall x. Eq x => Eq (m x)) => Eq (LinearEquationM m)

instance (forall x. Show x => Show (m x)) => Show (LinearEquationM m) where
  show :: LinearEquationM m -> String
show (LinearEquationM m LinearEquation
a m LinearEquation
b) = (\ShowS
f -> ShowS
f String
"")
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"\\x -> if odd x then "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 m LinearEquation
a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" else "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 m LinearEquation
b

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

genLinearEquationM :: Applicative m => Gen (LinearEquationM m)
genLinearEquationM :: forall (m :: * -> *). Applicative m => Gen (LinearEquationM m)
genLinearEquationM = forall (m :: * -> *).
m LinearEquation -> m LinearEquation -> LinearEquationM m
LinearEquationM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LinearEquation
genLinearEquation) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LinearEquation
genLinearEquation)

data LinearEquationTwo = LinearEquationTwo
  { LinearEquationTwo -> Integer
_linearEquationTwoX :: Integer
  , LinearEquationTwo -> Integer
_linearEquationTwoY :: Integer
  , LinearEquationTwo -> Integer
_linearEquationTwoConstant :: Integer
  }

instance Show LinearEquationTwo where
  show :: LinearEquationTwo -> String
show (LinearEquationTwo Integer
x Integer
y Integer
c) = String
"\\x y -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
x forall a. [a] -> [a] -> [a]
++ String
" * x + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
y forall a. [a] -> [a] -> [a]
++ String
" * y + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
c

genLinearEquationTwo :: Gen LinearEquationTwo
genLinearEquationTwo :: Gen LinearEquationTwo
genLinearEquationTwo = Integer -> Integer -> Integer -> LinearEquationTwo
LinearEquationTwo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
absGenInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
absGenInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
absGenInteger
  where
    absGenInteger :: Gen Integer
absGenInteger = forall a. Num a => a -> a
abs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genSmallInteger

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

data CubicEquation = CubicEquation
  { CubicEquation -> Integer
_cubicEquationCubic :: Integer
  , CubicEquation -> Integer
_cubicEquationQuadratic :: Integer
  , CubicEquation -> Integer
_cubicEquationLinear :: Integer
  , CubicEquation -> Integer
_cubicEquationConstant :: Integer
  }

instance Show CubicEquation where
  show :: CubicEquation -> String
show (CubicEquation Integer
x Integer
y Integer
z Integer
c) = String
"\\x -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
x forall a. [a] -> [a] -> [a]
++ String
" * x ^ 3 + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
y forall a. [a] -> [a] -> [a]
++ String
" * x ^ 2 + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
z forall a. [a] -> [a] -> [a]
++ String
" * x + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
c

genCubicEquation :: Gen CubicEquation
genCubicEquation :: Gen CubicEquation
genCubicEquation = Integer -> Integer -> Integer -> Integer -> CubicEquation
CubicEquation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genSmallInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
genSmallInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
genSmallInteger forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
genSmallInteger

runCubicEquation :: CubicEquation -> Integer -> Integer -> Integer -> Integer
runCubicEquation :: CubicEquation -> Integer -> Integer -> Integer -> Integer
runCubicEquation (CubicEquation Integer
a Integer
b Integer
c Integer
d) Integer
x Integer
y Integer
z = Integer
a forall a. Num a => a -> a -> a
* Integer
x forall a. Num a => a -> a -> a
+ Integer
b forall a. Num a => a -> a -> a
* Integer
y forall a. Num a => a -> a -> a
+ Integer
c forall a. Num a => a -> a -> a
* Integer
z forall a. Num a => a -> a -> a
+ Integer
d