The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl
use strict;
use warnings;

use Test::More tests => 13;

use Sort::ByExample
  sbe    => undef,
  sorter => { -as => 'alpha_sort', example => [ qw(first second third) ] },
  cmp    => { -as => 'alpha_cmp',  example => [ qw(first second third) ] };

{
  my @example = qw(
    foo
    bar
    baz
    quux
    pantalones
  );

  my @input  = qw(foo bar bar x foo quux foo pantalones garbage);

  {
    # We'll sort by example, falling back to sorting by length.
    my @expect = qw(foo foo foo bar bar quux pantalones x garbage);

    my $sorter = sbe(\@example, sub { length $_[0] <=> length $_[1] });
    my @sorted = $sorter->(@input);

    # diag "IN:   @input";
    # diag "OUT:  @sorted";
    # diag "WANT: @expect";
    is_deeply(\@sorted, \@expect, "it sorted as we wanted");
  }

  {
    # We'll sort by example, falling back to sorting by length.
    my @expect = qw(foo foo foo bar bar quux pantalones garbage x);

    my $sorter = sbe(\@example, sub { length $_[1] <=> length $_[0] });
    my @sorted = $sorter->(@input);

    # diag "IN:   @input";
    # diag "OUT:  @sorted";
    # diag "WANT: @expect";
    is_deeply(\@sorted, \@expect, "it sorted as we wanted");
  }
}

{
  # We'll sort by example, falling back to sorting by length.
  my $example = { x => 1, xyzzy => 1, bar => 2 };
  my @input   = qw(x xyzzy crap xyzzy bar bar lemon x x xyzzy);
  my @expect  = qw(x x x xyzzy xyzzy xyzzy bar bar crap lemon);

  my $sorter = sbe($example, sub { length $_[0] <=> length $_[1] });
  my @sorted = $sorter->(@input);

  # diag "IN:   @input";
  # diag "OUT:  @sorted";
  # diag "WANT: @expect";
  is_deeply(\@sorted, \@expect, "it sorted as we wanted");
}

{
  # We'll sort by example, falling back to sorting by length (named args).
  my $example = { x => 1, xyzzy => 1, bar => 2 };
  my @input   = qw(x xyzzy crap xyzzy bar bar lemon x x xyzzy);
  my @expect  = qw(x x x xyzzy xyzzy xyzzy bar bar crap lemon);

  my $sorter = sbe(
    $example,
    { fallback => sub { length $_[0] <=> length $_[1] } },
  );
  my @sorted = $sorter->(@input);

  # diag "IN:   @input";
  # diag "OUT:  @sorted";
  # diag "WANT: @expect";
  is_deeply(\@sorted, \@expect, "it sorted as we wanted");
}

{
  eval { sbe('scalars are invalid'); };
  like($@, qr/invalid/, 'we throw an exception for non-% non-@ example');
}

{
  # We'll sort codename alpha after the example.
  my $example = [ qw(charlie alfa bravo) ];
  my @input   = (
    { name => 'Bertrand', codename => 'bravo'   },
    { name => 'Dracover', codename => 'zulu',   },
    { name => 'Cheswick', codename => 'charlie' },
    { name => 'Elbereth', codename => 'yankee'  },
    { name => 'Algernon', codename => 'alfa'    },
  );
  my @expect  = (
    { name => 'Cheswick', codename => 'charlie' },
    { name => 'Algernon', codename => 'alfa'    },
    { name => 'Bertrand', codename => 'bravo'   },
    { name => 'Elbereth', codename => 'yankee'  },
    { name => 'Dracover', codename => 'zulu',   },
  );

  my $fallback = sub {
    my ($x, $y) = @_;
    return $x cmp $y;
  };

  my $sorter = sbe(
    $example,
    {
      fallback => $fallback,
      xform    => sub { $_[0]->{codename} },
    },
  );

  my @sorted = $sorter->(@input);

  is_deeply(\@sorted, \@expect, "hashrefs sorted as we wanted");
}

{
  # We'll sort name alpha  after the example.
  my $example = [ qw(charlie alfa bravo) ];
  my @input   = (
    { name => 'Bertrand', codename => 'bravo'   },
    { name => 'Dracover', codename => 'zulu',   },
    { name => 'Cheswick', codename => 'charlie' },
    { name => 'Elbereth', codename => 'yankee'  },
    { name => 'Algernon', codename => 'alfa'    },
  );
  my @expect  = (
    { name => 'Cheswick', codename => 'charlie' },
    { name => 'Algernon', codename => 'alfa'    },
    { name => 'Bertrand', codename => 'bravo'   },
    { name => 'Dracover', codename => 'zulu',   },
    { name => 'Elbereth', codename => 'yankee'  },
  );

  my $fallback = sub {
    my ($x_xf, $y_xf, $x, $y) = @_;
    return $x->{name} cmp $y->{name};
  };

  my $sorter = sbe(
    $example,
    {
      fallback => $fallback,
      xform    => sub { $_[0]->{codename} },
    },
  );

  my @sorted = $sorter->(@input);

  is_deeply(\@sorted, \@expect, "hashrefs sorted as we wanted");
}

{
  my $example = [ qw(first fifth fourth third second sixth) ];

  is_deeply(
    [ alpha_sort(@$example) ],
    [ qw(first second third fifth fourth sixth) ],
    "alpha_sort installed routine",
  );

  is(
    alpha_cmp('second', 'first'),
    1,
    "alpha_cmp on two args",
  );

  is_deeply(
    [ sort { alpha_cmp($a, $b) } @$example ],
    [ qw(first second third fifth fourth sixth) ],
    "alpha_cmp installed routine",
  );

  is_deeply(
    [ sort alpha_cmp @$example ],
    [ qw(first second third fifth fourth sixth) ],
    "alpha_cmp installed routine",
  );
}

{
  use Sort::ByExample
   cmp    => { -as => 'by_eng',   example => [qw(first second third fourth)] },
   sorter => { -as => 'eng_sort', example => [qw(first second third fourth)] };

  my @example = qw(first second third fourth);
  my $sorter = sbe(\@example);

  is_deeply(
    [ eng_sort(qw(second third unknown fourth first)) ],
    [ qw(first second third fourth unknown) ],
    'sorter from synopsis',
  );

  is_deeply(
    [ sort by_eng qw(second third unknown fourth first) ],
    [ qw(first second third fourth unknown) ],
    'sort cmp LIST from synopsis',
  );
}