{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE PolyKinds #-}
#endif

#if __GLASGOW_HASKELL__ < 709
{-# LANGUAGE OverlappingInstances #-}
#endif

{- |
Module      :  Generics.Deriving.Uniplate
Copyright   :  2011-2012 Universiteit Utrecht, University of Oxford
License     :  BSD3

Maintainer  :  generics@haskell.org
Stability   :  experimental
Portability :  non-portable

Summary: Functions inspired by the Uniplate generic programming library,
mostly implemented by Sean Leather.
-}

module Generics.Deriving.Uniplate (
  -- * Generic Uniplate class
    Uniplate(..)

  -- * Derived functions
  , uniplate
  , universe
  , rewrite
  , rewriteM
  , contexts
  , holes
  , para

  -- * Default definitions
  , childrendefault
  , contextdefault
  , descenddefault
  , descendMdefault
  , transformdefault
  , transformMdefault

  -- * Internal Uniplate class
  , Uniplate'(..)

  -- * Internal Context class
  , Context'(..)
  ) where


import Generics.Deriving.Base

import Control.Monad (liftM, liftM2)
import GHC.Exts (build)

--------------------------------------------------------------------------------
-- Generic Uniplate
--------------------------------------------------------------------------------

class Uniplate' f b where
  children'  :: f a -> [b]
  descend'   :: (b -> b) -> f a -> f a
  descendM'  :: Monad m => (b -> m b) -> f a -> m (f a)
  transform' :: (b -> b) -> f a -> f a
  transformM'  :: Monad m => (b -> m b) -> f a -> m (f a)

instance Uniplate' U1 a where
  children' :: forall (a :: k). U1 a -> [a]
children' U1 a
U1 = []
  descend' :: forall (a :: k). (a -> a) -> U1 a -> U1 a
descend' a -> a
_ U1 a
U1 = forall k (p :: k). U1 p
U1
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(a -> m a) -> U1 a -> m (U1 a)
descendM' a -> m a
_ U1 a
U1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall k (p :: k). U1 p
U1
  transform' :: forall (a :: k). (a -> a) -> U1 a -> U1 a
transform' a -> a
_ U1 a
U1 = forall k (p :: k). U1 p
U1
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(a -> m a) -> U1 a -> m (U1 a)
transformM' a -> m a
_ U1 a
U1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall k (p :: k). U1 p
U1

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPING #-}
#endif
    (Uniplate a) => Uniplate' (K1 i a) a where
  children' :: forall (a :: k). K1 i a a -> [a]
children' (K1 a
a) = [a
a]
  descend' :: forall (a :: k). (a -> a) -> K1 i a a -> K1 i a a
descend' a -> a
f (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 (a -> a
f a
a)
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(a -> m a) -> K1 i a a -> m (K1 i a a)
descendM' a -> m a
f (K1 a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k i c (p :: k). c -> K1 i c p
K1 (a -> m a
f a
a)
  transform' :: forall (a :: k). (a -> a) -> K1 i a a -> K1 i a a
transform' a -> a
f (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 (forall a. Uniplate a => (a -> a) -> a -> a
transform a -> a
f a
a)
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(a -> m a) -> K1 i a a -> m (K1 i a a)
transformM' a -> m a
f (K1 a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k i c (p :: k). c -> K1 i c p
K1 (forall a (m :: * -> *).
(Uniplate a, Monad m) =>
(a -> m a) -> a -> m a
transformM a -> m a
f a
a)

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPABLE #-}
#endif
    Uniplate' (K1 i a) b where
  children' :: forall (a :: k). K1 i a a -> [b]
children' (K1 a
_) = []
  descend' :: forall (a :: k). (b -> b) -> K1 i a a -> K1 i a a
descend' b -> b
_ (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 a
a
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> K1 i a a -> m (K1 i a a)
descendM' b -> m b
_ (K1 a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall k i c (p :: k). c -> K1 i c p
K1 a
a)
  transform' :: forall (a :: k). (b -> b) -> K1 i a a -> K1 i a a
transform' b -> b
_ (K1 a
a) = forall k i c (p :: k). c -> K1 i c p
K1 a
a
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> K1 i a a -> m (K1 i a a)
transformM' b -> m b
_ (K1 a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall k i c (p :: k). c -> K1 i c p
K1 a
a)

instance (Uniplate' f b) => Uniplate' (M1 i c f) b where
  children' :: forall (a :: k). M1 i c f a -> [b]
children' (M1 f a
a) = forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' f a
a
  descend' :: forall (a :: k). (b -> b) -> M1 i c f a -> M1 i c f a
descend' b -> b
f (M1 f a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' b -> b
f f a
a)
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> M1 i c f a -> m (M1 i c f a)
descendM' b -> m b
f (M1 f a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' b -> m b
f f a
a)
  transform' :: forall (a :: k). (b -> b) -> M1 i c f a -> M1 i c f a
transform' b -> b
f (M1 f a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' b -> b
f f a
a)
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> M1 i c f a -> m (M1 i c f a)
transformM' b -> m b
f (M1 f a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' b -> m b
f f a
a)

instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where
  children' :: forall (a :: k). (:+:) f g a -> [b]
children' (L1 f a
a) = forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' f a
a
  children' (R1 g a
a) = forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' g a
a
  descend' :: forall (a :: k). (b -> b) -> (:+:) f g a -> (:+:) f g a
descend' b -> b
f (L1 f a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' b -> b
f f a
a)
  descend' b -> b
f (R1 g a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' b -> b
f g a
a)
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> (:+:) f g a -> m ((:+:) f g a)
descendM' b -> m b
f (L1 f a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' b -> m b
f f a
a)
  descendM' b -> m b
f (R1 g a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' b -> m b
f g a
a)
  transform' :: forall (a :: k). (b -> b) -> (:+:) f g a -> (:+:) f g a
transform' b -> b
f (L1 f a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' b -> b
f f a
a)
  transform' b -> b
f (R1 g a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' b -> b
f g a
a)
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> (:+:) f g a -> m ((:+:) f g a)
transformM' b -> m b
f (L1 f a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' b -> m b
f f a
a)
  transformM' b -> m b
f (R1 g a
a) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' b -> m b
f g a
a)

instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where
  children' :: forall (a :: k). (:*:) f g a -> [b]
children' (f a
a :*: g a
b) = forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' f a
a forall a. [a] -> [a] -> [a]
++ forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' g a
b
  descend' :: forall (a :: k). (b -> b) -> (:*:) f g a -> (:*:) f g a
descend' b -> b
f (f a
a :*: g a
b) = forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' b -> b
f f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' b -> b
f g a
b
  descendM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> (:*:) f g a -> m ((:*:) f g a)
descendM' b -> m b
f (f a
a :*: g a
b) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' b -> m b
f f a
a) (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' b -> m b
f g a
b)
  transform' :: forall (a :: k). (b -> b) -> (:*:) f g a -> (:*:) f g a
