-- |Compare two 'Data' value with time and size limit
{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification #-}
module Data.Data.Compare 
    ( Answer (..)
    , showAnswer
    , compareData
    ) where

import Data.Data.GenRep
import System.IO.Parallel (twoParallel, manyParallel)
import Data.Data.Eval (evalWithBudget)
import System.SimpleTimeout.Limits

import Control.DeepSeq (NFData, rnf)
import Data.Data (Data, Typeable, gmapQi, toConstr)
import Data.List (minimumBy)
import Data.Ord (comparing)

------------------------

-- |Answer with possibility
--
--      * 'No': no
--
--      * @'Maybe' d@: maybe with d possibility (0-1, 1 denotes yes)
--
--      * 'Yes': yes
data Answer
    = No | Maybe Double | Yes
        deriving (Answer -> Answer -> Bool
(Answer -> Answer -> Bool)
-> (Answer -> Answer -> Bool) -> Eq Answer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Answer -> Answer -> Bool
$c/= :: Answer -> Answer -> Bool
== :: Answer -> Answer -> Bool
$c== :: Answer -> Answer -> Bool
Eq, Eq Answer
Eq Answer
-> (Answer -> Answer -> Ordering)
-> (Answer -> Answer -> Bool)
-> (Answer -> Answer -> Bool)
-> (Answer -> Answer -> Bool)
-> (Answer -> Answer -> Bool)
-> (Answer -> Answer -> Answer)
-> (Answer -> Answer -> Answer)
-> Ord Answer
Answer -> Answer -> Bool
Answer -> Answer -> Ordering
Answer -> Answer -> Answer
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 :: Answer -> Answer -> Answer
$cmin :: Answer -> Answer -> Answer
max :: Answer -> Answer -> Answer
$cmax :: Answer -> Answer -> Answer
>= :: Answer -> Answer -> Bool
$c>= :: Answer -> Answer -> Bool
> :: Answer -> Answer -> Bool
$c> :: Answer -> Answer -> Bool
<= :: Answer -> Answer -> Bool
$c<= :: Answer -> Answer -> Bool
< :: Answer -> Answer -> Bool
$c< :: Answer -> Answer -> Bool
compare :: Answer -> Answer -> Ordering
$ccompare :: Answer -> Answer -> Ordering
$cp1Ord :: Eq Answer
Ord, Int -> Answer -> ShowS
[Answer] -> ShowS
Answer -> String
(Int -> Answer -> ShowS)
-> (Answer -> String) -> ([Answer] -> ShowS) -> Show Answer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Answer] -> ShowS
$cshowList :: [Answer] -> ShowS
show :: Answer -> String
$cshow :: Answer -> String
showsPrec :: Int -> Answer -> ShowS
$cshowsPrec :: Int -> Answer -> ShowS
Show, Typeable, Typeable Answer
DataType
Constr
Typeable Answer
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Answer -> c Answer)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Answer)
-> (Answer -> Constr)
-> (Answer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Answer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Answer))
-> ((forall b. Data b => b -> b) -> Answer -> Answer)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Answer -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Answer -> r)
-> (forall u. (forall d. Data d => d -> u) -> Answer -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Answer -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Answer -> m Answer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Answer -> m Answer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Answer -> m Answer)
-> Data Answer
Answer -> DataType
Answer -> Constr
(forall b. Data b => b -> b) -> Answer -> Answer
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Answer -> c Answer
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Answer
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Answer -> u
forall u. (forall d. Data d => d -> u) -> Answer -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Answer -> m Answer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Answer -> m Answer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Answer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Answer -> c Answer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Answer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Answer)
$cYes :: Constr
$cMaybe :: Constr
$cNo :: Constr
$tAnswer :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Answer -> m Answer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Answer -> m Answer
gmapMp :: (forall d. Data d => d -> m d) -> Answer -> m Answer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Answer -> m Answer
gmapM :: (forall d. Data d => d -> m d) -> Answer -> m Answer
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Answer -> m Answer
gmapQi :: Int -> (forall d. Data d => d -> u) -> Answer -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Answer -> u
gmapQ :: (forall d. Data d => d -> u) -> Answer -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Answer -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Answer -> r
gmapT :: (forall b. Data b => b -> b) -> Answer -> Answer
$cgmapT :: (forall b. Data b => b -> b) -> Answer -> Answer
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Answer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Answer)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Answer)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Answer)
dataTypeOf :: Answer -> DataType
$cdataTypeOf :: Answer -> DataType
toConstr :: Answer -> Constr
$ctoConstr :: Answer -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Answer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Answer
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Answer -> c Answer
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Answer -> c Answer
$cp1Data :: Typeable Answer
Data)

