{-# LANGUAGE RankNTypes, ScopedTypeVariables, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Twins
-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  generics@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (local universal quantification)
--
-- \"Scrap your boilerplate\" --- Generic programming in Haskell
-- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>. The present module
-- provides support for multi-parameter traversal, which is also
-- demonstrated with generic operations like equality.
--
-----------------------------------------------------------------------------

module Data.Generics.Twins (

        -- * Generic folds and maps that also accumulate
        gfoldlAccum,
        gmapAccumT,
        gmapAccumM,
        gmapAccumQl,
        gmapAccumQr,
        gmapAccumQ,
        gmapAccumA,

        -- * Mapping combinators for twin traversal
        gzipWithT,
        gzipWithM,
        gzipWithQ,

        -- * Typical twin traversals
        geq,
        gzip,
        gcompare

  ) where


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

#ifdef __HADDOCK__
import Prelude
#endif
import Data.Data
import Data.Generics.Aliases

#ifdef __GLASGOW_HASKELL__
import Prelude hiding ( GT )
#endif

#if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative(..))
import Data.Monoid         ( mappend, mconcat )
#endif

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


------------------------------------------------------------------------------
--
--      Generic folds and maps that also accumulate
--
------------------------------------------------------------------------------

{--------------------------------------------------------------

A list map can be elaborated to perform accumulation.
In the same sense, we can elaborate generic maps over terms.

We recall the type of map:
map :: (a -> b) -> [a] -> [b]

We recall the type of an accumulating map (see Data.List):
mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])

Applying the same scheme we obtain an accumulating gfoldl.

--------------------------------------------------------------}

-- | gfoldl with accumulation
--
-- @since 0.1.0.0
gfoldlAccum :: Data d
            => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
            -> (forall g. a -> g -> (a, c g))
            -> a -> d -> (a, c d)

gfoldlAccum :: forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum forall e r. Data e => a -> c (e -> r) -> e -> (a, c r)
k forall g. a -> g -> (a, c g)
z a
a0 d
d = A a c d -> a -> (a, c d)
forall a (c :: * -> *) d. A a c d -> a -> (a, c d)
unA ((forall d b. Data d => A a c (d -> b) -> d -> A a c b)
-> (forall g. g -> A a c g) -> d -> A a c d
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> d -> c d
gfoldl A a c (d -> b) -> d -> A a c b
forall d b. Data d => A a c (d -> b) -> d -> A a c b
k' g -> A a c g
forall g. g -> A a c g
z' d
d) a
a0
 where
  k' :: A a c (e -> d) -> e -> A a c d