transform' b -> b
f (f a
a :*: g a
b) = forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' b -> b
f f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' b -> b
f g a
b
  transformM' :: forall (m :: * -> *) (a :: k).
Monad m =>
(b -> m b) -> (:*:) f g a -> m ((:*:) f g a)
transformM' b -> m b
f (f a
a :*: g a
b) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' b -> m b
f f a
a) (forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' b -> m b
f g a
b)


-- Context' is a separate class from Uniplate' since it uses special product
-- instances, but the context function still appears in Uniplate.
class Context' f b where
  context' :: f a -> [b] -> f a

instance Context' U1 b where
  context' :: forall (a :: k). U1 a -> [b] -> U1 a
context' U1 a
U1 [b]
_ = forall k (p :: k). U1 p
U1

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPING #-}
#endif
    Context' (K1 i a) a where
  context' :: forall (a :: k). K1 i a a -> [a] -> K1 i a a
context' K1 i a a
_      []    = forall a. HasCallStack => [Char] -> a
error [Char]
"Generics.Deriving.Uniplate.context: empty list"
  context' (K1 a
_) (a
c:[a]
_) = forall k i c (p :: k). c -> K1 i c p
K1 a
c

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPABLE #-}
#endif
    Context' (K1 i a) b where
  context' :: forall (a :: k). K1 i a a -> [b] -> K1 i a a
context' (K1 a
a) [b]
_ = forall k i c (p :: k). c -> K1 i c p
K1 a
a

instance (Context' f b) => Context' (M1 i c f) b where
  context' :: forall (a :: k). M1 i c f a -> [b] -> M1 i c f a
context' (M1 f a
a) [b]
cs = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' f a
a [b]
cs)

