package Markdent::Role::HTMLStream;
{
  $Markdent::Role::HTMLStream::VERSION = '0.22';
}

use strict;
use warnings;
use namespace::autoclean;

use HTML::Stream;
use Markdent::Types qw(
    HeaderLevel Str Bool HashRef
    TableCellAlignment PosInt
    OutputStream
);
use MooseX::Params::Validate qw( validated_list validated_hash );

use Moose::Role;

with 'Markdent::Role::EventsAsMethods';

requires qw( start_document end_document );

has _output => (
    is       => 'ro',
    isa      => OutputStream,
    required => 1,
    init_arg => 'output',
);

has _stream => (
    is       => 'ro',
    isa      => 'HTML::Stream',
    init_arg => undef,
    lazy     => 1,
    default  => sub { HTML::Stream->new( $_[0]->_wrapped_output() ) },
);

sub start_header {
    my $self = shift;
    my ($level) = validated_list(
        \@_,
        level => { isa => HeaderLevel },
    );

    my $tag = 'h' . $level;

    $self->_stream()->tag($tag);
}

sub end_header {
    my $self = shift;
    my ($level) = validated_list(
        \@_,
        level => { isa => HeaderLevel },
    );

    my $tag = '_h' . $level;

    $self->_stream()->tag($tag);
}

sub start_blockquote {
    my $self = shift;

    $self->_stream()->tag('blockquote');
}

sub end_blockquote {
    my $self = shift;

    $self->_stream()->tag('_blockquote');
}

sub start_unordered_list {
    my $self = shift;

    $self->_stream()->tag('ul');
}

sub end_unordered_list {
    my $self = shift;

    $self->_stream()->tag('_ul');
}

sub start_ordered_list {
    my $self = shift;

    $self->_stream()->tag('ol');
}

sub end_ordered_list {
    my $self = shift;

    $self->_stream()->tag('_ol');
}

sub start_list_item {
    my $self = shift;

    $self->_stream()->tag('li');
}

sub end_list_item {
    my $self = shift;

    $self->_stream()->tag('_li');
}

sub code_block {
    my $self = shift;
    my ( $code, $language ) = validated_list(
        \@_,
        code     => { isa => Str },
        language => { isa => Str, optional => 1 },
    );

    $self->_stream()->tag('pre');

    my @class = $language ? ( class => 'language-' . $language ) : ();
    $self->_stream()->tag( 'code', @class );

    $self->_stream()->text($code);

    $self->_stream()->tag('_code');
    $self->_stream()->tag('_pre');
}

sub preformatted {
    my $self = shift;
    my ($text) = validated_list( \@_, text => { isa => Str }, );

    $self->_stream()->tag('pre');
    $self->_stream()->tag('code');
    $self->_stream()->text($text);
    $self->_stream()->tag('_code');
    $self->_stream()->tag('_pre');
}

sub start_paragraph {
    my $self = shift;

    $self->_stream()->tag('p');
}

sub end_paragraph {
    my $self = shift;

    $self->_stream()->tag('_p');
}

sub start_table {
    my $self = shift;
    my ($caption) = validated_list(
        \@_,
        caption => { isa => Str, optional => 1 },
    );

    $self->_stream()->tag('table');

    if ( defined $caption && length $caption ) {
        $self->_stream()->tag('caption');
        $self->_stream()->text($caption);
        $self->_stream()->tag('_caption');
    }
}

sub end_table {
    my $self = shift;

    $self->_stream()->tag('_table');
}

sub start_table_header {
    my $self = shift;

    $self->_stream()->tag('thead');
}

sub end_table_header {
    my $self = shift;

    $self->_stream()->tag('_thead');
}

sub start_table_body {
    my $self = shift;

    $self->_stream()->tag('tbody');
}

sub end_table_body {
    my $self = shift;

    $self->_stream()->tag('_tbody');
}

sub start_table_row {
    my $self = shift;

    $self->_stream()->tag('tr');
}

sub end_table_row {
    my $self = shift;

    $self->_stream()->tag('_tr');
}

sub start_table_cell {
    my $self = shift;
    my ( $alignment, $colspan, $is_header ) = validated_list(
        \@_,
        alignment      => { isa => TableCellAlignment, optional => 1 },
        colspan        => { isa => PosInt },
        is_header_cell => { isa => Bool },
    );

    my $tag = $is_header ? 'th' : 'td';

    my %attr = ( align => $alignment );
    $attr{colspan} = $colspan
        if $colspan != 1;

    $self->_stream()->tag( $tag, %attr );
}

sub end_table_cell {
    my $self = shift;
    my ($is_header) = validated_hash(
        \@_,
        is_header_cell => { isa => Bool },
    );

    $self->_stream()->tag( $is_header ? '_th' : '_td' );
}

sub start_emphasis {
    my $self = shift;

    $self->_stream()->tag('em');
}

sub end_emphasis {
    my $self = shift;

    $self->_stream()->tag('_em');
}

