package Web::Components::Navigation;

use Web::ComposableRequest::Constants qw( EXCEPTION_CLASS FALSE NUL SPC TRUE );

use HTTP::Status          qw( HTTP_OK );
use Unexpected::Types     qw( ArrayRef Bool HashRef Object PositiveInt Str );
use Web::Components::Util qw( clear_redirect formpost throw );
use Ref::Util             qw( is_hashref );
use Scalar::Util          qw( blessed );
use Type::Utils           qw( class_type );
use Unexpected::Functions qw( UnknownMethod Unspecified );
use HTML::Tiny;
use JSON::MaybeXS;
use Try::Tiny;
use Moo;

=encoding utf-8

=head1 Name

Web::Components::Navigation - Context sensitive menu builder

=head1 Synopsis

   use Web::Components::Navigation;

=head1 Description

Context sensitive menu builder

=head2 JavaScript

Files F<wcom-*.js> are included in the F<share/js> directory of the source
tree. These will be installed to the F<File::ShareDir> distribution level
shared data files. Nothing further is done with these files. They should be
concatenated in sort order by filename and the result placed under the
webservers document root. Link to this from the web applications pages. Doing
this is outside the scope of this distribution

=head1 Configuration and Environment

Defines the following attributes;

=over 3

=item C<confirm_message>

Immutable string. The default "Are you sure ?" message

=cut

has 'confirm_message' => is => 'ro', isa => Str, default => 'Are you sure ?';

=item C<container_class>

Lazy string combining C<container_name> and C<container_layout>. This can be
applied as a class name to the HTML container element by the application's
page layout template

=cut

has 'container_class' =>
   is      => 'lazy',
   isa     => Str,
   default => sub {
      my $self = shift;

      return $self->container_name . SPC . $self->container_layout;
   };

=item C<container_layout>

A mutable string which defaults to C<centred>. Used as a class name in the HTML
it is also shared with the JS code

=cut

has 'container_layout' => is => 'rw', isa => Str, default => 'centred';

=item C<container_name>

An immutable string which defaults to C<standard>. Used as a class name in the
HTML it is also shared with the JS code

=cut

has 'container_name' => is => 'ro', isa => Str, default => 'standard';

=item C<container_tag>

An immutable string which default to C<div>. The HTML element to render

=cut

has 'container_tag' => is => 'ro', isa => Str, default => 'div';

=item C<content_name>

An immutable string which defaults to C<panel>. Used as an id and a class name
in the HTML it is also shared with the JS code

=cut

has 'content_name' => is => 'ro', isa => Str, default => 'panel';

=item C<context>

An immutable required weak reference to the C<context> object

=cut

has 'context' =>
   is       => 'ro',
   isa      => Object,
   required => TRUE,
   weak_ref => TRUE;

=item C<control_icon>

An immutable string which defaults to C<user-settings>. The name of the symbol
in the SVG icons file for the user settings menu

=cut

has 'control_icon' => is => 'ro', isa => Str, default => 'user-settings';

=item C<global>

An immutable array reference with an empty default. Contains a list of action
paths used to create the top level of the navigation menus. It is expected
that this will be populated at object construction time

=cut

has 'global' => is => 'ro', isa => ArrayRef, default => sub { [] };

=item C<icons>

A lazy string representation of a partial URI. This should point to an SVG file
containing named symbols. Defaults to C<< img/icons.svg >>

=cut

has 'icons' =>
   is       => 'lazy',
   isa      => Str,
   init_arg => undef,
   default  => sub {
      my $self = shift;

      return $self->context->request->uri_for($self->_icons)->as_string;
   };

has '_icons' =>
   is       => 'ro',
   isa      => Str,
   init_arg => 'icons',
   default  => 'img/icons.svg';

=item C<json_view>

An immutable string which defaults to C<json>. Stashed by C<finalise> as the
view which will serialise the response as JSON

=cut

has 'json_view' => is => 'ro', isa => Str, default => 'json';

=item C<link_display>

A lazy string which defaults to either the value is the C<session> if it
exists or the string C<both>. An enumerated type with values; C<both>, C<icon>,
or C<text>. Controls how the C<global> menu display links

=cut

