#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Tree operations
# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc., 2020
#-------------------------------------------------------------------------------
# podDocumentation
package Tree::Ops;
our $VERSION = 20200628;
require v5.26;
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess cluck);
use Data::Dump qw(dump);
use Data::Table::Text qw(genHash);
use feature qw(say current_sub);

#D1 Build                                                                       # Create a tree.

sub new($)                                                                      #S Create a new child recording the specified user data.
 {my ($user) = @_;                                                              # User data to be recorded in the child
  genHash(__PACKAGE__,                                                          # Child in the tree
    children   => [],                                                           # Children of this child
    user       => $user,                                                        # User data for this child
    parent     => undef,                                                        # Parent for this child
    lastChild  => undef,                                                        # Last active child
   );
 }

sub activeScope($)                                                              #P Locate the active scope in a tree.
 {my ($tree) = @_;                                                              # Tree
  my $active;                                                                   # Latest active node
  for(my $l = $tree; $l; $l = $l->lastChild) {$active = $l}                     # Skip down edge of parse tree to node above active node
  $active
 }

sub setParentOfChild($$)                                                        #P Set the parent of a child and return the child.
 {my ($child, $parent) = @_;                                                    # Child, parent
  $child->parent = $parent;                                                     # Parent child
  $child
 }

sub open($$)                                                                    # Add a child and make it the currently active scope into which new nodes are added.
 {my ($tree, $user) = @_;                                                       # Tree, user data to be recorded in the interior child being opened
  my $parent = activeScope $tree;                                               # Active node
  my $child  = new $user;                                                       # Child
  push $parent->children->@*, $child;                                           # Place child - inline put last
  $parent->lastChild = $child;                                                  # Make child active
  setParentOfChild $child, $parent                                              # Parent child
 }

sub close($)                                                                    # Close the current scope returning to the previous scope.
 {my ($tree) = @_;                                                              # Tree
  my $parent = activeScope $tree;                                               # Locate active scope
  delete $parent->parent->{lastChild};                                          # Close scope
  $parent
 }

sub single($$)                                                                  # Add one child in the current scope.
 {my ($tree, $user) = @_;                                                       # Tree, user data to be recorded in the child being created
  $tree->open($user);                                                           # Open scope
  $tree->close;                                                                 # Close scope immediately
 }

#D1 Navigation                                                                  # Navigate through the tree.

sub first($)                                                                    # Get the first child under the specified parent.
 {my ($parent) = @_;                                                            # Parent
  $parent->children->[0]
 }

sub last($)                                                                     # Get the last child under the specified parent.
 {my ($parent) = @_;                                                            # Parent
  $parent->children->[-1]
 }