sub start_strong {
    my $self = shift;

    $self->_stream()->tag('strong');
}

sub end_strong {
    my $self = shift;

    $self->_stream()->tag('_strong');
}

sub start_code {
    my $self = shift;

    $self->_stream()->tag('code');
}

sub end_code {
    my $self = shift;

    $self->_stream()->tag('_code');
}

sub auto_link {
    my $self = shift;
    my ($uri) = validated_list(
        \@_,
        uri => { isa => Str, optional => 1 },
    );

    $self->_stream()->tag( 'a', href => $uri );
    $self->_stream()->text($uri);
    $self->_stream()->tag('_a');
}

sub start_link {
    my $self = shift;
    my %p    = validated_hash(
        \@_,
        uri            => { isa => Str },
        title          => { isa => Str, optional => 1 },
        id             => { isa => Str, optional => 1 },
        is_implicit_id => { isa => Bool, optional => 1 },
    );

    delete @p{ grep { !defined $p{$_} } keys %p };

    $self->_stream()->tag(
        'a', href => $p{uri},
        exists $p{title} ? ( title => $p{title} ) : (),
    );
}

sub end_link {
    my $self = shift;

    $self->_stream()->tag('_a');
}

sub line_break {
    my $self = shift;

    $self->_stream()->tag('br');
}

sub text {
    my $self = shift;
    my ($text) = validated_list( \@_, text => { isa => Str }, );

    $self->_stream()->text($text);
}

sub start_html_tag {
    my $self = shift;
    my ( $tag, $attributes ) = validated_list(
        \@_,
        tag        => { isa => Str },
        attributes => { isa => HashRef },
    );

    $self->_stream()->tag( $tag, %{$attributes} );
}

sub html_comment_block {
    my $self = shift;
    my ($text) = validated_list(
        \@_,
        text => { isa => Str },
    );

    # HTML::Stream->comment() adds extra whitespace for no good reason.
    $self->_output()->print( '<!--' . $text . '-->' . "\n" );
}

sub html_comment {
    my $self = shift;
    my ($text) = validated_list(
        \@_,
        text => { isa => Str },
    );

    # HTML::Stream->comment() adds extra whitespace for no good reason.
    $self->_output()->print( '<!--' . $text . '-->' );
}

sub html_tag {
    my $self = shift;
    my ( $tag, $attributes ) = validated_list(
        \@_,
        tag        => { isa => Str },
        attributes => { isa => HashRef },
    );

    $self->_stream()->tag( $tag, %{$attributes} );
}

sub end_html_tag {
    my $self = shift;
    my ($tag) = validated_list(
        \@_,
        tag => { isa => Str },
    );

    $self->_stream()->tag( q{_} . $tag );
}

sub html_entity {
    my $self = shift;
    my ($entity) = validated_list( \@_, entity => { isa => Str }, );

    $self->_stream()->ent($entity);
}

sub html_block {
    my $self = shift;
    my ($html) = validated_list( \@_, html => { isa => Str }, );

    $self->_output()->print($html);
}

sub image {
    my $self = shift;
    my %p    = validated_hash(
        \@_,
        alt_text       => { isa => Str },
        uri            => { isa => Str, optional => 1 },
        title          => { isa => Str, optional => 1 },
        id             => { isa => Str, optional => 1 },
        is_implicit_id => { isa => Bool, optional => 1 },
    );

    delete @p{ grep { !defined $p{$_} } keys %p };

    $self->_stream()->tag(
        'img', src => $p{uri},
        ( exists $p{alt_text} ? ( alt   => $p{alt_text} ) : () ),
        ( exists $p{title}    ? ( title => $p{title} )    : () ),
    );
}

sub horizontal_rule {
    my $self = shift;

    $self->_stream()->tag('hr');
}

sub _wrapped_output {
    my $self = shift;

    my $output = $self->_output();
    return $output if blessed $output && ! $output->isa('IO::Handle');

    return _CheckedOutput->new($output);
}

package
    _CheckedOutput;

use strict;
use warnings;

sub new {
    my $class  = shift;
    my $output = shift;

    return bless \$output, $class;
}

sub print {
    my $self = shift;

    # We don't need warnings from IO::* about printing to closed handles when
    # we'll die in that case anyway.
    no warnings 'io';
    print { ${$self} } @_ or die "Cannot write to handle: $!";
}

1;

# ABSTRACT: A role for handlers which generate HTML



=pod

=head1 NAME

Markdent::Role::HTMLStream - A role for handlers which generate HTML

=head1 VERSION

version 0.22

=head1 DESCRIPTION

This role implements most of the code needed for event receivers which
generate a stream of HTML output based on those events.

=head1 REQUIRED METHODS

This role requires that consuming classes implement two methods, C<<
$handler->start_document() >> and C<< $handler->end_document() >>.

=head1 ROLES

This role does the L<Markdent::Role::EventsAsMethods> and
L<Markdent::Role::Handler> roles.

=head1 BUGS

See L<Markdent> for bug reporting details.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Dave Rolsky.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__