path: root/bin/hedgedoc2quarto

#!/usr/bin/perl

use v5.36;
use strict;
use utf8;

=head1 NAME

hedgedoc2quarto - convert HedgeDoc content to Quarto

=head1 VERSION

Version 0.0.1

=head1 SYNOPSIS

    hedgedoc2quarto INFILE OUTFILE

    hedgedoc2quarto < INFILE > OUTFILE

=head1 DESCRIPTION

B<hedgedoc2quarto> reformats text content
from HedgeDoc- to Quarto-flavored Markdown,
and adapts embedded diagram code.

Both HedgeDoc and Quarto uses Markdown,
but different flavors,
and whereas both handle (different subsets of) Mermaid diagrams,
Quarto also (through plugins) handles PlantUML diagrams.

=cut

# slurp INFILE if passed as first argument, or else STDIN
my ( $infile, $outfile, $bogus ) = @ARGV;
die 'Too many arguments: expected INFILE and OUTFILE' if $bogus;
@ARGV = ($infile) if $infile;
my $content = do { local $/ = undef; <> };

$content =~ s/^
        (?'fence'[``~]{3,})\s*
        \Kmermaid\n
        (?'type'gantt)\n
        (?'code'.*?\n)
        \k'fence'
    $/

# FIXME: implement option to choose output diagram language
#   "{mermaid}\n\%\%| fig-width: 100\%\n"
#   . &mmd2mmd( $+{type}, $+{code} )
    "{.plantuml}\n\%\%| fig-width: 100\%\n"
    . &mmd2puml( $+{type}, $+{code} )
    . $+{fence}
    /gsmex;

if ($outfile) {
    open( FH, '>', $outfile ) or die $!;
    print FH $content;
}
else {
    print $content;
}

sub mmd2mmd ( $type, $code )
{

    # strip special comment marker '%%QUARTO%%'
    $code =~ s/^\s*+\K%%QUARTO%%//gm;

    return "$type\n$code";
}