instance (Context' f b, Context' g b) => Context' (f :+: g) b where
  context' :: forall (a :: k). (:+:) f g a -> [b] -> (:+:) f g a
context' (L1 f a
a) [b]
cs = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' f a
a [b]
cs)
  context' (R1 g a
a) [b]
cs = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' g a
a [b]
cs)

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPING #-}
#endif
    (Context' g a) => Context' (M1 i c (K1 j a) :*: g) a where
  context' :: forall (a :: k).
(:*:) (M1 i c (K1 j a)) g a -> [a] -> (:*:) (M1 i c (K1 j a)) g a
context' (:*:) (M1 i c (K1 j a)) g a
_                 []     = forall a. HasCallStack => [Char] -> a
error [Char]
"Generics.Deriving.Uniplate.context: empty list"
  context' (M1 (K1 a
_) :*: g a
b) (a
c:[a]
cs) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall k i c (p :: k). c -> K1 i c p
K1 a
c) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' g a
b [a]
cs

instance
#if __GLASGOW_HASKELL__ >= 709
    {-# OVERLAPPABLE #-}
#endif
    (Context' g b) => Context' (f :*: g) b where
  context' :: forall (a :: k). (:*:) f g a -> [b] -> (:*:) f g a
context' (f a
a :*: g a
b) [b]
cs = f a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' g a
b [b]
cs


class Uniplate a where
  children :: a -> [a]
#if __GLASGOW_HASKELL__ >= 701
  default children :: (Generic a, Uniplate' (Rep a) a) => a -> [a]
  children = forall a. (Generic a, Uniplate' (Rep a) a) => a -> [a]
childrendefault
#endif

  context :: a -> [a] -> a
#if __GLASGOW_HASKELL__ >= 701
  default context :: (Generic a, Context' (Rep a) a) => a -> [a] -> a
  context = forall a. (Generic a, Context' (Rep a) a) => a -> [a] -> a
contextdefault
#endif

  descend :: (a -> a) -> a -> a
#if __GLASGOW_HASKELL__ >= 701
  default descend :: (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
  descend = forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
descenddefault
#endif

  descendM :: Monad m => (a -> m a) -> a -> m a
#if __GLASGOW_HASKELL__ >= 701
  default descendM :: (Generic a, Uniplate' (Rep a) a, Monad m) => (a -> m a) -> a -> m a
  descendM = forall a (m :: * -> *).
(Generic a, Uniplate' (Rep a) a, Monad m) =>
(a -> m a) -> a -> m a
descendMdefault
#endif

  transform :: (a -> a) -> a -> a
#if __GLASGOW_HASKELL__ >= 701
  default transform :: (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
  transform = forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
transformdefault
#endif

  transformM :: Monad m => (a -> m a) -> a -> m a
#if __GLASGOW_HASKELL__ >= 701
  default transformM :: (Generic a, Uniplate' (Rep a) a, Monad m) => (a -> m a) -> a -> m a
  transformM = forall a (m :: * -> *).
(Generic a, Uniplate' (Rep a) a, Monad m) =>
(a -> m a) -> a -> m a
transformMdefault
#endif

childrendefault :: (Generic a, Uniplate' (Rep a) a) => a -> [a]
childrendefault :: forall a. (Generic a, Uniplate' (Rep a) a) => a -> [a]
childrendefault = forall {k} (f :: k -> *) b (a :: k). Uniplate' f b => f a -> [b]
children' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

contextdefault :: (Generic a, Context' (Rep a) a) => a -> [a] -> a
contextdefault :: forall a. (Generic a, Context' (Rep a) a) => a -> [a] -> a
contextdefault a
x [a]
cs = forall a x. Generic a => Rep a x -> a
to (forall {k} (f :: k -> *) b (a :: k).
Context' f b =>
f a -> [b] -> f a
context' (forall a x. Generic a => a -> Rep a x
from a
x) [a]
cs)

descenddefault :: (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
descenddefault :: forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
descenddefault a -> a
f = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
descend' a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

descendMdefault :: (Generic a, Uniplate' (Rep a) a, Monad m) => (a -> m a) -> a -> m a
descendMdefault :: forall a (m :: * -> *).
(Generic a, Uniplate' (Rep a) a, Monad m) =>
(a -> m a) -> a -> m a
descendMdefault a -> m a
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
descendM' a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

transformdefault :: (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
transformdefault :: forall a. (Generic a, Uniplate' (Rep a) a) => (a -> a) -> a -> a
transformdefault a -> a
f = a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) b (a :: k).
Uniplate' f b =>
(b -> b) -> f a -> f a
transform' a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

transformMdefault :: (Generic a, Uniplate' (Rep a) a, Monad m) => (a -> m a) -> a -> m a
transformMdefault :: forall a (m :: * -> *).
(Generic a, Uniplate' (Rep a) a, Monad m) =>
(a -> m a) -> a -> m a
transformMdefault a -> m a
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) b (m :: * -> *) (a :: k).
(Uniplate' f b, Monad m) =>
(b -> m b) -> f a -> m (f a)
transformM' a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from


-- Derived functions (mostly copied from Neil Michell's code)

uniplate :: Uniplate a => a -> ([a], [a] -> a)
uniplate :: forall a. Uniplate a => a -> ([a], [a] -> a)
uniplate a
a = (forall a. Uniplate a => a -> [a]
children a
a, forall a. Uniplate a => a -> [a] -> a
context a
a)

universe :: Uniplate a => a -> [a]
universe :: forall a. Uniplate a => a -> [a]
universe a
a = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (forall {t} {a}. Uniplate t => t -> (t -> a -> a) -> a -> a
go a
a)
  where
    go :: t -> (t -> a -> a) -> a -> a
go t
x t -> a -> a
cons a
nil = t -> a -> a
cons t
x forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) a
nil forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\t
c -> t -> (t -> a -> a) -> a -> a
go t
c t -> a -> a
cons) forall a b. (a -> b) -> a -> b
$ forall a. Uniplate a => a -> [a]
children t
x

rewrite :: Uniplate a => (a -> Maybe a) -> a -> a
rewrite :: forall a. Uniplate a => (a -> Maybe a) -> a -> a
rewrite a -> Maybe a
f = forall a. Uniplate a => (a -> a) -> a -> a
transform a -> a
g
  where
    g :: a -> a
g a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (forall a. Uniplate a => (a -> Maybe a) -> a -> a
rewrite a -> Maybe a
f) (a -> Maybe a
f a
x)

rewriteM :: (Monad m, Uniplate a) => (a -> m (Maybe a)) -> a -> m a
rewriteM :: forall (m :: * -> *) a.
(Monad m, Uniplate a) =>
(a -> m (Maybe a)) -> a -> m a
rewriteM a -> m (Maybe a)
f = forall a (m :: * -> *).
(Uniplate a, Monad m) =>
(a -> m a) -> a -> m a
transformM a -> m a
g
  where
    g :: a -> m a
g a
x = a -> m (Maybe a)
f a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return a
x) (forall (m :: * -> *) a.
(Monad m, Uniplate a) =>
(a -> m (Maybe a)) -> a -> m a
rewriteM a -> m (Maybe a)
f)

contexts :: Uniplate a => a -> [(a, a -> a)]
contexts :: forall a. Uniplate a => a -> [(a, a -> a)]
contexts a
a = (a
a, forall a. a -> a
id) forall a. a -> [a] -> [a]
: forall {b} {c}. Uniplate b => [(b, b -> c)] -> [(b, b -> c)]
f (forall a. Uniplate a => a -> [(a, a -> a)]
holes a
a)
  where
    f :: [(b, b -> c)] -> [(b, b -> c)]
f [(b, b -> c)]
xs = [ (b
ch2, b -> c
ctx1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
ctx2)
           | (b
ch1, b -> c
ctx1) <- [(b, b -> c)]
xs
           , (b
ch2, b -> b
ctx2) <- forall a. Uniplate a => a -> [(a, a -> a)]
contexts b
ch1]

holes :: Uniplate a => a -> [(a, a -> a)]
holes :: forall a. Uniplate a => a -> [(a, a -> a)]
holes a
a = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a} {c}. [a] -> ([a] -> c) -> [(a, a -> c)]
f (forall a. Uniplate a => a -> ([a], [a] -> a)
uniplate a
a)
  where
    f :: [a] -> ([a] -> c) -> [(a, a -> c)]
f []     [a] -> c
_   = []
    f (a
x:[a]
xs) [a] -> c
gen = (a
x, [a] -> c
gen forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[a]
xs)) forall a. a -> [a] -> [a]
: [a] -> ([a] -> c) -> [(a, a -> c)]
f [a]
xs ([a] -> c
gen forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:))

para :: Uniplate a => (a -> [r] -> r) -> a -> r
para :: forall a r. Uniplate a => (a -> [r] -> r) -> a -> r
para a -> [r] -> r
f a
x = a -> [r] -> r
f a
x forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a r. Uniplate a => (a -> [r] -> r) -> a -> r
para a -> [r] -> r
f) forall a b. (a -> b) -> a -> b
$ forall a. Uniplate a => a -> [a]
children a
x


-- Base types instances
instance Uniplate Bool where
  children :: Bool -> [Bool]
children Bool
_ = []
  context :: Bool -> [Bool] -> Bool
context Bool
x [Bool]
_ = Bool
x
  descend :: (Bool -> Bool) -> Bool -> Bool
descend Bool -> Bool
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *). Monad m => (Bool -> m Bool) -> Bool -> m Bool
descendM Bool -> m Bool
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Bool -> Bool) -> Bool -> Bool
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *). Monad m => (Bool -> m Bool) -> Bool -> m Bool
transformM Bool -> m Bool
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate Char where
  children :: Char -> [Char]
children Char
_ = []
  context :: Char -> [Char] -> Char
context Char
x [Char]
_ = Char
x
  descend :: (Char -> Char) -> Char -> Char
descend Char -> Char
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *). Monad m => (Char -> m Char) -> Char -> m Char
descendM Char -> m Char
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Char -> Char) -> Char -> Char
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *). Monad m => (Char -> m Char) -> Char -> m Char
transformM Char -> m Char
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate Double where
  children :: Double -> [Double]
children Double
_ = []
  context :: Double -> [Double] -> Double
context Double
x [Double]
_ = Double
x
  descend :: (Double -> Double) -> Double -> Double
descend Double -> Double
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
(Double -> m Double) -> Double -> m Double
descendM Double -> m Double
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Double -> Double) -> Double -> Double
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
(Double -> m Double) -> Double -> m Double
transformM Double -> m Double
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate Float where
  children :: Float -> [Float]
children Float
_ = []
  context :: Float -> [Float] -> Float
context Float
x [Float]
_ = Float
x
  descend :: (Float -> Float) -> Float -> Float
descend Float -> Float
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
(Float -> m Float) -> Float -> m Float
descendM Float -> m Float
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Float -> Float) -> Float -> Float
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
(Float -> m Float) -> Float -> m Float
transformM Float -> m Float
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate Int where
  children :: Int -> [Int]
children Int
_ = []
  context :: Int -> [Int] -> Int
context Int
x [Int]
_ = Int
x
  descend :: (Int -> Int) -> Int -> Int
descend Int -> Int
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *). Monad m => (Int -> m Int) -> Int -> m Int
descendM Int -> m Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Int -> Int) -> Int -> Int
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *). Monad m => (Int -> m Int) -> Int -> m Int
transformM Int -> m Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate () where
  children :: () -> [()]
children ()
_ = []
  context :: () -> [()] -> ()
context ()
x [()]
_ = ()
x
  descend :: (() -> ()) -> () -> ()
descend () -> ()
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *). Monad m => (() -> m ()) -> () -> m ()
descendM () -> m ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (() -> ()) -> () -> ()
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *). Monad m => (() -> m ()) -> () -> m ()
transformM () -> m ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return

-- Tuple instances
instance Uniplate (b,c) where
  children :: (b, c) -> [(b, c)]
children (b, c)
_ = []
  context :: (b, c) -> [(b, c)] -> (b, c)
context (b, c)
x [(b, c)]
_ = (b, c)
x
  descend :: ((b, c) -> (b, c)) -> (b, c) -> (b, c)
descend (b, c) -> (b, c)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c) -> m (b, c)) -> (b, c) -> m (b, c)
descendM (b, c) -> m (b, c)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c) -> (b, c)) -> (b, c) -> (b, c)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c) -> m (b, c)) -> (b, c) -> m (b, c)
transformM (b, c) -> m (b, c)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (b,c,d) where
  children :: (b, c, d) -> [(b, c, d)]