sub indexOfChildInParent($)                                                     #P Get the index of a child within the specified parent.
 {my ($child) = @_;                                                             # Child
  return undef unless my $parent = $child->parent;                              # Parent
  my $c = $parent->children;                                                    # Siblings
  for(0..$#$c) {return $_ if $$c[$_] == $child}                                 # Locate child and return index
  confess 'Child not found in parent'
 }

sub next($)                                                                     # Get the next sibling following the specified child.
 {my ($child) = @_;                                                             # Child
  return undef unless my $parent = $child->parent;                              # Parent
  my $c = $parent->children;                                                    # Siblings
  return undef if @$c == 0 or $$c[-1] == $child;                                # No next child
  $$c[+1 + indexOfChildInParent $child]                                         # Next child
 }

sub prev($)                                                                     # Get the previous sibling of the specified child.
 {my ($child) = @_;                                                             # Child
  return undef unless my $parent = $child->parent;                              # Parent
  my $c = $parent->children;                                                    # Siblings
  return undef if @$c == 0 or $$c[0] == $child;                                 # No previous child
  $$c[-1 + indexOfChildInParent $child]                                         # Previous child
 }

#D1 Location                                                                    # Navigate through the tree.

sub context($)                                                                  # Get the context of the current child.
 {my ($child) = @_;                                                             # Child
  my @c;                                                                        # Context
  for(my $c = $child; $c; $c = $c->parent) {push @c, $c}                        # Walk up
  @c
 }

sub singleChildOfParent($)                                                      # Return the only child of this parent if the parent has an only child, else B<undef>
 {my ($parent) = @_;                                                            # Parent
  $parent->children->@* == 1 ? $parent->children->[0] : undef                   # Return only child if it exists
 }

#D1 Put                                                                         # Insert children into a tree.

sub putFirst($$)                                                                # Place a new child first under the specified parent and return the child.
 {my ($parent, $child) = @_;                                                    # Parent, child
  unshift $parent->children->@*, $child;                                        # Place child
  setParentOfChild $child, $parent                                              # Parent child
 }

sub putLast($$)                                                                 # Place a new child last under the specified parent and return the child.
 {my ($parent, $child) = @_;                                                    # Parent, child
  push $parent->children->@*, $child;                                           # Place child
  setParentOfChild $child, $parent                                              # Parent child
 }

sub putNext($$)                                                                 # Place a new child after the specified child.
 {my ($child, $new) = @_;                                                       # Existing child, new child
  return undef unless defined(my $i = indexOfChildInParent $child);             # Locate child within parent
  splice $child->parent->children->@*, $i, 1, $child, $new;                     # Place new child
  setParentOfChild $new, $child->parent                                         # Parent child
 }

sub putPrev($$)                                                                 # Place a new child before the specified child.
 {my ($child, $new) = @_;                                                       # Child, new child
  return undef unless defined(my $i = indexOfChildInParent($child));            # Locate child within parent
  splice $child->parent->children->@*, $i, 1, $new, $child;                     # Place new child
  setParentOfChild $new, $child->parent                                         # Parent child
 }

#D1 Edit                                                                        # Edit nodes in context.

sub cut($)                                                                      # Cut out a child and all its content and children, return it ready for reinsertion else where.
 {my ($node) = @_;                                                              # Child
  splice $node->parent->children->@*, indexOfChildInParent($node), 1            # Remove node
 }

sub dup($)                                                                      # Duplicate a parent and all its descendants.
 {my ($parent) = @_;                                                            # Parent

  sub($)                                                                        # Duplicate a node
   {my ($old)  = @_;                                                            # Node
    my $new    = new $old->user;                                                # New node
    push $new->children->@*, __SUB__->($_) for $old->children->@*;              # Duplicate children of node
    $new
   }->($parent)                                                                 # Start duplication at parent
 }

sub unwrap($)                                                                   # Unwrap the specified child and return it
 {my ($child) = @_;                                                             # Child
  return undef unless defined(my $i = indexOfChildInParent $child);             # Locate child within parent
  my $parent = $child->parent;                                                  # Parent
  $_->parent = $parent for $child->children->@*;                                # Reparent unwrapped children of child
  delete $child->{parent};                                                      # Unparent unwrapped child
  splice $parent->children->@*, $i, 1, $child->children->@*;                    # Remove child
  $parent
 }

sub wrap($$)                                                                    # Wrap the specified child with a new parent and return the new parent.
 {my ($child, $new) = @_;                                                       # Child to wrap, new wrapping parent
  return undef unless defined(my $i = indexOfChildInParent $child);             # Locate child within existing parent
  my $parent     = $child->parent;                                              # Existing parent
  $new->parent   = $parent;                                                     # Parent new parent
  $new->children = [$child];                                                    # Set children for new parent
  splice $parent->children->@*, $i, 1, $new;                                    # Place new parent in existing parent
  $child->parent = $new;                                                        # Reparent child to new parent
 }

#D1 Traverse                                                                    # Traverse the tree.

sub by($$)                                                                      # Traverse a tree in order to process each child and return an array of the results of processing each node.
 {my ($tree, $sub) = @_;                                                        # Tree, method to process a child
  my @r;                                                                        # Results

  sub($)                                                                        # Traverse
   {my ($child) = @_;                                                           # Child
    __SUB__->($_) for $child->children->@*;                                     # Children of child
    push @r, &$sub($child);                                                     # Process child saving result
   }->($tree);                                                                  # Start at root of tree

  @r
 }

sub select($$)                                                                  # Select matching children in a tree. A child can be selected via named value, array of values, a hash of values, a regular expression or a sub reference.
 {my ($tree, $select) = @_;                                                     # Tree, method to select a child
  my $ref = ref $select;                                                        # Selector type
  my $sel =                                                                     # Selection method
             $ref =~ m(array)i ? sub{grep{$_[0]} @$select} :                    # Array
             $ref =~ m(hash)i  ? sub{$$select{$_[0]}}      :                    # Hash
             $ref =~ m(re)i    ? sub{$_[0] =~ m($select)}  :                    # Regular expression
             $ref =~ m(code)i  ? sub{&$select($_[0])}      :                    # Sub
                                 sub{$_[0] eq $select};                         # Scalar
  my @s;                                                                        # Selection
  sub($)                                                                        # Traverse
   {my ($child) = @_;                                                           # Child
    push @s, $child if &$sel($child->user);                                     # Select child if it matches
    __SUB__->($_) for $child->children->@*;                                     # Each child
   }->($tree);                                                                  # Start at root

  @s
 }

#D1 Print                                                                       # Print the tree.

sub print($;$)                                                                  # String representation as a horizontal tree.
 {my ($tree, $print) = @_;                                                      # Tree, optional print method
  my @s;                                                                        # String representation

  sub($$)                                                                       # Print a node
   {my ($child, $depth) = @_;                                                   # Child, depth
    my $user = $child->user;                                                    # User data
    push @s, join '', '  ' x $depth, $print ? &$print($user) : $user;           # Print child
    __SUB__->($_, $depth+1) for $child->children->@*;                           # Print children of child
   }->($tree, 0);                                                               # Print root node

  join "\n", @s, ''                                                             # String result
 }

sub brackets($$;$)                                                              # Bracketed string representation of a tree.
 {my ($tree, $print, $separator) = @_;                                          # Tree, print method, child separator
  my @s;                                                                        # String representation
  my $t = $separator // '';                                                     # Default child separator
  sub($)                                                                        # Print a node
   {my ($child) = @_;                                                           # Child
    my $user = $child->user;                                                    # User data
    my ($p) = ($print ? &$print($user) : $user);                                # Printed child
    my  $c  = $child->children;                                                 # Children of child
    return $p unless @$c;                                                       # Return child immediately if no children to format
    join '', $p, '(', join($t, map {__SUB__->($_)} @$c), ')'                    # String representation
   }->($tree);                                                                  # Print root node
 }

#D1 Data Structures                                                             # Data structures use by this package.

#D0
#-------------------------------------------------------------------------------
# Export
#-------------------------------------------------------------------------------

use Exporter qw(import);

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

@ISA          = qw(Exporter);
@EXPORT_OK    = qw(
);
%EXPORT_TAGS  = (all=>[@EXPORT, @EXPORT_OK]);

# podDocumentation

=pod

=encoding utf-8

=head1 Name

Tree::Ops - Tree operations.

=head1 Synopsis

Create a tree:

  my $t = Tree::Ops::new 'a';
  for(1..2)
   {$t->open  ('b');
    $t->single('c');
    $t->close;
   }
  $t->single  ('d');

Print the tree:

  is_deeply $t->print(sub{@_}), <<END;
  a
    b
      c
    b
      c
    d
  END

Locate a specific child in the tree and print it:

  my ($c) = $t->select(sub{$_[0] eq 'c'});

  is_deeply $c->print (sub{$_[0]}), <<END;
  c
  END

=head1 Description

Tree operations.


Version 20200628.


The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L<Index|/Index>.



=head1 Build

Create a tree.

=head2 new($user)

Create a new child recording the specified user data.

     Parameter  Description
  1  $user      User data to be recorded in the child

B<Example:>


  if (1)
   {my $t = Tree::Ops::𝗻𝗲𝘄 'a';
    for(1..2)
     {$t->open  ('b');
      $t->single('c');
      $t->close;
     }
    $t->single  ('d');
    is_deeply $t->print, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->select('c');
    is_deeply $c->print, <<END;
  c
  END
   }


This is a static method and so should either be imported or invoked as:

  Tree::Ops::new


=head2 open($tree, $user)

Add a child and make it the currently active scope into which new nodes are added.

     Parameter  Description
  1  $tree      Tree
  2  $user      User data to be recorded in the interior child being opened

B<Example:>


  if (1)
   {my $t = Tree::Ops::new 'a';
    for(1..2)
     {$t->𝗼𝗽𝗲𝗻  ('b');
      $t->single('c');
      $t->close;
     }
    $t->single  ('d');
    is_deeply $t->print, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->select('c');
    is_deeply $c->print, <<END;
  c
  END
   }


=head2 close($tree)

Close the current scope returning to the previous scope.

     Parameter  Description
  1  $tree      Tree

B<Example:>


  if (1)
   {my $t = Tree::Ops::new 'a';
    for(1..2)
     {$t->open  ('b');
      $t->single('c');
      $t->𝗰𝗹𝗼𝘀𝗲;
     }
    $t->single  ('d');
    is_deeply $t->print, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->select('c');
    is_deeply $c->print, <<END;
  c
  END
   }


=head2 single($tree, $user)

Add one child in the current scope.

     Parameter  Description
  1  $tree      Tree
  2  $user      User data to be recorded in the child being created

B<Example:>


  if (1)
   {my $t = Tree::Ops::new 'a';
    for(1..2)
     {$t->open  ('b');
      $t->𝘀𝗶𝗻𝗴𝗹𝗲('c');
      $t->close;
     }
    $t->𝘀𝗶𝗻𝗴𝗹𝗲  ('d');
    is_deeply $t->print, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->select('c');
    is_deeply $c->print, <<END;
  c
  END
   }


=head1 Navigation

Navigate through the tree.

=head2 first($parent)

Get the first child under the specified parent.

     Parameter  Description
  1  $parent    Parent

B<Example:>


    if (1) {


=head2 last($parent)

Get the last child under the specified parent.

     Parameter  Description
  1  $parent    Parent

B<Example:>


    if (1) {


=head2 next($child)

Get the next sibling following the specified child.

     Parameter  Description
  1  $child     Child

B<Example:>


    if (1) {


=head2 prev($child)

Get the previous sibling of the specified child.

     Parameter  Description
  1  $child     Child

B<Example:>


    if (1) {


=head1 Location

Navigate through the tree.

=head2 context($child)

Get the context of the current child.

     Parameter  Description
  1  $child     Child

B<Example:>


    if (1) {


=head2 singleChildOfParent($parent)

Return the only child of this parent if the parent has an only child, else B<undef>

     Parameter  Description
  1  $parent    Parent

B<Example:>


    if (1)


=head1 Put

Insert children into a tree.

=head2 putFirst($parent, $child)

Place a new child first under the specified parent and return the child.

     Parameter  Description
  1  $parent    Parent
  2  $child     Child

B<Example:>


    if (1) {


=head2 putLast($parent, $child)

Place a new child last under the specified parent and return the child.

     Parameter  Description
  1  $parent    Parent
  2  $child     Child

B<Example:>


    if (1) {


=head2 putNext($child, $new)

Place a new child after the specified child.

     Parameter  Description
  1  $child     Existing child
  2  $new       New child

B<Example:>


    if (1) {


=head2 putPrev($child, $new)

Place a new child before the specified child.

     Parameter  Description
  1  $child     Child
  2  $new       New child

B<Example:>


    if (1) {


=head1 Edit

Edit nodes in context.

=head2 cut($node)

Cut out a child and all its content and children, return it ready for reinsertion else where.

     Parameter  Description
  1  $node      Child

B<Example:>


    if (1) {


=head2 dup($parent)

Duplicate a parent and all its descendants.

     Parameter  Description
  1  $parent    Parent

B<Example:>


    if (1) {


=head2 unwrap($child)

Unwrap the specified child and return it

     Parameter  Description
  1  $child     Child

B<Example:>


    if (1) {


=head2 wrap($child, $new)

Wrap the specified child with a new parent and return the new parent.

     Parameter  Description
  1  $child     Child to wrap
  2  $new       New wrapping parent

B<Example:>


    if (1) {


=head1 Traverse

Traverse the tree.

=head2 by($tree, $sub)

Traverse a tree in order to process each child and return an array of the results of processing each node.

     Parameter  Description
  1  $tree      Tree
  2  $sub       Method to process a child

B<Example:>


    if (1) {


=head2 select($tree, $select)

Select matching children in a tree. A child can be selected via named value, array of values, a hash of values, a regular expression or a sub reference.

     Parameter  Description
  1  $tree      Tree
  2  $select    Method to select a child

B<Example:>


  if (1)
   {my $t = Tree::Ops::new 'a';
    for(1..2)
     {$t->open  ('b');
      $t->single('c');
      $t->close;
     }
    $t->single  ('d');
    is_deeply $t->print, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->𝘀𝗲𝗹𝗲𝗰𝘁('c');
    is_deeply $c->print, <<END;
  c
  END
   }


=head1 Print

Print the tree.

=head2 print($tree, $print)

String representation as a horizontal tree.

     Parameter  Description
  1  $tree      Tree
  2  $print     Optional print method

B<Example:>


  if (1)
   {my $t = Tree::Ops::new 'a';
    for(1..2)
     {$t->open  ('b');
      $t->single('c');
      $t->close;
     }
    $t->single  ('d');
    is_deeply $t->𝗽𝗿𝗶𝗻𝘁, <<END;
  a
    b
      c
    b
      c
    d
  END

    my ($c) = $t->select('c');
    is_deeply $c->𝗽𝗿𝗶𝗻𝘁, <<END;
  c
  END
   }


=head2 brackets($tree, $print, $separator)

Bracketed string representation of a tree.

     Parameter   Description
  1  $tree       Tree
  2  $print      Print method
  3  $separator  Child separator

B<Example:>


    if (1) {


=head1 Data Structures

Data structures use by this package.


=head2 Tree::Ops Definition


Child in the tree




=head3 Output fields


B<children> - Children of this child

B<lastChild> - Last active child

B<parent> - Parent for this child

B<user> - User data for this child



=head1 Private Methods

=head2 activeScope($tree)

Locate the active scope in a tree.

     Parameter  Description
  1  $tree      Tree

=head2 setParentOfChild($child, $parent)

Set the parent of a child and return the child.

     Parameter  Description
  1  $child     Child
  2  $parent    Parent

=head2 indexOfChildInParent($child)

Get the index of a child within the specified parent.

     Parameter  Description
  1  $child     Child


=head1 Index


1 L<activeScope|/activeScope> - Locate the active scope in a tree.

2 L<brackets|/brackets> - Bracketed string representation of a tree.

3 L<by|/by> - Traverse a tree in order to process each child and return an array of the results of processing each node.

4 L<close|/close> - Close the current scope returning to the previous scope.

5 L<context|/context> - Get the context of the current child.

6 L<cut|/cut> - Cut out a child and all its content and children, return it ready for reinsertion else where.

7 L<dup|/dup> - Duplicate a parent and all its descendants.

8 L<first|/first> - Get the first child under the specified parent.

9 L<indexOfChildInParent|/indexOfChildInParent> - Get the index of a child within the specified parent.

10 L<last|/last> - Get the last child under the specified parent.

11 L<new|/new> - Create a new child recording the specified user data.

12 L<next|/next> - Get the next sibling following the specified child.

13 L<open|/open> - Add a child and make it the currently active scope into which new nodes are added.

14 L<prev|/prev> - Get the previous sibling of the specified child.

15 L<print|/print> - String representation as a horizontal tree.

16 L<putFirst|/putFirst> - Place a new child first under the specified parent and return the child.

17 L<putLast|/putLast> - Place a new child last under the specified parent and return the child.

18 L<putNext|/putNext> - Place a new child after the specified child.

19 L<putPrev|/putPrev> - Place a new child before the specified child.

20 L<select|/select> - Select matching children in a tree.

21 L<setParentOfChild|/setParentOfChild> - Set the parent of a child and return the child.

22 L<single|/single> - Add one child in the current scope.

23 L<singleChildOfParent|/singleChildOfParent> - Return the only child of this parent if the parent has an only child, else B<undef>

24 L<unwrap|/unwrap> - Unwrap the specified child and return it

25 L<wrap|/wrap> - Wrap the specified child with a new parent and return the new parent.

=head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B<cpan>:

  sudo cpan install Tree::Ops

=head1 Author

L<philiprbrenan@gmail.com|mailto:philiprbrenan@gmail.com>

L<http://www.appaapps.com|http://www.appaapps.com>

=head1 Copyright

Copyright (c) 2016-2019 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.

=cut



# Tests and documentation

sub test
 {my $p = __PACKAGE__;
  binmode($_, ":utf8") for *STDOUT, *STDERR;
  return if eval "eof(${p}::DATA)";
  my $s = eval "join('', <${p}::DATA>)";
  $@ and die $@;
  eval $s;
  $@ and die $@;
  1
 }

test unless caller;

1;
# podDocumentation
__DATA__
use warnings FATAL=>qw(all);
use strict;
require v5.26;
use Test::More tests=>58;

#goto latestTest;

if (1)                                                                          #Tnew #Topen #Tsingle #Tclose #Tprint #Tselect
 {my $t = Tree::Ops::new 'a';
  for(1..2)
   {$t->open  ('b');
    $t->single('c');
    $t->close;
   }
  $t->single  ('d');
  is_deeply $t->print, <<END;
a
  b
    c
  b
    c
  d
END

  my ($c) = $t->select('c');
  is_deeply $c->print, <<END;
c
END
 }

if (1)
 {my $a = Tree::Ops::new('a');  is_deeply $a->brackets, 'a';
  my $b = $a->open      ('b');  is_deeply $b->brackets, 'b';
  my $c = $a->single    ('c');  is_deeply $c->brackets, 'c';
  my $B = $a->close;            is_deeply $B->brackets, 'b(c)';
  my $d = $a->open      ('d');  is_deeply $d->brackets, 'd';
  my $e = $a->single    ('e');  is_deeply $e->brackets, 'e';
  my $f = $a->single    ('f');  is_deeply $f->brackets, 'f';
  my $g = $a->single    ('g');  is_deeply $g->brackets, 'g';
  my $h = $a->single    ('h');  is_deeply $h->brackets, 'h';
  my $D = $a->close;            is_deeply $D->brackets, 'd(efgh)';
  my $i = $a->single    ('i');  is_deeply $i->brackets, 'i';
  my $j = $a->single    ('j');  is_deeply $j->brackets, 'j';

  if (1) {                                                                      #Tparent #Tfirst #Tlast #Tnext #Tprev
    is_deeply $a->brackets, 'a(b(c)d(efgh)ij)';
    is_deeply $c->parent,  $b;
    is_deeply $a->first,   $b;
    is_deeply $a->last,    $j;
    is_deeply $e->next,    $f;
    is_deeply $f->prev,    $e;
   }

  is_deeply $a->brackets, 'a(b(c)d(efgh)ij)';
  is_deeply $b->parent,  $a;
  is_deeply $c->parent,  $b;
  is_deeply $d->parent,  $a;
  is_deeply $a->first,   $b;
  is_deeply $a->last,    $j;
  is_deeply $d->first,   $e;
  is_deeply $d->last,    $h;
  is_deeply $e->next,    $f;
  is_deeply $f->prev,    $e;

  ok !$c->first;
  ok !$e->last;
  ok !$h->next;
  ok !$e->prev;

  if (1)                                                                        #TsingleChildOfParent
   {is_deeply $a->brackets, 'a(b(c)d(efgh)ij)';
    is_deeply $b->singleChildOfParent, $c;
   }

  if (1) {                                                                      #TputFirst #TputLast #TputNext #TputPrev
    is_deeply $a->brackets, 'a(b(c)d(efgh)ij)';

    my $z = $b->putNext(new 'z');
    is_deeply $z->brackets, 'z';
    is_deeply $a->brackets, 'a(b(c)zd(efgh)ij)';

    my $y = $d->putPrev(new 'y');
    is_deeply $y->brackets, 'y';
    is_deeply $a->brackets, 'a(b(c)zyd(efgh)ij)';

    $z->putLast(new 't');
    is_deeply $z->brackets, 'z(t)';
    is_deeply $a->brackets, 'a(b(c)z(t)yd(efgh)ij)';

    $z->putFirst(new 's');
    is_deeply $a->brackets, 'a(b(c)z(st)yd(efgh)ij)';
   }

  my ($y, $z) = map {$a->select($_)} 'y', 'z';
  is_deeply $y->brackets, 'y';
  is_deeply $z->brackets, 'z(st)';

  $y->putNext($z->cut);
  is_deeply $a->brackets, 'a(b(c)yz(st)d(efgh)ij)';

  my $x = $y->putFirst(new "x");
  is_deeply $a->brackets, 'a(b(c)y(x)z(st)d(efgh)ij)';

  if (1) {                                                                      #Tcut #Tunwrap #Twrap #Tcontext #Tby #Tdup
    is_deeply $a->brackets, 'a(b(c)y(x)z(st)d(efgh)ij)';

    is_deeply [map {$_->user} $x->context], [qw(x y a)];

    is_deeply join(' ', $a->by(sub{$_[0]->user})), "c b x y s t z e f g h d i j a";

    $z->cut;
    is_deeply $a->brackets, 'a(b(c)y(x)d(efgh)ij)';

    $y->unwrap;
    is_deeply $a->brackets, 'a(b(c)xd(efgh)ij)';

    $y = $x->wrap(new 'y');
    is_deeply $y->brackets, 'y(x)';
    is_deeply $a->brackets, 'a(b(c)y(x)d(efgh)ij)';

    $y->putNext($y->dup);
    is_deeply $a->brackets, 'a(b(c)y(x)y(x)d(efgh)ij)';
   }

  if (1) {                                                                      #Tbrackets
    is_deeply $a->brackets, 'a(b(c)y(x)y(x)d(efgh)ij)';
    is_deeply $a->print(sub{@_}), <<END;
a
  b
    c
  y
    x
  y
    x
  d
    e
    f
    g
    h
  i
  j
END
   }
 }

done_testing;
#   owf(q(/home/phil/z/z/z/zzz.txt), $dfa->dumpAsJson);