has 'link_display' =>
   is       => 'lazy',
   isa      => Str,
   init_arg => undef,
   default  => sub {
      my $self = shift;
      my $session = $self->context->session;

      return $session->link_display || $self->_link_display;
   };

has '_link_display' =>
   is       => 'ro',
   isa      => Str,
   init_arg => 'link_display',
   default  => 'both';

=item C<logo>

A optional lazy string representation of a partial URI with a null
default. This should point to an image file containing the logo if one is
required

=cut

has 'logo' =>
   is       => 'lazy',
   isa      => Str,
   init_arg => undef,
   default  => sub {
      my $self = shift;

      return $self->context->request->uri_for($self->_logo)->as_string
         if $self->_logo;

      return NUL;
   };

has '_logo' => is => 'ro', isa => Str, init_arg => 'logo', default => NUL;

=item C<media_break>

An immutable positive integer with a default of C<680> pixels. When the
display window's <innerWidth> drop below this (due to a resize event)
C<link_display> is set to C<icon> which reduces the display width requirement

=cut

has 'media_break' => is => 'ro', isa => PositiveInt, default => 680;

=item C<menu_location>

A lazy string which defaults to C<header>. Can be set to C<sidebar>. Effects
where the navigation menus are rendered

=cut

has 'menu_location' =>
   is       => 'lazy',
   isa      => Str,
   init_arg => undef,
   default  => sub {
      my $self    = shift;
      my $session = $self->context->session;

      return $session->menu_location || $self->_menu_location;
   };

has '_menu_location' =>
   is       => 'ro',
   isa      => Str,
   init_arg => 'menu_location',
   default  => 'header';

=item C<message_action>

An immutable string which defaults to C<api/navigation_messages>. This is the
action path for the API call that the message object in the JS will make to
collect messages

=cut

has 'message_action' =>
   is      => 'ro',
   isa     => Str,
   default => 'api/navigation_messages';

=item C<messages>

An immutable hash reference with an empty default. The attributes are used to
configure the JS message collection and display code. Attributes are;

=over 3

=item buffer-limit

Maximum number of messages to buffer. Defaults to C<3>

=item display-time

How long in seconds to display each message for. Defaults to C<20> seconds

=back

=cut

has 'messages' => is => 'ro', isa => HashRef, default => sub { {} };

=item C<model>

An immutable required object reference to the model component that is handling
the current request

=cut

has 'model' => is => 'ro', isa => Object, required => TRUE;

=item C<title>

An immutable string which defaults to null. If set will be displayed as the
application title along with the logo in the page header

=cut

has 'title' => is => 'ro', isa => Str, default => NUL;

=item C<title_abbrev>

An immutable string which defaults to C<Nav>. Used to set the pages C<title>
attribute in the HTML head. This is used in turn is used by the browser to
create history links (the back button). Would set this from configuration to
the abbreviation for the application

=cut

has 'title_abbrev' => is => 'ro', isa => Str, default => 'Nav';

=item C<title_entry>

A lazy string. The default constructor sets it to the current pages navigation
label. This is appended to C<title_abbrev> to form the labels in the browser
history

=cut

has 'title_entry' =>
   is      => 'lazy',
   isa     => Str,
   default => sub {
      my $self  = shift;
      my @parts = split m{ / }mx, $self->context->action;
      my $label = $self->_get_nav_label($parts[0] . '/' . $parts[-1]);

      return (split m{ \| }mx, $label)[0] // NUL;
   };

# Private attributes
has '_base_url' =>
   is      => 'lazy',
   isa     => class_type('URI'),
   default => sub {
      return shift->context->request->uri_for(NUL);
   };

has '_container' =>
   is      => 'lazy',
   isa     => Str,
   default => sub {
      my $self = shift;
      my $tag  = $self->container_tag;

      return $self->_html->$tag($self->_data);
   };

