    {-# LANGUAGE RankNTypes, ScopedTypeVariables, CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Generics.Schemes
    -- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
    -- 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 frequently used generic traversal schemes.
    --
    -----------------------------------------------------------------------------

    module Data.Generics.Schemes (

            everywhere,
            everywhere',
            everywhereBut,
            everywhereM,
            somewhere,
            everything,
            everythingBut,
            everythingWithContext,
            listify,
            something,
            synthesize,
            gsize,
            glength,
            gdepth,
            gcount,
            gnodecount,
            gtypecount,
            gfindtype

     ) where

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

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

    -- | Apply a transformation everywhere in bottom-up manner

    everywhere :: (forall a. Data a => a -> a)
               -> (forall a. Data a => a -> a)

    -- Use gmapT to recurse into immediate subterms;
    -- recall: gmapT preserves the outermost constructor;
    -- post-process recursively transformed result via f
    --
    everywhere :: (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere f :: forall a. Data a => a -> a
    f = a -> a
    forall a. Data a => a -> a
    go
      where
        go :: forall a. Data a => a -> a
        go :: a -> a
    go = a -> a
    forall a. Data a => a -> a
    f (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall a. Data a => a -> a) -> a -> a
    forall a. Data a => (forall a. Data a => a -> a) -> a -> a
    gmapT forall a. Data a => a -> a
    go

    -- | Apply a transformation everywhere in top-down manner
    everywhere' :: (forall a. Data a => a -> a)
                -> (forall a. Data a => a -> a)

    -- Arguments of (.) are flipped compared to everywhere
    everywhere' :: (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere' f :: forall a. Data a => a -> a
    f = a -> a
    forall a. Data a => a -> a
    go
      where
        go :: forall a. Data a => a -> a
        go :: a -> a
    go = (forall a. Data a => a -> a) -> a -> a
    forall a. Data a => (forall a. Data a => a -> a) -> a -> a
    gmapT forall a. Data a => a -> a
    go (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    forall a. Data a => a -> a
    f

    -- | Variation on everywhere with an extra stop condition
    everywhereBut :: GenericQ Bool -> GenericT -> GenericT

    -- Guarded to let traversal cease if predicate q holds for x
    everywhereBut :: GenericQ Bool
    -> (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhereBut q :: GenericQ Bool
    q f :: forall a. Data a => a -> a
    f = a -> a
    forall a. Data a => a -> a
    go
      where
        go :: GenericT
        go :: a -> a
    go x :: a
    x
          | a -> Bool
    GenericQ Bool
    q a
    x       = a
    x
          | Bool
    otherwise = a -> a
    forall a. Data a => a -> a
    f ((forall a. Data a => a -> a) -> a -> a
    forall a. Data a => (forall a. Data a => a -> a) -> a -> a
    gmapT forall a. Data a => a -> a
    go a
    x)

    -- | Monadic variation on everywhere
    everywhereM :: forall m. Monad m => GenericM m -> GenericM m

    -- Bottom-up order is also reflected in order of do-actions
    everywhereM :: GenericM m -> GenericM m
    everywhereM f :: GenericM m
    f = a -> m a
    GenericM m
    go
      where
        go :: GenericM m
        go :: a -> m a
    go x :: a
    x = do
          a
    x' <- GenericM m -> a -> m a
    forall a (m :: * -> *).
    (Data a, Monad m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapM GenericM m
    go a
    x
          a -> m a
    GenericM m
    f a
    x'

    -- | Apply a monadic transformation at least somewhere
    somewhere :: forall m. MonadPlus m => GenericM m -> GenericM m

    -- We try "f" in top-down manner, but descent into "x" when we fail
    -- at the root of the term. The transformation fails if "f" fails
    -- everywhere, say succeeds nowhere.
    --
    somewhere :: GenericM m -> GenericM m
    somewhere f :: GenericM m
    f = a -> m a
    GenericM m
    go
      where
        go :: GenericM m
        go :: a -> m a
    go x :: a
    x = a -> m a
    GenericM m
    f a
    x m a -> m a -> m a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` GenericM m -> a -> m a
    forall a (m :: * -> *).
    (Data a, MonadPlus m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapMp GenericM m
    go a
    x

    -- | Summarise all nodes in top-down, left-to-right order
    everything :: forall r. (r -> r -> r) -> GenericQ r -> GenericQ r

    -- Apply f to x to summarise top-level node;
    -- use gmapQ to recurse into immediate subterms;
    -- use ordinary foldl to reduce list of intermediate results
    --
    everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
    everything k :: r -> r -> r
    k f :: GenericQ r
    f = a -> r
    GenericQ r
    go
      where
        go :: GenericQ r
        go :: a -> r
    go x :: a
    x = (r -> r -> r) -> r -> [r] -> r
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl r -> r -> r
    k (a -> r
    GenericQ r
    f a
    x) (GenericQ r -> a -> [r]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ GenericQ r
    go a
    x)

    -- | Variation of "everything" with an added stop condition
    everythingBut :: forall r. (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
    everythingBut :: (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
    everythingBut k :: r -> r -> r
    k f :: GenericQ (r, Bool)
    f = a -> r
    GenericQ r
    go
      where
        go :: GenericQ r
        go :: a -> r
    go x :: a
    x = let (v :: r
    v, stop :: Bool
    stop) = a -> (r, Bool)
    GenericQ (r, Bool)
    f a
    x
               in if Bool
    stop
                    then r
    v
                    else (r -> r -> r) -> r -> [r] -> r
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl r -> r -> r
    k r
    v (GenericQ r -> a -> [r]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ GenericQ r
    go a
    x)

    -- | Summarise all nodes in top-down, left-to-right order, carrying some state
    -- down the tree during the computation, but not left-to-right to siblings.
    everythingWithContext :: forall s r. s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
    everythingWithContext :: s -> (r -> r -> r) -> GenericQ (s -> (r, s)) -> GenericQ r
    everythingWithContext s0 :: s
    s0 f :: r -> r -> r
    f q :: GenericQ (s -> (r, s))
    q = s -> GenericQ r
    go s
    s0
      where
        go :: s -> GenericQ r
        go :: s -> GenericQ r
    go s :: s
    s x :: a
    x = (r -> r -> r) -> r -> [r] -> r
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl r -> r -> r
    f r
    r (GenericQ r -> a -> [r]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ (s -> GenericQ r
    go s
    s') a
    x)
          where (r :: r
    r, s' :: s
    s') = a -> s -> (r, s)
    GenericQ (s -> (r, s))
    q a
    x s
    s

    -- | Get a list of all entities that meet a predicate
    listify :: Typeable r => (r -> Bool) -> GenericQ [r]
    listify :: (r -> Bool) -> GenericQ [r]
    listify p :: r -> Bool
    p = ([r] -> [r] -> [r]) -> GenericQ [r] -> GenericQ [r]
    forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
    everything [r] -> [r] -> [r]
    forall a. [a] -> [a] -> [a]
    (++) ([] [r] -> (r -> [r]) -> a -> [r]
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    `mkQ` (\x :: r
    x -> if r -> Bool
    p r
    x then [r
    x] else []))

    -- | Look up a subterm by means of a maybe-typed filter
    something :: GenericQ (Maybe u) -> GenericQ (Maybe u)

    -- "something" can be defined in terms of "everything"
    -- when a suitable "choice" operator is used for reduction
    --
    something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
    something = (Maybe u -> Maybe u -> Maybe u)
    -> GenericQ (Maybe u) -> GenericQ (Maybe u)
    forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
    everything Maybe u -> Maybe u -> Maybe u
    forall a. Maybe a -> Maybe a -> Maybe a
    orElse

    -- | Bottom-up synthesis of a data structure;
    --   1st argument z is the initial element for the synthesis;
    --   2nd argument o is for reduction of results from subterms;
    --   3rd argument f updates the synthesised data according to the given term
    --
    synthesize :: forall s t. s  -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t
    synthesize :: s -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t
    synthesize z :: s
    z o :: t -> s -> s
    o f :: GenericQ (s -> t)
    f = a -> t
    GenericQ t
    go
      where
        go :: GenericQ t
        go :: a -> t
    go x :: a
    x = a -> s -> t
    GenericQ (s -> t)
    f a
    x ((t -> s -> s) -> s -> [t] -> s
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr t -> s -> s
    o s
    z (GenericQ t -> a -> [t]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ GenericQ t
    go a
    x))

    -- | Compute size of an arbitrary data structure
    gsize :: Data a => a -> Int
    gsize :: a -> Int
    gsize t :: a
    t = 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((forall d. Data d => d -> Int) -> a -> [Int]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ forall d. Data d => d -> Int
    gsize a
    t)

    -- | Count the number of immediate subterms of the given term
    glength :: GenericQ Int
    glength :: a -> Int
    glength = [()] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([()] -> Int) -> (a -> [()]) -> a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall d. Data d => d -> ()) -> a -> [()]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ (() -> d -> ()
    forall a b. a -> b -> a
    const ())

    -- | Determine depth of the given term
    gdepth :: GenericQ Int
    gdepth :: a -> Int
    gdepth = Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) 1 (Int -> Int) -> (a -> Int) -> a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 0 ([Int] -> Int) -> (a -> [Int]) -> a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall d. Data d => d -> Int) -> a -> [Int]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ forall d. Data d => d -> Int
    gdepth

    -- | Determine the number of all suitable nodes in a given term
    gcount :: GenericQ Bool -> GenericQ Int
    gcount :: GenericQ Bool -> forall d. Data d => d -> Int
    gcount p :: GenericQ Bool
    p =  (Int -> Int -> Int)
    -> (forall d. Data d => d -> Int) -> forall d. Data d => d -> Int
    forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
    everything Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) (\x :: a
    x -> if a -> Bool
    GenericQ Bool
    p a
    x then 1 else 0)

    -- | Determine the number of all nodes in a given term
    gnodecount :: GenericQ Int
    gnodecount :: a -> Int
    gnodecount = GenericQ Bool -> forall d. Data d => d -> Int
    gcount (Bool -> a -> Bool
    forall a b. a -> b -> a
    const Bool
    True)

    -- | Determine the number of nodes of a given type in a given term
    gtypecount :: Typeable a => a -> GenericQ Int
    gtypecount :: a -> forall d. Data d => d -> Int
    gtypecount (a
    _::a) = GenericQ Bool -> forall d. Data d => d -> Int
    gcount (Bool
    False Bool -> (a -> Bool) -> a -> Bool
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    `mkQ` (\(a
    _::a) -> Bool
    True))

    -- | Find (unambiguously) an immediate subterm of a given type
    gfindtype :: (Data x, Typeable y) => x -> Maybe y
    gfindtype :: x -> Maybe y
    gfindtype = [y] -> Maybe y
    forall a. [a] -> Maybe a
    singleton
              ([y] -> Maybe y) -> (x -> [y]) -> x -> Maybe y
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([y] -> Maybe y -> [y]) -> [y] -> [Maybe y] -> [y]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [y] -> Maybe y -> [y]
    forall a. [a] -> Maybe a -> [a]
    unJust []
              ([Maybe y] -> [y]) -> (x -> [Maybe y]) -> x -> [y]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall d. Data d => d -> Maybe y) -> x -> [Maybe y]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ (Maybe y
    forall a. Maybe a
    Nothing Maybe y -> (y -> Maybe y) -> d -> Maybe y
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    `mkQ` y -> Maybe y
    forall a. a -> Maybe a
    Just)
     where
      unJust :: [a] -> Maybe a -> [a]
    unJust l :: [a]
    l (Just x :: a
    x) = a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    l
      unJust l :: [a]
    l Nothing  = [a]
    l
      singleton :: [a] -> Maybe a
    singleton [s :: a
    s] = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    s
      singleton _   = Maybe a
    forall a. Maybe a
    Nothing