children (b, c, d)
_ = []
  context :: (b, c, d) -> [(b, c, d)] -> (b, c, d)
context (b, c, d)
x [(b, c, d)]
_ = (b, c, d)
x
  descend :: ((b, c, d) -> (b, c, d)) -> (b, c, d) -> (b, c, d)
descend (b, c, d) -> (b, c, d)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c, d) -> m (b, c, d)) -> (b, c, d) -> m (b, c, d)
descendM (b, c, d) -> m (b, c, d)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c, d) -> (b, c, d)) -> (b, c, d) -> (b, c, d)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c, d) -> m (b, c, d)) -> (b, c, d) -> m (b, c, d)
transformM (b, c, d) -> m (b, c, d)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (b,c,d,e) where
  children :: (b, c, d, e) -> [(b, c, d, e)]
children (b, c, d, e)
_ = []
  context :: (b, c, d, e) -> [(b, c, d, e)] -> (b, c, d, e)
context (b, c, d, e)
x [(b, c, d, e)]
_ = (b, c, d, e)
x
  descend :: ((b, c, d, e) -> (b, c, d, e)) -> (b, c, d, e) -> (b, c, d, e)
descend (b, c, d, e) -> (b, c, d, e)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e) -> m (b, c, d, e)) -> (b, c, d, e) -> m (b, c, d, e)
descendM (b, c, d, e) -> m (b, c, d, e)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c, d, e) -> (b, c, d, e)) -> (b, c, d, e) -> (b, c, d, e)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e) -> m (b, c, d, e)) -> (b, c, d, e) -> m (b, c, d, e)
transformM (b, c, d, e) -> m (b, c, d, e)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (b,c,d,e,f) where
  children :: (b, c, d, e, f) -> [(b, c, d, e, f)]
