{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
# if MIN_VERSION_GLASGOW_HASKELL(8, 6, 1, 0)
{-# LANGUAGE QuantifiedConstraints #-}
# else
{-# LANGUAGE DataKinds #-}
# endif
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Generics.Traversable.Generic where
import Data.Generics.Traversable
import GHC.Generics
# if MIN_VERSION_GLASGOW_HASKELL(8, 6, 1, 0)
# else
import GHC.TypeLits (TypeError, ErrorMessage (..))
# endif
class GTraversable' c (f :: * -> *) where
gtraverse' :: Applicative g => (forall d. c d => d -> g d) -> (forall p. f p -> g (f p))
instance GTraversable' c U1 where
gtraverse' :: (forall d. c d => d -> g d) -> forall p. U1 p -> g (U1 p)
gtraverse' forall d. c d => d -> g d
_f U1 p
U1 = U1 p -> g (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
instance GTraversable' c V1 where
gtraverse' :: (forall d. c d => d -> g d) -> forall p. V1 p -> g (V1 p)
gtraverse' forall d. c d => d -> g d
_f = [Char] -> V1 p -> g (V1 p)
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible"
instance GTraversable' c Par1 where
gtraverse' :: (forall d. c d => d -> g d) -> forall p. Par1 p -> g (Par1 p)
gtraverse' forall d. c d => d -> g d
_f Par1 p
par1 = Par1 p -> g (Par1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Par1 p
par1
# if MIN_VERSION_GLASGOW_HASKELL(8, 6, 1, 0)
instance (forall p. GTraversable c (f p)) => GTraversable' c (Rec1 f) where
gtraverse' :: (forall d. c d => d -> g d) -> forall p. Rec1 f p -> g (Rec1 f p)
gtraverse' forall d. c d => d -> g d
f (Rec1 f p
recur) = f p -> Rec1 f p
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f p -> Rec1 f p) -> g (f p) -> g (Rec1 f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> g d) -> f p -> g (f p)
forall (c :: * -> Constraint) a (f :: * -> *).
(GTraversable c a, Applicative f) =>
(forall d. c d => d -> f d) -> a -> f a
gtraverse @c forall d. c d => d -> g d
f f p
recur
# else
instance
( TypeError
( 'Text "No generic instance can be derived for " ':$$: 'ShowType f ':$$:
'Text " for this GHC version - upgrade to at least 8.6.1 to be" ':$$:
'Text " able to use `GTraversable` from `Generic` here"
)
)
=> GTraversable' c (Rec1 f) where
gtraverse' _ _ = error "Cannot implement `gtraverse'` for this type"
# endif
instance (c con) => GTraversable' c (K1 i con) where
gtraverse' :: (forall d. c d => d -> g d)
-> forall p. K1 i con p -> g (K1 i con p)
gtraverse' forall d. c d => d -> g d
f (K1 con
con) = con -> K1 i con p
forall k i c (p :: k). c -> K1 i c p
K1 (con -> K1 i con p) -> g con -> g (K1 i con p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> con -> g con
forall d. c d => d -> g d
f con
con
instance (GTraversable' c f) => GTraversable' c (M1 i meta f) where
gtraverse' :: (forall d. c d => d -> g d)
-> forall p. M1 i meta f p -> g (M1 i meta f p)
gtraverse' forall d. c d => d -> g d
f (M1 f p
inner) = f p -> M1 i meta f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 i meta f p) -> g (f p) -> g (M1 i meta f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> g d) -> f p -> g (f p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f f p
inner
instance (GTraversable' c f, GTraversable' c g) => GTraversable' c (f :+: g) where
gtraverse' :: (forall d. c d => d -> g d)
-> forall p. (:+:) f g p -> g ((:+:) f g p)
gtraverse' forall d. c d => d -> g d
f (L1 f p
val) = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f p -> (:+:) f g p) -> g (f p) -> g ((:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> g d) -> f p -> g (f p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f f p
val
gtraverse' forall d. c d => d -> g d
f (R1 g p
val) = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g p -> (:+:) f g p) -> g (g p) -> g ((:+:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> g d) -> g p -> g (g p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f g p
val
instance (GTraversable' c f, GTraversable' c g) => GTraversable' c (f :*: g) where
gtraverse' :: (forall d. c d => d -> g d)
-> forall p. (:*:) f g p -> g ((:*:) f g p)
gtraverse' forall d. c d => d -> g d
f (f p
left :*: g p
right)
= f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f p -> g p -> (:*:) f g p) -> g (f p) -> g (g p -> (:*:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> g d) -> f p -> g (f p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f f p
left g (g p -> (:*:) f g p) -> g (g p) -> g ((:*:) f g p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall d. c d => d -> g d) -> g p -> g (g p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f g p
right
instance (Traversable f, GTraversable' c g) => GTraversable' c (f :.: g) where
gtraverse' :: (forall d. c d => d -> g d)
-> forall p. (:.:) f g p -> g ((:.:) f g p)
gtraverse' forall d. c d => d -> g d
f (Comp1 f (g p)
comp) = f (g p) -> (:.:) f g p
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g p) -> (:.:) f g p) -> g (f (g p)) -> g ((:.:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g p -> g (g p)) -> f (g p) -> g (f (g p))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall d. c d => d -> g d) -> forall p. g p -> g (g p)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> g d
f) f (g p)
comp
instance
{-# OVERLAPPABLE #-}
(Generic a, GTraversable' c (Rep a))
=> GTraversable c a
where
gtraverse :: (forall d. c d => d -> f d) -> a -> f a
gtraverse forall d. c d => d -> f d
f a
val
= Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> f (Rep a Any) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. c d => d -> f d) -> Rep a Any -> f (Rep a Any)
forall (c :: * -> Constraint) (f :: * -> *) (g :: * -> *).
(GTraversable' c f, Applicative g) =>
(forall d. c d => d -> g d) -> forall p. f p -> g (f p)
gtraverse' @c forall d. c d => d -> f d
f (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
val)