instance NFData Answer where
    rnf :: Answer -> ()
rnf Answer
x = case Answer
x of
        Maybe Double
a ->  Double -> ()
forall a. NFData a => a -> ()
rnf Double
a
        Answer
_       ->  ()

-- |Show an 'Answer' as an equality operator.
showAnswer :: Answer -> String
showAnswer :: Answer -> String
showAnswer Answer
No          = String
"=/=" 
showAnswer (Maybe Double
_)   = String
"=?=" 
showAnswer Answer
Yes         = String
"===" 

-----------------------------

-- |Compare two 'Data' value with time and size limit.
compareData 
    :: (Data a) 
    => TimeLimit    -- ^ time limit for comparison decision
    -> TimeLimit    -- ^ time limit for highlighting the difference
    -> SizeLimit    -- ^ size limit for the output (in characters)
    -> a            -- ^ first value
    -> a            -- ^ second value
    -> IO (Answer, GenericData, GenericData)
compareData :: Double
-> Double -> Int -> a -> a -> IO (Answer, GenericData, GenericData)
compareData Double
t1 Double
t2 Int
s a
x a
y = do
    Budget
b1 <- Double -> Int -> IO Budget
newBudget Double
t1 Int
forall a. Bounded a => a
maxBound
    (Answer
ans, Path DData
l) <- Budget -> a -> a -> IO (Answer, Path DData)
forall a b.
(Data a, Data b) =>
Budget -> a -> b -> IO (Answer, Path DData)
decideEquality Budget
b1 a
x a
y
    Budget
b2 <- Double -> Int -> IO Budget
newBudget Double
t2 Int
s
    (GenericData
x, GenericData
y) <- (Path GenericData -> (GenericData, GenericData))
-> IO (Path GenericData) -> IO (GenericData, GenericData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path GenericData -> (GenericData, GenericData)
assemble (IO (Path GenericData) -> IO (GenericData, GenericData))
-> IO (Path GenericData) -> IO (GenericData, GenericData)
forall a b. (a -> b) -> a -> b
$ [IO ([Int], (GenericData, GenericData))] -> IO (Path GenericData)
forall a. [IO a] -> IO [a]
manyParallel ([IO ([Int], (GenericData, GenericData))] -> IO (Path GenericData))
-> [IO ([Int], (GenericData, GenericData))]
-> IO (Path GenericData)
forall a b. (a -> b) -> a -> b
$ (([Int], (DData, DData)) -> IO ([Int], (GenericData, GenericData)))
-> Path DData -> [IO ([Int], (GenericData, GenericData))]
forall a b. (a -> b) -> [a] -> [b]
map (Budget
-> ([Int], (DData, DData))
-> IO ([Int], (GenericData, GenericData))
showPart Budget
b2) (Path DData -> [IO ([Int], (GenericData, GenericData))])
-> Path DData -> [IO ([Int], (GenericData, GenericData))]
forall a b. (a -> b) -> a -> b
$ Path DData -> Path DData
collapsePath Path DData
l
    (Answer, GenericData, GenericData)
-> IO (Answer, GenericData, GenericData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Answer
ans, GenericData
x, GenericData
y)
 where
    showPart :: Budget
-> ([Int], (DData, DData))
-> IO ([Int], (GenericData, GenericData))
showPart Budget
budget ([Int]
is, (DData a
x, DData y)) = do
        (GenericData, GenericData)
p <- IO GenericData -> IO GenericData -> IO (GenericData, GenericData)
forall a b. IO a -> IO b -> IO (a, b)
twoParallel (Budget -> [Int] -> a -> IO GenericData
forall a. Data a => Budget -> [Int] -> a -> IO GenericData
evalPath Budget
budget [Int]
is a
x) (Budget -> [Int] -> a -> IO GenericData
forall a. Data a => Budget -> [Int] -> a -> IO GenericData
evalPath Budget
budget [Int]
is a
y)
        ([Int], (GenericData, GenericData))
-> IO ([Int], (GenericData, GenericData))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int]
is, (GenericData, GenericData)
p)

data DData = forall a. Data a => DData a

type Path a = [([Int], (a, a))]