children (b, c, d, e, f)
_ = []
  context :: (b, c, d, e, f) -> [(b, c, d, e, f)] -> (b, c, d, e, f)
context (b, c, d, e, f)
x [(b, c, d, e, f)]
_ = (b, c, d, e, f)
x
  descend :: ((b, c, d, e, f) -> (b, c, d, e, f))
-> (b, c, d, e, f) -> (b, c, d, e, f)
descend (b, c, d, e, f) -> (b, c, d, e, f)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f) -> m (b, c, d, e, f))
-> (b, c, d, e, f) -> m (b, c, d, e, f)
descendM (b, c, d, e, f) -> m (b, c, d, e, f)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c, d, e, f) -> (b, c, d, e, f))
-> (b, c, d, e, f) -> (b, c, d, e, f)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f) -> m (b, c, d, e, f))
-> (b, c, d, e, f) -> m (b, c, d, e, f)
transformM (b, c, d, e, f) -> m (b, c, d, e, f)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (b,c,d,e,f,g) where
  children :: (b, c, d, e, f, g) -> [(b, c, d, e, f, g)]
children (b, c, d, e, f, g)
_ = []
  context :: (b, c, d, e, f, g) -> [(b, c, d, e, f, g)] -> (b, c, d, e, f, g)
context (b, c, d, e, f, g)
x [(b, c, d, e, f, g)]
_ = (b, c, d, e, f, g)
x
  descend :: ((b, c, d, e, f, g) -> (b, c, d, e, f, g))