k' A a c (e -> d)
c e
y = (a -> (a, c d)) -> A a c d
forall a (c :: * -> *) d. (a -> (a, c d)) -> A a c d
A (\a
a -> let (a
a', c (e -> d)
c') = A a c (e -> d) -> a -> (a, c (e -> d))
forall a (c :: * -> *) d. A a c d -> a -> (a, c d)
unA A a c (e -> d)
c a
a in a -> c (e -> d) -> e -> (a, c d)
forall e r. Data e => a -> c (e -> r) -> e -> (a, c r)
k a
a' c (e -> d)
c' e
y)
  z' :: d -> A a c d
z' d
f   = (a -> (a, c d)) -> A a c d
forall a (c :: * -> *) d. (a -> (a, c d)) -> A a c d
A (\a
a -> a -> d -> (a, c d)
forall g. a -> g -> (a, c g)
z a
a d
f)


-- | A type constructor for accumulation
newtype A a c d = A { forall a (c :: * -> *) d. A a c d -> a -> (a, c d)
unA :: a -> (a, c d) }


-- | gmapT with accumulation
--
-- @since 0.1.0.0
gmapAccumT :: Data d
           => (forall e. Data e => a -> e -> (a,e))
           -> a -> d -> (a, d)
gmapAccumT :: forall d a.
Data d =>
(forall e. Data e => a -> e -> (a, e)) -> a -> d -> (a, d)
gmapAccumT forall e. Data e => a -> e -> (a, e)
f a
a0 d
d0 = let (a
a1, ID d
d1) = (forall e r. Data e => a -> ID (e -> r) -> e -> (a, ID r))
-> (forall g. a -> g -> (a, ID g)) -> a -> d -> (a, ID d)
forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum a -> ID (e -> r) -> e -> (a, ID r)
forall e r. Data e => a -> ID (e -> r) -> e -> (a, ID r)
k a -> g -> (a, ID g)
forall g. a -> g -> (a, ID g)
forall {a} {x}. a -> x -> (a, ID x)
z a
a0 d
d0
                     in (a
a1, ID d -> d
forall x. ID x -> x
unID ID d
d1)
 where
  k :: a -> ID (t -> x) -> t -> (a, ID x)
k a
a (ID t -> x
c) t
d = let (a
a',t
d') = a -> t -> (a, t)
forall e. Data e => a -> e -> (a, e)
f a
a t
d
                  in (a
a', x -> ID x
forall x. x -> ID x
ID (t -> x
c t
d'))
  z :: a -> x -> (a, ID x)
z a
a x
x = (a
a, x -> ID x
forall x. x -> ID x
ID x
x)


-- | Applicative version
--
-- @since 0.2
gmapAccumA :: forall b d a. (Data d, Applicative a)
           => (forall e. Data e => b -> e -> (b, a e))
           -> b -> d -> (b, a d)
gmapAccumA :: forall b d (a :: * -> *).
(Data d, Applicative a) =>
(forall e. Data e => b -> e -> (b, a e)) -> b -> d -> (b, a d)
gmapAccumA forall e. Data e => b -> e -> (b, a e)
f b
a0 d
d0 = (forall e r. Data e => b -> a (e -> r) -> e -> (b, a r))
-> (forall g. b -> g -> (b, a g)) -> b -> d -> (b, a d)
forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum b -> a (e -> r) -> e -> (b, a r)
forall e r. Data e => b -> a (e -> r) -> e -> (b, a r)
k b -> g -> (b, a g)
forall g. b -> g -> (b, a g)
forall t c (a' :: * -> *). Applicative a' => t -> c -> (t, a' c)
z b
a0 d
d0
    where
      k :: forall d' e. (Data d') =>
           b -> a (d' -> e) -> d' -> (b, a e)
      k :: forall e r. Data e => b -> a (e -> r) -> e -> (b, a r)
k b
a a (d' -> e)
c d'
d = let (b
a',a d'
d') = b -> d' -> (b, a d')
forall e. Data e => b -> e -> (b, a e)
f b
a d'
d
                    c' :: a e
c' = a (d' -> e)
c a (d' -> e) -> a d' -> a e
forall a b. a (a -> b) -> a a -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a d'
d'
                in (b
a', a e
c')
      z :: forall t c a'. (Applicative a') =>
           t -> c -> (t, a' c)
      z :: forall t c (a' :: * -> *). Applicative a' => t -> c -> (t, a' c)
z t
a c
x = (t
a, c -> a' c
forall a. a -> a' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
x)


-- | gmapM with accumulation
--
-- @since 0.1.0.0
gmapAccumM :: (Data d, Monad m)
           => (forall e. Data e => a -> e -> (a, m e))
           -> a -> d -> (a, m d)
gmapAccumM :: forall d (m :: * -> *) a.
(Data d, Monad m) =>
(forall e. Data e => a -> e -> (a, m e)) -> a -> d -> (a, m d)
gmapAccumM forall e. Data e => a -> e -> (a, m e)
f = (forall e r. Data e => a -> m (e -> r) -> e -> (a, m r))
-> (forall g. a -> g -> (a, m g)) -> a -> d -> (a, m d)
forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum a -> m (e -> r) -> e -> (a, m r)
forall e r. Data e => a -> m (e -> r) -> e -> (a, m r)
k a -> g -> (a, m g)
forall g. a -> g -> (a, m g)
forall {m :: * -> *} {a} {a}. Monad m => a -> a -> (a, m a)
z
 where
  k :: a -> m (t -> b) -> t -> (a, m b)
k a
a m (t -> b)
c t
d = let (a
a',m t
d') = a -> t -> (a, m t)
forall e. Data e => a -> e -> (a, m e)
f a
a t
d
             in (a
a', m t
d' m t -> (t -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t
d'' -> m (t -> b)
c m (t -> b) -> ((t -> b) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t -> b
c' -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
c' t
d''))
  z :: a -> a -> (a, m a)
z a
a a
x = (a
a, a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)


-- | gmapQl with accumulation
--
-- @since 0.1.0.0
gmapAccumQl :: Data d
            => (r -> r' -> r)
            -> r
            -> (forall e. Data e => a -> e -> (a,r'))
            -> a -> d -> (a, r)
gmapAccumQl :: forall d r r' a.
Data d =>
(r -> r' -> r)
-> r -> (forall e. Data e => a -> e -> (a, r')) -> a -> d -> (a, r)
gmapAccumQl r -> r' -> r
o r
r0 forall e. Data e => a -> e -> (a, r')
f a
a0 d
d0 = let (a
a1, CONST r d
r1) = (forall e r.
 Data e =>
 a -> CONST r (e -> r) -> e -> (a, CONST r r))
-> (forall g. a -> g -> (a, CONST r g)) -> a -> d -> (a, CONST r d)
forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum a -> CONST r (e -> r) -> e -> (a, CONST r r)
forall e r. Data e => a -> CONST r (e -> r) -> e -> (a, CONST r r)
forall {p} {a} {a}. Data p => a -> CONST r a -> p -> (a, CONST r a)
k a -> g -> (a, CONST r g)
forall g. a -> g -> (a, CONST r g)
forall {a} {p} {a}. a -> p -> (a, CONST r a)
z a
a0 d
d0
                           in (a
a1, CONST r d -> r
forall c a. CONST c a -> c
unCONST CONST r d
r1)
 where
  k :: a -> CONST r a -> p -> (a, CONST r a)
k a
a (CONST r
c) p
d = let (a
a', r'
r) = a -> p -> (a, r')
forall e. Data e => a -> e -> (a, r')
f a
a p
d
                     in (a
a', r -> CONST r a
forall c a. c -> CONST c a
CONST (r
c r -> r' -> r
`o` r'
r))
  z :: a -> p -> (a, CONST r a)
z a
a p
_ = (a
a, r -> CONST r a
forall c a. c -> CONST c a
CONST r
r0)


-- | gmapQr with accumulation
--
-- @since 0.1.0.0
gmapAccumQr :: Data d
            => (r' -> r -> r)
            -> r
            -> (forall e. Data e => a -> e -> (a,r'))
            -> a -> d -> (a, r)
gmapAccumQr :: forall d r' r a.
Data d =>
(r' -> r -> r)
-> r -> (forall e. Data e => a -> e -> (a, r')) -> a -> d -> (a, r)
gmapAccumQr r' -> r -> r
o r
r0 forall e. Data e => a -> e -> (a, r')
f a
a0 d
d0 = let (a
a1, Qr r d
l) = (forall e r. Data e => a -> Qr r (e -> r) -> e -> (a, Qr r r))
-> (forall g. a -> g -> (a, Qr r g)) -> a -> d -> (a, Qr r d)
forall d a (c :: * -> *).
Data d =>
(forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
-> (forall g. a -> g -> (a, c g)) -> a -> d -> (a, c d)
gfoldlAccum a -> Qr r (e -> r) -> e -> (a, Qr r r)
forall e r. Data e => a -> Qr r (e -> r) -> e -> (a, Qr r r)
forall {p} {a} {a}. Data p => a -> Qr r a -> p -> (a, Qr r a)
k a -> g -> (a, Qr r g)
forall g. a -> g -> (a, Qr r g)
forall {a} {p} {r} {a}. a -> p -> (a, Qr r a)
z a
a0 d
d0
                           in (a
a1, Qr r d -> r -> r
forall r a. Qr r a -> r -> r
unQr Qr r d
l r
r0)
 where
  k :: a -> Qr r a -> p -> (a, Qr r a)
k a
a (Qr r -> r
c) p
d = let (a
a',r'
r') = a -> p -> (a, r')
forall e. Data e => a -> e -> (a, r')
f a
a p
d
                  in (a
a', (r -> r) -> Qr r a
forall r a. (r -> r) -> Qr r a
Qr (\r
r -> r -> r
c (r'
r' r' -> r -> r
`o` r
r)))
  z :: a -> p -> (a, Qr r a)
z a
a p
_ = (a
a, (r -> r) -> Qr r a
forall r a. (r -> r) -> Qr r a
Qr r -> r
forall a. a -> a
id)


-- | gmapQ with accumulation
--
-- @since 0.1.0.0
gmapAccumQ :: Data d
           => (forall e. Data e => a -> e -> (a,q))
           -> a -> d -> (a, [q])
gmapAccumQ :: forall d a q.
Data d =>
(forall e. Data e => a -> e -> (a, q)) -> a -> d -> (a, [q])
gmapAccumQ forall e. Data e => a -> e -> (a, q)
f = (q -> [q] -> [q])
-> [q]
-> (forall e. Data e => a -> e -> (a, q))
-> a
-> d
-> (a, [q])
forall d r' r a.
Data d =>
(r' -> r -> r)
-> r -> (forall e. Data e => a -> e -> (a, r')) -> a -> d -> (a, r)
gmapAccumQr (:) [] a -> e -> (a, q)
forall e. Data e => a -> e -> (a, q)
f



------------------------------------------------------------------------------
--
--      Helper type constructors
--
------------------------------------------------------------------------------


-- | The identity type constructor needed for the definition of gmapAccumT
newtype ID x = ID { forall x. ID x -> x
unID :: x }


-- | The constant type constructor needed for the definition of gmapAccumQl
newtype CONST c a = CONST { forall c a. CONST c a -> c
unCONST :: c }


-- | The type constructor needed for the definition of gmapAccumQr
newtype Qr r a = Qr { forall r a. Qr r a -> r -> r
unQr  :: r -> r }



------------------------------------------------------------------------------
--
--      Mapping combinators for twin traversal
--
------------------------------------------------------------------------------


-- | Twin map for transformation
--
-- @since 0.1.0.0
gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
gzipWithT :: GenericQ GenericT -> GenericQ GenericT
gzipWithT GenericQ GenericT
f a
x a
y = case (forall e. Data e => [GenericT'] -> e -> ([GenericT'], e))
-> [GenericT'] -> a -> ([GenericT'], a)
forall d a.
Data d =>
(forall e. Data e => a -> e -> (a, e)) -> a -> d -> (a, d)
gmapAccumT [GenericT'] -> e -> ([GenericT'], e)
forall e. Data e => [GenericT'] -> e -> ([GenericT'], e)
perkid [GenericT']
funs a
y of
                    ([], a
c) -> a
c
                    ([GenericT'], a)
_       -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"gzipWithT"
 where
  perkid :: [GenericT'] -> b -> ([GenericT'], b)
perkid [GenericT']
a b
d = ([GenericT'] -> [GenericT']
forall a. HasCallStack => [a] -> [a]
tail [GenericT']
a, GenericT' -> GenericT
unGT ([GenericT'] -> GenericT'
forall a. HasCallStack => [a] -> a
head [GenericT']
a) b
d)
  funs :: [GenericT']
funs = (forall d. Data d => d -> GenericT') -> a -> [GenericT']
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ (\d
k -> GenericT -> GenericT'
GT (d -> GenericT
GenericQ GenericT
f d
k)) a
x



-- | Twin map for monadic transformation
--
-- @since 0.1.0.0
gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM :: forall (m :: * -> *).
Monad m =>
GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM GenericQ (GenericM m)
f a
x a
y = case (forall e. Data e => [GenericM' m] -> e -> ([GenericM' m], m e))
-> [GenericM' m] -> a -> ([GenericM' m], m a)
forall d (m :: * -> *) a.
(Data d, Monad m) =>
(forall e. Data e => a -> e -> (a, m e)) -> a -> d -> (a, m d)
gmapAccumM [GenericM' m] -> e -> ([GenericM' m], m e)
forall e. Data e => [GenericM' m] -> e -> ([GenericM' m], m e)
forall {a} {m :: * -> *}.
Data a =>
[GenericM' m] -> a -> ([GenericM' m], m a)
perkid [GenericM' m]
funs a
y of
                    ([], m a
c) -> m a
c
                    ([GenericM' m], m a)
_       -> [Char] -> m a
forall a. HasCallStack => [Char] -> a
error [Char]
"gzipWithM"
 where
  perkid :: [GenericM' m] -> a -> ([GenericM' m], m a)
perkid [GenericM' m]
a a
d = ([GenericM' m] -> [GenericM' m]
forall a. HasCallStack => [a] -> [a]
tail [GenericM' m]
a, GenericM' m -> GenericM m
forall (m :: * -> *). GenericM' m -> GenericM m
unGM ([GenericM' m] -> GenericM' m
forall a. HasCallStack => [a] -> a
head [GenericM' m]
a) a
d)
  funs :: [GenericM' m]
funs = (forall d. Data d => d -> GenericM' m) -> a -> [GenericM' m]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ (\d
k -> GenericM m -> GenericM' m
forall (m :: * -> *). GenericM m -> GenericM' m
GM (d -> GenericM m
GenericQ (GenericM m)
f d
k)) a
x


-- | Twin map for queries
--
-- @since 0.1.0.0
gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ :: forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ GenericQ (GenericQ r)
f a
x a
y = case (forall e. Data e => [GenericQ' r] -> e -> ([GenericQ' r], r))
-> [GenericQ' r] -> a -> ([GenericQ' r], [r])
forall d a q.
Data d =>
(forall e. Data e => a -> e -> (a, q)) -> a -> d -> (a, [q])
gmapAccumQ [GenericQ' r] -> e -> ([GenericQ' r], r)
forall e. Data e => [GenericQ' r] -> e -> ([GenericQ' r], r)
forall {a} {b}. Data a => [GenericQ' b] -> a -> ([GenericQ' b], b)
perkid [GenericQ' r]
funs a
y of
                   ([], [r]
r) -> [r]
r
                   ([GenericQ' r], [r])
_       -> [Char] -> [r]
forall a. HasCallStack => [Char] -> a
error [Char]
"gzipWithQ"
 where
  perkid :: [GenericQ' b] -> a -> ([GenericQ' b], b)
perkid [GenericQ' b]
a a
d = ([GenericQ' b] -> [GenericQ' b]
forall a. HasCallStack => [a] -> [a]
tail [GenericQ' b]
a, GenericQ' b -> GenericQ b
forall r. GenericQ' r -> GenericQ r
unGQ ([GenericQ' b] -> GenericQ' b
forall a. HasCallStack => [a] -> a
head [GenericQ' b]
a) a
d)
  funs :: [GenericQ' r]
funs = (forall d. Data d => d -> GenericQ' r) -> a -> [GenericQ' r]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
forall u. (forall d. Data d => d -> u) -> a -> [u]
gmapQ (\d
k -> GenericQ r -> GenericQ' r
forall r. GenericQ r -> GenericQ' r
GQ (d -> GenericQ r
GenericQ (GenericQ r)
f d
k)) a
x



------------------------------------------------------------------------------
--
--      Typical twin traversals
--
------------------------------------------------------------------------------

-- | Generic equality: an alternative to \"deriving Eq\"
--
-- @since 0.1.0.0
geq :: Data a => a -> a -> Bool

{-

Testing for equality of two terms goes like this. Firstly, we
establish the equality of the two top-level datatype
constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
to compare the two lists of immediate subterms.

(Note for the experts: the type of the worker geq' is rather general
but precision is recovered via the restrictive type of the top-level
operation geq. The imprecision of geq' is caused by the type system's
unability to express the type equivalence for the corresponding
couples of immediate subterms from the two given input terms.)

-}

geq :: forall a. Data a => a -> a -> Bool
geq a
x0 a
y0 = a -> GenericQ Bool
GenericQ (GenericQ Bool)
geq' a
x0 a
y0
  where
    geq' :: GenericQ (GenericQ Bool)
    geq' :: GenericQ (GenericQ Bool)
geq' a
x a
y =     (a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Constr
forall a. Data a => a -> Constr
toConstr a
y)
                Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (GenericQ (GenericQ Bool) -> GenericQ (GenericQ [Bool])
forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ a -> a -> Bool
a -> GenericQ Bool
GenericQ (GenericQ Bool)
geq' a
x a
y)


-- | Generic zip controlled by a function with type-specific branches
--
-- @since 0.1.0.0
gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
-- See testsuite/.../Generics/gzip.hs for an illustration
gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
gzip GenericQ (GenericM Maybe)
f = a -> a -> Maybe a
a -> GenericM Maybe
GenericQ (GenericM Maybe)
go
  where
    go :: GenericQ (GenericM Maybe)
    go :: GenericQ (GenericM Maybe)
go a
x a
y =
      a -> GenericM Maybe
GenericQ (GenericM Maybe)
f a
x a
y
      Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
`orElse`
      if a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Constr
forall a. Data a => a -> Constr
toConstr a
y
        then GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
forall (m :: * -> *).
Monad m =>
GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM a -> a -> Maybe a
a -> GenericM Maybe
GenericQ (GenericM Maybe)
go a
x a
y
        else Maybe a
forall a. Maybe a
Nothing

-- | Generic comparison: an alternative to \"deriving Ord\"
--
-- @since 0.5
gcompare :: Data a => a -> a -> Ordering
gcompare :: forall a. Data a => a -> a -> Ordering
gcompare = a -> a -> Ordering
forall a b. (Data a, Data b) => a -> b -> Ordering
gcompare'
  where
    gcompare' :: (Data a, Data b) => a -> b -> Ordering
    gcompare' :: forall a b. (Data a, Data b) => a -> b -> Ordering
gcompare' a
x b
y
      = let repX :: ConstrRep
repX = Constr -> ConstrRep
constrRep (Constr -> ConstrRep) -> Constr -> ConstrRep
forall a b. (a -> b) -> a -> b
$ a -> Constr
forall a. Data a => a -> Constr
toConstr a
x
            repY :: ConstrRep
repY = Constr -> ConstrRep
constrRep (Constr -> ConstrRep) -> Constr -> ConstrRep
forall a b. (a -> b) -> a -> b
$ b -> Constr
forall a. Data a => a -> Constr
toConstr b
y
        in
        case (ConstrRep
repX, ConstrRep
repY) of
          (AlgConstr ConIndex
nX,   AlgConstr ConIndex
nY)   ->
            ConIndex
nX ConIndex -> ConIndex -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ConIndex
nY Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat (GenericQ (GenericQ Ordering) -> GenericQ (GenericQ [Ordering])
forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ (\a
a -> a -> a -> Ordering
forall a b. (Data a, Data b) => a -> b -> Ordering
gcompare' a
a) a
x b
y)
          (IntConstr Integer
iX,   IntConstr Integer
iY)   -> Integer
iX Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
iY
          (FloatConstr Rational
rX, FloatConstr Rational
rY) -> Rational
rX Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Rational
rY
          (CharConstr Char
cX,  CharConstr Char
cY)  -> Char
cX Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Char
cY
          (ConstrRep, ConstrRep)
_ -> [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"type incompatibility in gcompare"