collapsePath :: Path DData -> Path DData
collapsePath :: Path DData -> Path DData
collapsePath Path DData
xs = case Int -> Path DData -> (Path DData, Path DData)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 Path DData
xs of
    (Path DData
l, []) -> Path DData
l
    (Path DData
l, Path DData
m) -> Path DData
l Path DData -> Path DData -> Path DData
forall a. [a] -> [a] -> [a]
++ case Int -> Path DData -> (Path DData, Path DData)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 (Path DData -> (Path DData, Path DData))
-> Path DData -> (Path DData, Path DData)
forall a b. (a -> b) -> a -> b
$ Path DData -> Path DData
forall a. [a] -> [a]
reverse Path DData
m of
        (Path DData
m, []) -> Path DData -> Path DData
forall a. [a] -> [a]
reverse Path DData
m
        (Path DData
m, Path DData
k) -> case Path DData -> Path DData
forall a. [a] -> [a]
reverse Path DData
k of
            ([Int]
i,(DData, DData)
p):Path DData
k -> ([Int]
i [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (([Int], (DData, DData)) -> [Int]) -> Path DData -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], (DData, DData)) -> [Int]
forall a b. (a, b) -> a
fst Path DData
k, (DData, DData)
p)([Int], (DData, DData)) -> Path DData -> Path DData
forall a. a -> [a] -> [a]
: Path DData -> Path DData
forall a. [a] -> [a]
reverse Path DData
m
            Path DData
_       -> String -> Path DData
forall a. HasCallStack => String -> a
error String
"collapsePath"

assemble :: Path GenericData -> (GenericData, GenericData)
assemble :: Path GenericData -> (GenericData, GenericData)
assemble [([], (GenericData, GenericData)
p)] = (GenericData, GenericData)
p
assemble (([Int]
is, (GenericData
x, GenericData
y)) : Path GenericData
xys) = case Path GenericData -> (GenericData, GenericData)
assemble Path GenericData
xys of
    (GenericData
x', GenericData
y') -> ([Int] -> GenericData -> GenericData -> GenericData
forall t.
(Eq t, Num t) =>
[t] -> GenericData -> GenericData -> GenericData
g [Int]
is GenericData
x GenericData
x', [Int] -> GenericData -> GenericData -> GenericData
forall t.
(Eq t, Num t) =>
[t] -> GenericData -> GenericData -> GenericData
g [Int]
is GenericData
y GenericData
y')
  where
    g :: [t] -> GenericData -> GenericData -> GenericData
g [] GenericData
_ GenericData
x' = GenericData
x'
    g (t
i:[t]
is) (Constructor ConstructorName
c [GenericData]
l) GenericData
x' = ConstructorName -> [GenericData] -> GenericData
Constructor ConstructorName
c ([GenericData] -> GenericData) -> [GenericData] -> GenericData
forall a b. (a -> b) -> a -> b
$ t -> [GenericData] -> (GenericData -> GenericData) -> [GenericData]
forall t a. (Eq t, Num t) => t -> [a] -> (a -> a) -> [a]
rep t
i [GenericData]
l ((GenericData -> GenericData) -> [GenericData])
-> (GenericData -> GenericData) -> [GenericData]
forall a b. (a -> b) -> a -> b
$ \GenericData
x -> [t] -> GenericData -> GenericData -> GenericData
g [t]
is GenericData
x GenericData
x'
    g (t
_:[t]
is) GenericData
_ GenericData
x' = GenericData -> GenericData
detail (GenericData -> GenericData) -> GenericData -> GenericData
forall a b. (a -> b) -> a -> b
$ [t] -> GenericData -> GenericData -> GenericData
g [t]
is GenericData
Hole GenericData
x'

    detail :: GenericData -> GenericData
detail (Detail GenericData
x) = GenericData -> GenericData
Detail GenericData
x
    detail GenericData
x = GenericData -> GenericData
Detail GenericData
x

    rep :: t -> [a] -> (a -> a) -> [a]
rep t
0 (a
x:[a]
xs) a -> a
f = a -> a
f a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    rep t
i (a
x:[a]
xs) a -> a
f = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> (a -> a) -> [a]
rep (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs a -> a
f
    rep t
_ [a]
_ a -> a
_ = String -> [a]
forall a. HasCallStack => String -> a
error String
"rep"
assemble Path GenericData
_ = String -> (GenericData, GenericData)
forall a. HasCallStack => String -> a
error String
"assemble"


evalPath :: Data a => Budget -> [Int] -> a -> IO GenericData
evalPath :: Budget -> [Int] -> a -> IO GenericData
evalPath Budget
budget [] a
x 
    = Budget -> a -> IO GenericData
forall a. Data a => Budget -> a -> IO GenericData
evalWithBudget Budget
budget a
x
evalPath Budget
budget (Int
j:[Int]
is) a
x 
    = Budget -> a -> IO [GenericData] -> IO GenericData
forall a.
Data a =>
Budget -> a -> IO [GenericData] -> IO GenericData
constructor Budget
budget a
x
    (IO [GenericData] -> IO GenericData)
-> IO [GenericData] -> IO GenericData
forall a b. (a -> b) -> a -> b
$ [IO GenericData] -> IO [GenericData]
forall a. [IO a] -> IO [a]
manyParallel 
      [ Int
-> (forall d. Data d => d -> IO GenericData) -> a -> IO GenericData
forall a u. Data a => Int -> (forall d. Data d => d -> u) -> a -> u
gmapQi Int
i (if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j then Budget -> [Int] -> d -> IO GenericData
forall a. Data a => Budget -> [Int] -> a -> IO GenericData
evalPath Budget
budget [Int]
is else Budget -> d -> IO GenericData
forall a. Data a => Budget -> a -> IO GenericData
evalWithBudget Budget
budget) a
x
      | Int
i <- [Int
0..a -> Int
forall a. Data a => a -> Int
arity a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]


decideEquality :: (Data a, Data b) => Budget -> a -> b -> IO (Answer, Path DData)
decideEquality :: Budget -> a -> b -> IO (Answer, Path DData)
decideEquality Budget
budget a
x b
y = do
    GenericData
a <- a -> IO GenericData
forall d. Data d => d -> IO GenericData
observe a
x
    GenericData
b <- b -> IO GenericData
forall d. Data d => d -> IO GenericData
observe b
y
    GenericData
a GenericData -> GenericData -> IO (Answer, Path DData)
`f` GenericData
b
  where
    observe :: a -> IO GenericData
observe a
x = (GenericData -> GenericData) -> IO GenericData -> IO GenericData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenericData -> GenericData
simplify (IO GenericData -> IO GenericData)
-> IO GenericData -> IO GenericData
forall a b. (a -> b) -> a -> b
$ Budget -> a -> IO [GenericData] -> IO GenericData
forall a.
Data a =>
Budget -> a -> IO [GenericData] -> IO GenericData
constructor Budget
budget a
x (IO [GenericData] -> IO GenericData)
-> IO [GenericData] -> IO GenericData
forall a b. (a -> b) -> a -> b
$ [GenericData] -> IO [GenericData]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      where
        simplify :: GenericData -> GenericData
simplify (NestedError GenericData
_) = String -> GenericData
Error String
"undefined error"
        simplify GenericData
Hole  = Double -> GenericData
Timeout Double
1
        simplify GenericData
other = GenericData
other

    Error String
_   f :: GenericData -> GenericData -> IO (Answer, Path DData)
`f` Error String
_    = IO (Answer, Path DData)
forall a. IO (Answer, [([a], (DData, DData))])
yes
    Timeout Double
b `f` Timeout Double
b' = Double -> IO (Answer, Path DData)
forall (m :: * -> *) a.
Monad m =>
Double -> m (Answer, [([a], (DData, DData))])
may (Double -> IO (Answer, Path DData))
-> Double -> IO (Answer, Path DData)
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b')
    Timeout Double
b `f` Error String
_    = Double -> IO (Answer, Path DData)
forall (m :: * -> *) a.
Monad m =>
Double -> m (Answer, [([a], (DData, DData))])
may (Double -> IO (Answer, Path DData))
-> Double -> IO (Answer, Path DData)
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b
    Error String
_   `f` Timeout Double
b  = Double -> IO (Answer, Path DData)
forall (m :: * -> *) a.
Monad m =>
Double -> m (Answer, [([a], (DData, DData))])
may (Double -> IO (Answer, Path DData))
-> Double -> IO (Answer, Path DData)
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b
    Timeout Double
b `f` GenericData
_          = Double -> IO (Answer, Path DData)
forall (m :: * -> *) a.
Monad m =>
Double -> m (Answer, [([a], (DData, DData))])
may Double
b
    GenericData
_         `f` Timeout Double
b  = Double -> IO (Answer, Path DData)
forall (m :: * -> *) a.
Monad m =>
Double -> m (Answer, [([a], (DData, DData))])
may Double
b
    Error String
_   `f` GenericData
_          = IO (Answer, Path DData)
forall a. IO (Answer, [([a], (DData, DData))])
no
    GenericData
_         `f` Error String
_    = IO (Answer, Path DData)
forall a. IO (Answer, [([a], (DData, DData))])
no
    GenericData
_         `f` GenericData
_         | a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
/= b -> Constr
forall a. Data a => a -> Constr
toConstr b
y 
                             = IO (Answer, Path DData)
forall a. IO (Answer, [([a], (DData, DData))])
no
    GenericData
_         `f` GenericData
_          = do

        [(Answer, Path DData)]
r <- [IO (Answer, Path DData)] -> IO [(Answer, Path DData)]
forall a. [IO a] -> IO [a]
manyParallel 
              [ Int
-> (forall d. Data d => d -> IO (Answer, Path DData))
-> b
-> IO (Answer, Path DData)
forall a u. Data a => Int -> (forall d. Data d => d -> u) -> a -> u
gmapQi Int
i (Int
-> (forall d. Data d => d -> d -> IO (Answer, Path DData))
-> a
-> d
-> IO (Answer, Path DData)
forall a u. Data a => Int -> (forall d. Data d => d -> u) -> a -> u
gmapQi Int
i (Int -> d -> d -> IO (Answer, Path DData)
forall a b.
(Data a, Data b) =>
Int -> a -> b -> IO (Answer, Path DData)
decideEquality' Int
i) a
x) b
y | Int
i <- [Int
0..a -> Int
forall a. Data a => a -> Int
arity a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        case [(Answer, Path DData)]
r of
            [] -> IO (Answer, Path DData)
forall a. IO (Answer, [([a], (DData, DData))])
yes
            [(Answer, Path DData)]
xs -> (Answer, Path DData) -> IO (Answer, Path DData)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Answer, Path DData) -> IO (Answer, Path DData))
-> (Answer, Path DData) -> IO (Answer, Path DData)
forall a b. (a -> b) -> a -> b
$ ((Answer, Path DData) -> (Answer, Path DData) -> Ordering)
-> [(Answer, Path DData)] -> (Answer, Path DData)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Answer, Path DData) -> Answer)
-> (Answer, Path DData) -> (Answer, Path DData) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Answer, Path DData) -> Answer
forall a b. (a, b) -> a
fst) [(Answer, Path DData)]
xs

    pair :: (DData, DData)
pair = (a -> DData
forall a. Data a => a -> DData
DData a
x, b -> DData
forall a. Data a => a -> DData
DData b
y)

    yes :: IO (Answer, [([a], (DData, DData))])
yes   = (Answer, [([a], (DData, DData))])
-> IO (Answer, [([a], (DData, DData))])
forall (m :: * -> *) a. Monad m => a -> m a
return (Answer
Yes, [([], (DData, DData)
pair)])
    may :: Double -> m (Answer, [([a], (DData, DData))])
may Double
z = (Answer, [([a], (DData, DData))])
-> m (Answer, [([a], (DData, DData))])
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Answer
Maybe Double
z, [([], (DData, DData)
pair)])
    no :: IO (Answer, [([a], (DData, DData))])
no    = IO ()
stop IO ()
-> IO (Answer, [([a], (DData, DData))])
-> IO (Answer, [([a], (DData, DData))])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Answer, [([a], (DData, DData))])
-> IO (Answer, [([a], (DData, DData))])
forall (m :: * -> *) a. Monad m => a -> m a
return (Answer
No, [([], (DData, DData)
pair)])
      where
        stop :: IO ()
stop = Budget -> (Int -> (Int, ())) -> IO ()
forall a. Budget -> (Int -> (Int, a)) -> IO a
decSizeBudget Budget
budget ((Int -> (Int, ())) -> IO ()) -> (Int -> (Int, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int, ()) -> Int -> (Int, ())
forall a b. a -> b -> a
const (-Int
1,())

    decideEquality' :: Int -> a -> b -> IO (Answer, Path DData)
decideEquality' Int
i a
x b
y = do
        (Answer
ans, Path DData
ps) <- Budget -> a -> b -> IO (Answer, Path DData)
forall a b.
(Data a, Data b) =>
Budget -> a -> b -> IO (Answer, Path DData)
decideEquality Budget
budget a
x b
y
        (Answer, Path DData) -> IO (Answer, Path DData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Answer
ans, ([Int
i], (DData, DData)
pair)([Int], (DData, DData)) -> Path DData -> Path DData
forall a. a -> [a] -> [a]
:Path DData
ps)