{-# LANGUAGE RankNTypes, ScopedTypeVariables, CPP #-}
module Data.Generics.Twins (
gfoldlAccum,
gmapAccumT,
gmapAccumM,
gmapAccumQl,
gmapAccumQr,
gmapAccumQ,
gmapAccumA,
gzipWithT,
gzipWithM,
gzipWithQ,
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
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 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
gfoldl forall d b. Data d => A a c (d -> b) -> d -> A a c b
k' 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)
newtype A a c d = A { A a c d -> a -> (a, c d)
unA :: a -> (a, c d) }
gmapAccumT :: Data d
=> (forall e. Data e => a -> e -> (a,e))
-> a -> d -> (a, d)
gmapAccumT :: (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 forall e r. Data e => a -> ID (e -> r) -> e -> (a, ID r)
k 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)
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)) -> 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 forall e r. Data e => b -> a (e -> r) -> e -> (b, a r)
k 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 :: b -> a (d' -> e) -> d' -> (b, a e)
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 (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 :: t -> c -> (t, a' c)
z t
a c
x = (t
a, c -> a' c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
x)
gmapAccumM :: (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)) -> 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 forall e r. Data e => a -> m (e -> r) -> e -> (a, m r)
k 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t -> b
c' -> b -> m b
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 (m :: * -> *) a. Monad m => a -> m a
return a
x)
gmapAccumQl :: Data d
=> (r -> r' -> r)
-> r
-> (forall e. Data e => a -> e -> (a,r'))
-> a -> d -> (a, r)
gmapAccumQl :: (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 forall e r. Data e => a -> CONST r (e -> r) -> e -> (a, CONST r r)
forall e a a. Data e => a -> CONST r a -> e -> (a, CONST r a)
k 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 -> e -> (a, CONST r a)
k a
a (CONST r
c) e
d = let (a
a', r'
r) = a -> e -> (a, r')
forall e. Data e => a -> e -> (a, r')
f a
a e
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)
gmapAccumQr :: Data d
=> (r' -> r -> r)
-> r
-> (forall e. Data e => a -> e -> (a,r'))
-> a -> d -> (a, r)
gmapAccumQr :: (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 forall e r. Data e => a -> Qr r (e -> r) -> e -> (a, Qr r r)
forall e a a. Data e => a -> Qr r a -> e -> (a, Qr r a)
k 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 -> e -> (a, Qr r a)
k a
a (Qr r -> r
c) e
d = let (a
a',r'
r') = a -> e -> (a, r')
forall e. Data e => a -> e -> (a, r')
f a
a e
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)
gmapAccumQ :: Data d
=> (forall e. Data e => a -> e -> (a,q))
-> a -> d -> (a, [q])
gmapAccumQ :: (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 (:) [] forall e. Data e => a -> e -> (a, q)
f
newtype ID x = ID { ID x -> x
unID :: x }
newtype CONST c a = CONST { CONST c a -> c
unCONST :: c }
newtype Qr r a = Qr { Qr r a -> r -> r
unQr :: r -> r }
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 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. [a] -> [a]
tail [GenericT']
a, GenericT' -> b -> b
GenericT' -> GenericT
unGT ([GenericT'] -> GenericT'
forall a. [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]
gmapQ (\d
k -> GenericT -> GenericT'
GT (d -> GenericT
GenericQ GenericT
f d
k)) a
x
gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM :: 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 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. [a] -> [a]
tail [GenericM' m]
a, GenericM' m -> a -> m a
forall (m :: * -> *). GenericM' m -> forall a. Data a => a -> m a
unGM ([GenericM' m] -> GenericM' m
forall a. [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]
gmapQ (\d
k -> GenericM m -> GenericM' m
forall (m :: * -> *). (forall a. Data a => a -> m a) -> GenericM' m
GM (d -> GenericM m
GenericQ (GenericM m)
f d
k)) a
x
gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ :: 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 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. [a] -> [a]
tail [GenericQ' b]
a, GenericQ' b -> a -> b
forall r. GenericQ' r -> forall a. Data a => a -> r
unGQ ([GenericQ' b] -> GenericQ' b
forall a. [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]
gmapQ (\d
k -> GenericQ r -> GenericQ' r
forall r. (forall a. Data a => a -> r) -> GenericQ' r
GQ (d -> GenericQ r
GenericQ (GenericQ r)
f d
k)) a
x
geq :: Data a => a -> a -> Bool
geq :: a -> a -> Bool
geq a
x0 a
y0 = a -> a -> Bool
GenericQ (GenericQ Bool)
geq' a
x0 a
y0
where
geq' :: GenericQ (GenericQ Bool)
geq' :: a -> 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) -> a -> a -> [Bool]
forall r. GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
gzipWithQ GenericQ (GenericQ Bool)
geq' a
x a
y)
gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
gzip GenericQ (GenericM Maybe)
f = a -> a -> Maybe a
GenericQ (GenericM Maybe)
go
where
go :: GenericQ (GenericM Maybe)
go :: a -> GenericM Maybe
go a
x a
y =
a -> a -> Maybe a
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) -> a -> a -> Maybe a
forall (m :: * -> *).
Monad m =>
GenericQ (GenericM m) -> GenericQ (GenericM m)
gzipWithM GenericQ (GenericM Maybe)
go a
x a
y
else Maybe a
forall a. Maybe a
Nothing
gcompare :: Data a => a -> a -> Ordering
gcompare :: 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' :: 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) -> a -> b -> [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"