has '_data' =>
   is      => 'lazy',
   isa     => HashRef,
   default => sub {
      my $self     = shift;
      my $location = 'navigation-'  . $self->menu_location;
      my $display  = 'link-display-' . $self->link_display;

      return {
         'id'    => 'navigation',
         'class' => "navigation ${location} ${display}",
         'data-navigation-config' => $self->_json->encode({
            'menus'      => $self->_menus,
            'messages'   => $self->_messages,
            'moniker'    => $self->model->moniker,
            'properties' => {
               'base-url'         => $self->_base_url,
               'confirm'          => $self->confirm_message,
               'container-layout' => $self->container_layout,
               'container-name'   => $self->container_name,
               'content-name'     => $self->content_name,
               'control-icon'     => $self->control_icon,
               'icons'            => $self->icons,
               'link-display'     => $self->link_display,
               'location'         => $self->menu_location,
               'logo'             => $self->logo,
               'media-break'      => $self->media_break,
               'skin'             => $self->context->session->skin,
               'title'            => $self->title,
               'title-abbrev'     => $self->title_abbrev,
               'verify-token'     => $self->context->verification_token,
               'version'          => MCat->VERSION,
            },
         }),
      };
   };

has '_html' =>
   is      => 'ro',
   isa     => class_type('HTML::Tiny'),
   default => sub { HTML::Tiny->new };

has '_json' =>
   is      => 'ro',
   isa     => class_type(JSON::MaybeXS::JSON),
   default => sub {
      return JSON::MaybeXS->new( convert_blessed => TRUE, utf8 => FALSE );
   };

has '_lists' => is => 'ro', isa => HashRef, default => sub { {} };

has '_menus' =>
   is      => 'lazy',
   isa     => HashRef,
   default => sub {
      my $self = shift;

      return { map { $_ => $self->_lists->{$_} } @{$self->_order} };
   };

has '_messages' =>
   is      => 'lazy',
   isa     => HashRef,
   default => sub {
      my $self    = shift;
      my $context = $self->context;

      return {
         %{$self->messages},
         'messages-url' => $context->uri_for_action($self->message_action)
      };
   };

has '_name' => is => 'rwp', isa => Str, default => NUL;

has '_order' => is => 'ro', isa => ArrayRef, default => sub { [] };

=back

=head1 Subroutines/Methods

Defines the following methods;

=over 3

=item C<BUILDARGS>

Wraps around the constructor call. If the C<context> object has a reference to
the C<config> object which has a reference to a C<navigation> attribute, then
that hash reference is merged into the attributes passed to the constructor

=cut

around 'BUILDARGS' => sub {
   my ($orig, $self, @args) = @_;

   my $attr    = $orig->($self, @args);
   my $context = $attr->{context};

   throw Unspecified, ['context'] unless $context;

   return $attr unless $context->can('config');

   my $config = $context->config;

   throw UnknownMethod, [blessed $config, 'navigation']
      unless $config->can('navigation');

   return { %{$attr}, %{$config->navigation} };
};

=item C<crud>

   $self = $self->crud($moniker, $existing_id, $create_id);

A convenience method which calls C<item> up to four times. If C<create_id> is
passed C<item> is called with an action path of C<moniker/create>. The
C<existing_id> is required and C<item> is called three times with the action
paths; C<moniker/delete>, C<moniker/edit> and C<moniker/view>

=cut

sub crud {
   my ($self, $moniker, $existing_id, $create_id) = @_;

   $self->item("${moniker}/create", [$create_id]) if $create_id;
   $self->item(formpost, "${moniker}/delete", [$existing_id]);
   $self->item("${moniker}/edit", [$existing_id]);
   $self->item("${moniker}/view", [$existing_id]);
   return $self;
}

=item C<finalise>

Populates the stash with the data that represents the menu which will be
serialised to JSON

=cut

sub finalise {
   my $self    = shift;
   my $context = $self->context;
   my $request = $context->request;

   return unless $self->is_script_request
      && $request->query_parameters->{navigation};

   $self->_add_global;

   my $data = {
      'container-layout' => $self->container_layout,
      'menus'            => $self->_menus,
      'title-entry'      => $self->title_entry,
      'verify-token'     => $context->verification_token,
   };

   $context->stash(
      code      => HTTP_OK,
      finalised => TRUE,
      json      => $data,
      view      => $self->json_view
   );
   return;
}

=item C<finalise_script_request>

If C<is_script_request> is true then stash an OK HTTP return code. When using
JS navigation all HTTP responses must be OK or the browser (which sniffs the
fetch responses) will automatically navigate

=cut

sub finalise_script_request {
   my $self = shift;

   $self->context->stash(code => HTTP_OK) if $self->is_script_request;

   return;
}