-> (b, c, d, e, f, g) -> (b, c, d, e, f, g)
descend (b, c, d, e, f, g) -> (b, c, d, e, f, g)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f, g) -> m (b, c, d, e, f, g))
-> (b, c, d, e, f, g) -> m (b, c, d, e, f, g)
descendM (b, c, d, e, f, g) -> m (b, c, d, e, f, g)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c, d, e, f, g) -> (b, c, d, e, f, g))
-> (b, c, d, e, f, g) -> (b, c, d, e, f, g)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f, g) -> m (b, c, d, e, f, g))
-> (b, c, d, e, f, g) -> m (b, c, d, e, f, g)
transformM (b, c, d, e, f, g) -> m (b, c, d, e, f, g)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (b,c,d,e,f,g,h) where
  children :: (b, c, d, e, f, g, h) -> [(b, c, d, e, f, g, h)]
children (b, c, d, e, f, g, h)
_ = []
  context :: (b, c, d, e, f, g, h)
-> [(b, c, d, e, f, g, h)] -> (b, c, d, e, f, g, h)
context (b, c, d, e, f, g, h)
x [(b, c, d, e, f, g, h)]
_ = (b, c, d, e, f, g, h)
x
  descend :: ((b, c, d, e, f, g, h) -> (b, c, d, e, f, g, h))
-> (b, c, d, e, f, g, h) -> (b, c, d, e, f, g, h)
descend (b, c, d, e, f, g, h) -> (b, c, d, e, f, g, h)
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h))
-> (b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h)
descendM (b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: ((b, c, d, e, f, g, h) -> (b, c, d, e, f, g, h))
-> (b, c, d, e, f, g, h) -> (b, c, d, e, f, g, h)
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
((b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h))
-> (b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h)
transformM (b, c, d, e, f, g, h) -> m (b, c, d, e, f, g, h)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return

-- Parameterized type instances
instance Uniplate (Maybe a) where
  children :: Maybe a -> [Maybe a]
children Maybe a
_ = []
  context :: Maybe a -> [Maybe a] -> Maybe a
context Maybe a
x [Maybe a]
_ = Maybe a
x
  descend :: (Maybe a -> Maybe a) -> Maybe a -> Maybe a
descend Maybe a -> Maybe a
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
(Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
descendM Maybe a -> m (Maybe a)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Maybe a -> Maybe a) -> Maybe a -> Maybe a
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
(Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
transformM Maybe a -> m (Maybe a)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Uniplate (Either a b) where
  children :: Either a b -> [Either a b]
children Either a b
_ = []
  context :: Either a b -> [Either a b] -> Either a b
context Either a b
x [Either a b]
_ = Either a b
x
  descend :: (Either a b -> Either a b) -> Either a b -> Either a b
descend Either a b -> Either a b
_ = forall a. a -> a
id
  descendM :: forall (m :: * -> *).
Monad m =>
(Either a b -> m (Either a b)) -> Either a b -> m (Either a b)
descendM Either a b -> m (Either a b)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
  transform :: (Either a b -> Either a b) -> Either a b -> Either a b
transform = forall a. a -> a
id
  transformM :: forall (m :: * -> *).
Monad m =>
(Either a b -> m (Either a b)) -> Either a b -> m (Either a b)
transformM Either a b -> m (Either a b)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return

instance Uniplate [a] where
  children :: [a] -> [[a]]
children []    = []
  children (a
_:[a]
t) = [[a]
t]
  context :: [a] -> [[a]] -> [a]
context [a]
_     []    = forall a. HasCallStack => [Char] -> a
error [Char]
"Generics.Deriving.Uniplate.context: empty list"
  context []    [[a]]
_     = []
  context (a
h:[a]
_) ([a]
t:[[a]]
_) = a
hforall a. a -> [a] -> [a]
:[a]
t
  descend :: ([a] -> [a]) -> [a] -> [a]
descend [a] -> [a]
_ []    = []
  descend [a] -> [a]
f (a
h:[a]
t) = a
hforall a. a -> [a] -> [a]
:[a] -> [a]
f [a]
t
  descendM :: forall (m :: * -> *). Monad m => ([a] -> m [a]) -> [a] -> m [a]
descendM [a] -> m [a]
_ []    = forall (m :: * -> *) a. Monad m => a -> m a
return []
  descendM [a] -> m [a]
f (a
h:[a]
t) = [a] -> m [a]
f [a]
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
t' -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
hforall a. a -> [a] -> [a]
:[a]
t')
  transform :: ([a] -> [a]) -> [a] -> [a]
transform [a] -> [a]
f []    = [a] -> [a]
f []
  transform [a] -> [a]
f (a
h:[a]
t) = [a] -> [a]
f (a
hforall a. a -> [a] -> [a]
:forall a. Uniplate a => (a -> a) -> a -> a
transform [a] -> [a]
f [a]
t)
  transformM :: forall (m :: * -> *). Monad m => ([a] -> m [a]) -> [a] -> m [a]
transformM [a] -> m [a]
f []    = [a] -> m [a]
f []
  transformM [a] -> m [a]
f (a
h:[a]
t) = forall a (m :: * -> *).
(Uniplate a, Monad m) =>
(a -> m a) -> a -> m a
transformM [a] -> m [a]
f [a]
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
t' -> [a] -> m [a]
f (a
hforall a. a -> [a] -> [a]
:[a]
t')