sub mmd2puml ( $type, $code )
{
    my @newcode;

    # strip special comment marker '%%QUARTO%%'
    $code =~ s/^\s*+\K%%QUARTO%%//gm;

    open my $fh, '<', \$code or die $!;

    while (<$fh>) {

        /^\s*+$/
            and push @newcode, ''
            and next;

        /^(\s*+)%%PLANTUML%%\K.*/
            and push @newcode, "$1$&"
            and next;

        # convert comments markers
        /^(\s*+)(?:[%]{2,}(?'comment'\s*+))?+\K.*/;
        my $indent = defined( $+{comment} ) ? "$1'$2" : $1;
        $_ = $&;

        /^title\s/i
            and push @newcode, "${indent}$_"
            and next;

        /^excludes\s+weekends\b/i
            and push @newcode, "${indent}saturday are closed"
            and push @newcode, "${indent}sunday are closed"
            and next;
        /^weekday\s+\K(?:mon|tues|wednes|thurs|fri|satur|sun)day\b/i
            and push @newcode, "${indent}weeks start on $&"
            and next;
        /^(?:date|axis)Format\s/i
            and push @newcode, "${indent}'UNSUPPORTED: $_"
            and next;
        /^todayMarker\s+(off|on)\b/i
            and push @newcode, "${indent}'UNSUPPORTED' $_"
            and next;
        /^section\s+\K\S+(?:\s+\S+)*/i
            and push @newcode, "${indent}-- $& --"
            and next;

        if (/^tickInterval\s+(?'tickAmount'\d+)(?'tickUnit'millisecond|second|minute|hour|day|week|month)\s*$/i
            )
        {
            push @newcode, "${indent}projectscale daily"
                and next
                if $+{tickAmount} eq 1
                and $+{tickUnit} eq 'day';
            push @newcode, "${indent}projectscale weekly" and next
                if $+{tickAmount} eq 1 and $+{tickUnit} eq 'week'
                or $+{tickAmount} eq 7 and $+{tickUnit} eq 'day';
            push @newcode, "${indent}projectscale monthly"
                and next
                if $+{tickAmount} eq 1
                and $+{tickUnit} eq 'month';
            push @newcode, "${indent}projectscale quarterly"
                and next
                if $+{tickAmount} eq 3
                and $+{tickUnit} eq 'month';
            push @newcode, "${indent}projectscale yearly"
                and next
                if $+{tickAmount} eq 12
                and $+{tickUnit} eq 'month';
            push @newcode, "${indent}'UNSUPPORTED' $&"
                and next;
        }

        /^
            (?'title'[^:\n]+)
            \s*+:\s*+

            # optional tags
            (?:
                (?:
                    (?'active'active)
                |
                    (?'done'done)
                |
                    (?'crit'crit)
                |
                    (?'milestone'milestone)
                )\s*+
                ,\s*+
            )?+

            (?:
                # optional tertiary item
                (?:
                    (?'taskID'(?&id))\s*+
                    ,\s*+
                    (?=.*,) # several items must follow
                )?+

                # optional secondary item
                (?:
                    (?'startDate'(?&date))
                |
                    after
                    (?'afterTaskIDs'
                        (?:\s+(?&id))++
                    )
                )\s*+
                ,\s*+
            )?+

            # required main item
            (?:
                (?'endDate'(?&date))
            |
                until
                (?'untilTaskIDs'
                    (?:\s+(?&id))++
                )
            |
                (?'duration'\d+)
                \s*+d
            )\s*+
        (?(DEFINE)
            (?'id'[^\s\d,][^\s,]*+) # assume digit as lead caracter is illegal
            (?'date'\d\d\d\d(?:-\d\d(?:-\d\d)?+)?+)
        )
        $/x
            or defined( $+{comment} )
            and push @newcode, "${indent}$_"
            and next
            or die "unhandled syntax on line $.: $_";

        defined( $+{active} )
            or defined( $+{done} )
            or defined( $+{crit} )
            and die "unhandled tag on line $.: $_";

        my $task    = "${indent}\[$+{title}]";
        my $taskref = $task;

        # optional 3rd item
        if ( $+{taskID} ) {
            $task .= " as [$+{taskID}]";
            $taskref = "${indent}\[$+{taskID}]";
        }

        if ( defined( $+{afterTaskIDs} ) ) {
            my @reqs = split ' ', $+{afterTaskIDs};

            if ( $+{milestone} ) {
                push @newcode, "$task happens at [$_]'s end" for @reqs;
            }
            elsif ( $+{endDate} ) {
                push @newcode, "$task ends $+{endDate}";
                push( @newcode, "$taskref starts at [$_]'s end" ) for @reqs;
            }
            elsif ( defined( $+{untilTaskIDs} ) ) {
                my @reqsEnd = split ' ', $+{untilTaskIDs};
                push @newcode, "$task ends at [$_]'s end" for @reqsEnd;
                push( @newcode, "$taskref starts at [$_]'s end" ) for @reqs;
            }
            else {
                push @newcode, "$task requires $+{duration} days";
                push( @newcode, "$taskref starts at [$_]'s end" ) for @reqs;
            }
        }
        else {
            if ( $+{milestone} ) {
                push @newcode, "$task happens $+{startDate}";
            }
            elsif ( $+{endDate} ) {
                push @newcode,
                    "$task starts $+{startDate} and ends $+{ednDate}";
            }
            elsif ( defined( $+{untilTaskIDs} ) ) {
                my @reqsEnd = split ' ', $+{untilTaskIDs};
                push @newcode, "$task starts $+{startDate}";
                push @newcode, "$task ends at [$_]'s end" for @reqsEnd;
            }
            else {
                push @newcode,
                    "$task starts $+{startDate} and requires $+{duration} days";
            }
        }
    }

    $" = "\n";
    return "\@start$type\n@newcode\n\@end$type\n";
}

=encoding UTF-8

=head1 AUTHOR

Jonas Smedegaard C<< <dr@jones.dk> >>

=head1 COPYRIGHT AND LICENSE

  Copyright © 2024 Jonas Smedegaard

This program is free software:
you can redistribute it and/or modify it
under the terms of the GNU Affero General Public License
as published by the Free Software Foundation,
either version 3, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY;
without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU Affero General Public License for more details.

You should have received a copy
of the GNU Affero General Public License along with this program.
If not, see <https://www.gnu.org/licenses/>.

=cut

1;