=item C<is_script_request>

Returns true if the request has come from the JS in the browser

=cut

sub is_script_request {
   my $self   = shift;
   my $header = $self->context->request->header('x-requested-with') // NUL;

   return lc $header eq 'xmlhttprequest' ? TRUE : FALSE;
}

=item C<item>

   $self = $self->item('action path', $args, $params);
   $self = $self->item(formpost, 'action path', $args, $params);

The first example will add a single link to the current C<list>. The display
text is set by the C<Nav> subroutine attribute of the endpoint, the C<href>
is supplied by C<context> C<uri_for_action>

In the second example C<formpost> is imported from L<Web::Components::Util>
and causes the rendered menu item to be a form with a button on it (it is
expected that this will be styled like a link). This is used for delete
operations since we don't do deletes with a GET

=cut

sub item {
   my ($self, @args) = @_;

   my $label;

   if (is_hashref $args[0]) {
      $label = shift @args;
      $label->{name} = $self->_get_nav_label($args[0]);
   }
   else { $label = $self->_get_nav_label($args[0]) }

   if ($self->model->is_authorised($self->context, $args[0])) {
      my $list = $self->_lists->{$self->_name}->[1];
      my ($text, $icon);

      if (is_hashref $label) {
         ($text, $icon) = split m{ \| }mx, $label->{name};
         $label->{name} = $text;
         $text = $label;
      }
      else { ($text, $icon) = split m{ \| }mx, $label }

      $icon = $self->context->request->uri_for($icon)
         if $icon && $icon =~ m{ / }mx;

      push @{$list}, [$text => $self->_uri(@args), $icon];
   }
   else { clear_redirect $self->context }

   return $self;
}

=item C<list>

   $self = $self->list('list name', 'optional title');

Sets the current list to the name provided. If this list does not exist it
is created. Once a list has been created C<item> is called to add entries to it

=cut

sub list {
   my ($self, $name, $title) = @_;

   $self->_set__name($name);

   unless (exists $self->_lists->{$name}) {
      $self->_lists->{$name} = [ $title // NUL, [] ];
      push @{$self->_order}, $name;
   }

   return $self;
}

=item C<menu>

   $self = $self->menu('list name');

If the named list exists add it to the current list. This is how you created
nested lists

=cut

sub menu {
   my ($self, $name) = @_;

   my $lists = $self->_lists;

   push @{$lists->{$self->_name}->[1]}, $name if exists $lists->{$name};

   return $self;
}

=item C<render>

Returns the HTML for inclusion on the web page

=cut

sub render {
   my $self = shift;
   my $output;

   $self->_add_global;

   try   { $output = $self->_container }
   catch { $output = $_ };

   return $output;
}

# Private methods
sub _add_global {
   my $self = shift;
   my $list = $self->list('_global');

   for my $action (@{$self->global}) {
      my ($moniker, $method) = split m{ / }mx, $action;

      if ($self->model->is_authorised($self->context, $action)) {
         if ($method and $method eq 'menu') {
            $self->context->models->{$moniker}->menu($self->context);
            $self->_set__name('_global');
         }

         push @{$self->_lists->{$self->_name}->[1]}, $moniker
            if exists $self->_lists->{$moniker};

         $list->item($action);
      }
      else { clear_redirect $self->context }
   }

   return;
}

sub _get_nav_label {
   my ($self, $action) = @_;

   my $attr = try { $self->context->get_attributes($action) };

   return $attr->{Nav}->[0] if $attr && defined $attr->{Nav};

   return NUL;
}

sub _uri {
   my ($self, @args) = @_;

   my $action = $args[0];

   return NUL if $action =~ m{ /menu \z }mx;

   return $self->context->uri_for_action(@args);
}

use namespace::autoclean;

1;

__END__

=back

=head1 Diagnostics

None

=head1 Dependencies

=over 3

=item L<Moo>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module. Please report problems to
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Web-Components.
Patches are welcome

=head1 Acknowledgements

Larry Wall - For the Perl programming language

=head1 Author

Peter Flanigan, C<< <pjfl@cpan.org> >>

=head1 License and Copyright

Copyright (c) 2024 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End:
# vim: expandtab shiftwidth=3: