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

{- |
   Module     : Control.Arrow.ArrowTree
   Copyright  : Copyright (C) 2010 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
   Stability  : stable
   Portability: portable

   List arrows for tree processing.

   Trees that implement the "Data.Tree.Class" interface, can be processed
   with these arrows.
-}

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

module Control.Arrow.ArrowTree
    ( ArrowTree(..)
    , Tree
    )
where

import Data.Tree.Class (Tree)
import qualified Data.Tree.Class as T hiding (Tree)

import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf

infixl 5 />, //>, </

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

-- | The interface for tree arrows
--
-- all functions have default implementations

class (ArrowPlus a, ArrowIf a) => ArrowTree a where

    -- | construct a leaf

    mkLeaf              :: Tree t => b -> a c (t b)
    mkLeaf              = t b -> a c (t b)
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (t b -> a c (t b)) -> (b -> t b) -> b -> a c (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t b
forall a. a -> t a
forall (t :: * -> *) a. Tree t => a -> t a
T.mkLeaf
    {-# INLINE mkLeaf #-}

    -- | construct an inner node

    mkTree              :: Tree t => b -> [t b] -> a c (t b)
    mkTree b
n            = t b -> a c (t b)
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (t b -> a c (t b)) -> ([t b] -> t b) -> [t b] -> a c (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [t b] -> t b
forall a. a -> [t a] -> t a
forall (t :: * -> *) a. Tree t => a -> [t a] -> t a
T.mkTree b
n
    {-# INLINE mkTree #-}

    -- | select the children of the root of a tree

    getChildren         :: Tree t => a (t b) (t b)
    getChildren         = (t b -> [t b]) -> a (t b) (t b)
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall a. t a -> [t a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
T.getChildren
    {-# INLINE getChildren #-}

    -- | select the node info of the root of a tree

    getNode             :: Tree t => a (t b) b
    getNode             = (t b -> b) -> a (t b) b
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr t b -> b
forall a. t a -> a
forall (t :: * -> *) a. Tree t => t a -> a
T.getNode
    {-# INLINE getNode #-}

    -- | select the attribute of the root of a tree

    hasNode             :: Tree t => (b -> Bool) -> a (t b) (t b)
    hasNode b -> Bool
p           = (a (t b) b
forall (t :: * -> *) b. Tree t => a (t b) b
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) b
getNode a (t b) b -> a b b -> a (t b) b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (b -> Bool) -> a b b
forall b. (b -> Bool) -> a b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA b -> Bool
p) a (t b) b -> a (t b) (t b) -> a (t b) (t b)
forall b c d. a b c -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a (t b) (t b)
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    {-# INLINE hasNode #-}

    -- | substitute the children of the root of a tree

    setChildren         :: Tree t =>            [t b] -> a (t b) (t b)
    setChildren [t b]
cs      = (t b -> t b) -> a (t b) (t b)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([t b] -> t b -> t b
forall a. [t a] -> t a -> t a
forall (t :: * -> *) a. Tree t => [t a] -> t a -> t a
T.setChildren [t b]
cs)
    {-# INLINE setChildren #-}

    -- | substitute the attribute of the root of a tree

    setNode             :: Tree t =>                b -> a (t b) (t b)
    setNode b
n           = (t b -> t b) -> a (t b) (t b)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b -> t b -> t b
forall a. a -> t a -> t a
forall (t :: * -> *) a. Tree t => a -> t a -> t a
T.setNode b
n)
    {-# INLINE setNode #-}

    -- | edit the children of the root of a tree

    changeChildren      :: Tree t => ([t b] -> [t b]) -> a (t b) (t b)
    changeChildren [t b] -> [t b]
csf  = (t b -> t b) -> a (t b) (t b)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([t b] -> [t b]) -> t b -> t b
forall a. ([t a] -> [t a]) -> t a -> t a
forall (t :: * -> *) a. Tree t => ([t a] -> [t a]) -> t a -> t a
T.changeChildren [t b] -> [t b]
csf)
    {-# INLINE changeChildren #-}

    -- | edit the attribute of the root of a tree

    changeNode          :: Tree t =>        (b  -> b) -> a (t b) (t b)
    changeNode b -> b
nf       = (t b -> t b) -> a (t b) (t b)
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b -> b) -> t b -> t b
forall a. (a -> a) -> t a -> t a
forall (t :: * -> *) a. Tree t => (a -> a) -> t a -> t a
T.changeNode b -> b
nf)
    {-# INLINE changeNode #-}

                                                                -- compound arrows

    -- | apply an arrow element wise to all children of the root of a tree
    -- collect these results and substitute the children with this result
    --
    -- example: @ processChildren isText @ deletes all subtrees, for which isText does not hold
    --
    -- example: @ processChildren (none \`when\` isCmt) @ removes all children, for which isCmt holds

    processChildren     :: Tree t => a (t b) (t b) -> a (t b) (t b)
    processChildren a (t b) (t b)
f   = (t b -> b) -> a (t b) b
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr t b -> b
forall a. t a -> a
forall (t :: * -> *) a. Tree t => t a -> a
T.getNode
                          a (t b) b -> a (t b) [t b] -> a (t b) (b, [t b])
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                          a (t b) (t b) -> a (t b) [t b]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ((t b -> [t b]) -> a (t b) (t b)
forall b c. (b -> [c]) -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL t b -> [t b]
forall a. t a -> [t a]
forall (t :: * -> *) a. Tree t => t a -> [t a]
T.getChildren a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) (t b)
f)      -- new children, deterministic filter: single element result
                          a (t b) (b, [t b]) -> a (b, [t b]) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (b -> [t b] -> t b) -> a (b, [t b]) (t b)
forall b1 b2 c. (b1 -> b2 -> c) -> a (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 b -> [t b] -> t b
forall a. a -> [t a] -> t a
forall (t :: * -> *) a. Tree t => a -> [t a] -> t a
T.mkTree

    -- | similar to processChildren, but the new children are computed by processing
    -- the whole input tree
    --
    -- example: @ replaceChildren (deep isText) @ selects all subtrees for which isText holds
    -- and substitutes the children component of the root node with this list

    replaceChildren     :: Tree t => a (t b) (t b) -> a (t b) (t b)
    replaceChildren a (t b) (t b)
f   = (t b -> b) -> a (t b) b
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr t b -> b
forall a. t a -> a
forall (t :: * -> *) a. Tree t => t a -> a
T.getNode
                          a (t b) b -> a (t b) [t b] -> a (t b) (b, [t b])
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                          a (t b) (t b) -> a (t b) [t b]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
f                               -- compute new children
                          a (t b) (b, [t b]) -> a (b, [t b]) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (b -> [t b] -> t b) -> a (b, [t b]) (t b)
forall b1 b2 c. (b1 -> b2 -> c) -> a (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 b -> [t b] -> t b
forall a. a -> [t a] -> t a
forall (t :: * -> *) a. Tree t => a -> [t a] -> t a
T.mkTree

    -- |
    -- pronounced \"slash\", meaning g inside f
    --
    -- defined as @ f \/> g = f >>> getChildren >>> g @
    --
    -- example: @ hasName \"html\" \/> hasName \"body\" \/> hasName \"h1\" @
    --
    -- This expression selects
    -- all \"h1\" elements in the \"body\" element of an \"html\" element, an expression, that
    -- corresponds 1-1 to the XPath selection path \"html\/body\/h1\"

    (/>)                :: Tree t => a b (t c) -> a (t c) d -> a b d
    a b (t c)
f /> a (t c) d
g              = a b (t c)
f a b (t c) -> a (t c) d -> a b d
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t c) (t c)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t c) (t c) -> a (t c) d -> a (t c) d
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t c) d
g
    {-# INLINE (/>) #-}

    -- |
    -- pronounced \"double slash\", meaning g arbitrarily deep inside f
    --
    -- defined as @ f \/\/> g = f >>> getChildren >>> deep g @
    --
    -- example: @ hasName \"html\" \/\/> hasName \"table\" @
    --
    -- This expression selects
    -- all top level \"table\" elements within an \"html\" element, an expression.
    -- Attention: This does not correspond
    -- to the XPath selection path \"html\/\/table\". The latter on matches all table elements
    -- even nested ones, but @\/\/>@ gives in many cases the appropriate functionality.

    (//>)               :: Tree t => a b (t c) -> a (t c) d -> a b d
    a b (t c)
f //> a (t c) d
g             = a b (t c)
f a b (t c) -> a (t c) d -> a b d
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t c) (t c)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t c) (t c) -> a (t c) d -> a (t c) d
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t c) d -> a (t c) d
forall (t :: * -> *) b c. Tree t => a (t b) c -> a (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep a (t c) d
g
    {-# INLINE (//>) #-}


    -- |
    -- pronounced \"outside\" meaning f containing g
    --
    -- defined as @ f \<\/ g = f \`containing\` (getChildren >>> g) @

    (</)                :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
    a (t b) (t b)
f </ a (t b) (t b)
g              = a (t b) (t b)
f a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall b c d. a b c -> a c d -> a b c
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a c d -> a b c
`containing` (a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) (t b)
g)
    {-# INLINE (</) #-}


    -- | recursively searches a whole tree for subtrees, for which a predicate holds.
    -- The search is performed top down. When a tree is found, this becomes an element of the result
    -- list. The tree found is not further examined for any subtress, for which the predicate also could hold.
    -- See 'multi' for this kind of search.
    --
    -- example: @ deep isHtmlTable @ selects all top level table elements in a document
    -- (with an appropriate definition for isHtmlTable) but no tables occuring within a table cell.

    deep                :: Tree t => a (t b) c -> a (t b) c
    deep a (t b) c
f              = a (t b) c
f                                     -- success when applying f
                          a (t b) c -> a (t b) c -> a (t b) c
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                          (a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t b) (t b) -> a (t b) c -> a (t b) c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) c -> a (t b) c
forall (t :: * -> *) b c. Tree t => a (t b) c -> a (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep a (t b) c
f)              -- seach children


    -- | recursively searches a whole tree for subrees, for which a predicate holds.
    -- The search is performed bottom up.
    --
    -- example: @ deepest isHtmlTable @ selects all innermost table elements in a document
    -- but no table elements containing tables. See 'deep' and 'multi' for other search strategies.

    deepest             :: Tree t => a (t b) c -> a (t b) c
    deepest a (t b) c
f           = (a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t b) (t b) -> a (t b) c -> a (t b) c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) c -> a (t b) c
forall (t :: * -> *) b c. Tree t => a (t b) c -> a (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deepest a (t b) c
f)           -- seach children
                          a (t b) c -> a (t b) c -> a (t b) c
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                          a (t b) c
f                                     -- no success: apply f to root


    -- | recursively searches a whole tree for subtrees, for which a predicate holds.
    -- The search is performed top down. All nodes of the tree are searched, even within the
    -- subtrees of trees for which the predicate holds.
    --
    -- example: @ multi isHtmlTable @ selects all table elements, even nested ones.

    multi               :: Tree t => a (t b) c -> a (t b) c
    multi a (t b) c
f             = a (t b) c
f                                     -- combine result for root
                          a (t b) c -> a (t b) c -> a (t b) c
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                          (a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (t b) (t b) -> a (t b) c -> a (t b) c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (t b) c -> a (t b) c
forall (t :: * -> *) b c. Tree t => a (t b) c -> a (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
multi a (t b) c
f)             -- with result for all descendants

    -- | recursively transforms a whole tree by applying an arrow to all subtrees,
    -- this is done bottom up depth first, leaves first, root as last tree
    --
    -- example: @ processBottomUp (getChildren \`when\` isHtmlFont) @ removes all font tags in a HTML document, even nested ones
    -- (with an appropriate definition of isHtmlFont)

    processBottomUp     :: Tree t => a (t b) (t b) -> a (t b) (t b)
    processBottomUp a (t b) (t b)
f   = a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processBottomUp a (t b) (t b)
f)   -- process all descendants first
                          a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          a (t b) (t b)
f                                     -- then process root

    -- | similar to 'processBottomUp', but recursively transforms a whole tree by applying an arrow to all subtrees
    -- with a top down depth first traversal strategie. In many cases 'processBottomUp' and 'processTopDown'
    -- give same results.

    processTopDown      :: Tree t => a (t b) (t b) -> a (t b) (t b)
    processTopDown a (t b) (t b)
f    = a (t b) (t b)
f                                     -- first process root
                          a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDown a (t b) (t b)
f)    -- then process all descendants of new root


    -- | recursively transforms a whole tree by applying an arrow to all subtrees,
    -- but transformation stops when a predicte does not hold for a subtree,
    -- leaves are transformed first

    processBottomUpWhenNot
                        :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
    processBottomUpWhenNot a (t b) (t b)
f a (t b) (t b)
p
                        = ( a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b.
Tree t =>
a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
processBottomUpWhenNot a (t b) (t b)
f a (t b) (t b)
p)
                            a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                            a (t b) (t b)
f
                          ) a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall b c. a b b -> a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` a (t b) (t b)
p

    -- | recursively transforms a whole tree by applying an arrow to all subtrees,
    -- but transformation stops when a tree is successfully transformed.
    -- the transformation is done top down
    --
    -- example: @ processTopDownUntil (isHtmlTable \`guards\` tranformTable) @
    -- transforms all top level table elements into something else, but inner tables remain unchanged

    processTopDownUntil :: Tree t => a (t b) (t b) -> a (t b) (t b)
    processTopDownUntil a (t b) (t b)
f
                        = a (t b) (t b)
f
                          a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                          a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processTopDownUntil a (t b) (t b)
f)

    -- | computes a list of trees by applying an arrow to the input
    -- and inserts this list in front of index i in the list of children
    --
    -- example: @ insertChildrenAt 0 (deep isCmt) @ selects all subtrees for which isCmt holds
    -- and copies theses in front of the existing children

    insertChildrenAt    :: Tree t =>           Int -> a (t b) (t b) -> a (t b) (t b)
    insertChildrenAt Int
i a (t b) (t b)
f
                        = a (t b) (t b) -> a (t b) [t b]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
f a (t b) [t b] -> a (t b) (t b) -> a (t b) ([t b], t b)
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a (t b) (t b)
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this a (t b) ([t b], t b) -> a ([t b], t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([t b] -> t b -> t b) -> a ([t b], t b) (t b)
forall b1 b2 c. (b1 -> b2 -> c) -> a (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 [t b] -> t b -> t b
forall {t :: * -> *} {a}. Tree t => [t a] -> t a -> t a
insertAt
                          where
                          insertAt :: [t a] -> t a -> t a
insertAt [t a]
newcs
                              = ([t a] -> [t a]) -> t a -> t a
forall a. ([t a] -> [t a]) -> t a -> t a
forall (t :: * -> *) a. Tree t => ([t a] -> [t a]) -> t a -> t a
T.changeChildren (\ [t a]
cs -> let
                                                          ([t a]
cs1, [t a]
cs2) = Int -> [t a] -> ([t a], [t a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [t a]
cs
                                                          in
                                                          [t a]
cs1 [t a] -> [t a] -> [t a]
forall a. [a] -> [a] -> [a]
++ [t a]
newcs [t a] -> [t a] -> [t a]
forall a. [a] -> [a] -> [a]
++ [t a]
cs2
                                                 )

    -- | similar to 'insertChildrenAt', but the insertion position is searched with a predicate

    insertChildrenAfter :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
    insertChildrenAfter a (t b) (t b)
p a (t b) (t b)
f
                        = a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
                          ( ( ( a (t b) (t b) -> a (t b) [t b]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                a (t b) [t b] -> a [t b] ([t b], [t b]) -> a (t b) ([t b], [t b])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                a (t b) (t b) -> a [t b] ([t b], [t b])
forall b. a b b -> a [b] ([b], [b])
forall (a :: * -> * -> *) b. ArrowIf a => a b b -> a [b] ([b], [b])
spanA a (t b) (t b)
p
                              )
                              a (t b) ([t b], [t b])
-> a (t b) [t b] -> a (t b) (([t b], [t b]), [t b])
forall b c c'. a b c -> a b c' -> a b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                              a (t b) (t b) -> a (t b) [t b]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (t b) (t b)
f
                            )
                            a (t b) (([t b], [t b]), [t b])
-> a (([t b], [t b]), [t b]) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (([t b], [t b]) -> [t b] -> [t b])
-> a (([t b], [t b]), [t b]) (t b)
forall b c d. (b -> c -> [d]) -> a (b, c) d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
(b -> c -> [d]) -> a (b, c) d
arr2L (\ ([t b]
xs1, [t b]
xs2) [t b]
xs -> [t b]
xs1 [t b] -> [t b] -> [t b]
forall a. [a] -> [a] -> [a]
++ [t b]
xs [t b] -> [t b] -> [t b]
forall a. [a] -> [a] -> [a]
++ [t b]
xs2)
                          )

    -- | an arrow for inserting a whole subtree with some holes in it (a template)
    -- into a document. The holes can be filled with contents from the input.
    --
    -- Example
    --
    -- > insertTreeTemplateTest :: ArrowXml a => a b XmlTree
    -- > insertTreeTemplateTest
    -- >     = doc
    -- >       >>>
    -- >       insertTreeTemplate template pattern
    -- >     where
    -- >     doc                                                                -- the input data
    -- >        = constA "<x><y>The Title</y><z>The content</z></x>"
    -- >          >>> xread
    -- >     template                                                           -- the output template with 2 holes: xxx and yyy
    -- >        = constA "<html><head><title>xxx</title></head><body><h1>yyy</h1></body></html>"
    -- >          >>> xread
    -- >     pattern
    -- >        = [ hasText (== "xxx")                                          -- fill the xxx hole with the input contents from element "x/y"
    -- >            :-> ( getChildren >>> hasName "y" >>> deep isText )
    -- >
    -- >          , hasText (== "yyy")                                          -- fill the yyy hole with the input contents from element "x/z"
    -- >            :-> ( getChildren >>> hasName "z" >>> getChildren )
    -- >          ]
    --
    -- computes the XML tree for the following document
    --
    -- > "<html><head><title>The Title</title></head><body><h1>The content</h1></body></html>"

    insertTreeTemplate  :: Tree t =>
                           a (t b) (t b) ->                                     -- the the template
                           [IfThen (a (t b) c) (a (t b) (t b))] ->              -- the list of nodes in the template to be substituted
                           a (t b) (t b)
    insertTreeTemplate a (t b) (t b)
template [IfThen (a (t b) c) (a (t b) (t b))]
choices
        = t b -> a (t b) (t b)
insertTree (t b -> a (t b) (t b)) -> a (t b) (t b) -> a (t b) (t b)
forall c b d. (c -> a b d) -> a b c -> a b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< a (t b) (t b)
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          where
          insertTree :: t b -> a (t b) (t b)
insertTree t b
t
              = a (t b) (t b)
template                                        -- swap input and template
                a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                a (t b) (t b)
processTemplate
              where
              processTemplate :: a (t b) (t b)
processTemplate
                  = [IfThen (a (t b) c) (a (t b) (t b))] -> a (t b) (t b)
forall b c d. [IfThen (a b c) (a b d)] -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [IfThen (a (t b) c) (a (t b) (t b))]
forall {a}. [IfThen (a (t b) c) (a a (t b))]
choices'                            -- check whether node is a "hole" within the template
                    a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                    a (t b) (t b) -> a (t b) (t b)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren a (t b) (t b)
processTemplate             -- else descent into template tree
              choices' :: [IfThen (a (t b) c) (a a (t b))]
choices'
                  = (IfThen (a (t b) c) (a (t b) (t b))
 -> IfThen (a (t b) c) (a a (t b)))
-> [IfThen (a (t b) c) (a (t b) (t b))]
-> [IfThen (a (t b) c) (a a (t b))]
forall a b. (a -> b) -> [a] -> [b]
map IfThen (a (t b) c) (a (t b) (t b))
-> IfThen (a (t b) c) (a a (t b))
forall {cat :: * -> * -> *} {a} {c} {a}.
ArrowList cat =>
IfThen a (cat (t b) c) -> IfThen a (cat a c)
feedTree [IfThen (a (t b) c) (a (t b) (t b))]
choices                        -- modify choices, such that the input is feed into the action arrows
              feedTree :: IfThen a (cat (t b) c) -> IfThen a (cat a c)
feedTree (a
cond :-> cat (t b) c
action)
                  = a
cond a -> cat a c -> IfThen a (cat a c)
forall a b. a -> b -> IfThen a b
:-> (t b -> cat a (t b)
forall c b. c -> cat b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA t b
t cat a (t b) -> cat (t b) c -> cat a c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> cat (t b) c
action)              -- the real input becomes the input at the holes