#!/usr/bin/env perl

#
# Copyright (c) 2014-2019 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#

use strict; use warnings; use warnings FATAL => 'uninitialized';

# Method::Signatures versions 20120523 and 20141021 are working badly
# for this file, because (1) each package needs its own import, (2)
# error locations are completely off. Thus, still use the trusty
# Function::Parameters.

use Function::Parameters qw(:strict);

# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
    my $location= (-l $0) ? abs_path ($0) : $0;
    $location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname)=($1,$2);
}
use lib "$mydir/../lib";
# and the htmlgen/ directory
use lib $mydir;


our $css_path= "htmlgen.css";

sub usage {
    print "$myname config inbase outbase

  config is the path to a Perl file ending in a hash with config
  values, see functional-perl/website/gen-config.pl for an example.

  inbase needs to be a git working directory.

  Assumes that there is a file '$css_path', which is included in the
  <head/> and copied to outbase.

  Options:
    --repl  open a repl instead of running the main action
    --trap  trap uncached exception in a repl (implied by --repl)

";
    exit 1;
}

use Getopt::Long;
our $verbose=0;
our ($opt_repl,$opt_trap);
GetOptions("verbose"=> \$verbose,
           "help"=> sub{usage},
           "repl"=> \$opt_repl,
           "trap"=> \$opt_trap,
           ) or exit 1;
usage unless @ARGV==3 or ($opt_repl and @ARGV>=1);

our ($configpath, $inbase, $outbase)= @ARGV;

our $user_config= require $configpath;

use FP::Docstring;
use Chj::Backtrace;
use Hash::Util 'lock_hash';
use Chj::xperlfunc qw(basename dirname);
use Chj::xIOUtil qw(xgetfile_utf8 xcopyfile);
use FP::HashSet ":all";
use PXML::XHTML ":all";
use PXML::Serialize 'puthtmlfile';
use FP::Array ":all";
use File::Spec;
use FP::Array_sort;
use FP::Ops qw(string_cmp number_cmp the_method cut_method);
use FP::Equal qw(equal);
use FP::autobox;
use Chj::TEST ":all";
use FP::List qw(is_pair list);
use PXML::Util qw(pxml_map_elements_exhaustively);
use FP::Hash ":all";
use PXML::Tags qw(with_toc);
use FP::Predicates qw(complement);
use FP::Git::Repository;
use FunctionalPerl::Htmlgen::PathTranslate;
use FunctionalPerl::Htmlgen::PathUtil qw(path_add path_diff path0);
use FunctionalPerl::Htmlgen::Cost;
use FunctionalPerl::Htmlgen::default_config qw($default_config);
use FunctionalPerl::Htmlgen::FileUtil qw(existingpath_or create_parent_dirs);
use FunctionalPerl::Htmlgen::MarkdownPlus qw(markdownplus_parse);
use FP::Lazy;
use FunctionalPerl::Htmlgen::Mediawiki qw(mediawiki_prepare mediawiki_replace
                          mediawiki_rexpand);
use PXML::Preserialize qw(pxmlpre);
use FP::PureHash;
use FP::Equal qw(pointer_eq);

require FP::Repl::Trap if $opt_trap;


our $config = hashset_union ($user_config, $default_config);

lock_hash %$config;

our $pathtranslate= FunctionalPerl::Htmlgen::PathTranslate->new__
  (subhash $config, "is_indexpath0", "downcaps");

our $gitrepository= FP::Git::Repository->new_(chdir=> $inbase);

fun path0_to_inpath ($path0) {
    "$inbase/".$path0
}

fun path0_to_outpath ($path0) {
    #"$outbase/".$pathtranslate->xsuffix_md_to_html($path0,0)
    # nope, also used for .pl file copying,
    "$outbase/".$pathtranslate->possibly_suffix_md_to_html($path0,0)
}


use FunctionalPerl::Htmlgen::Toc;
use FunctionalPerl::Htmlgen::Linking;
use FunctionalPerl::Htmlgen::PerlTidy;

# XX make configurable
our $pxml_mappers=
    # These implement FunctionalPerl::Htmlgen::PXMLMapper; subarray
    # for those that match on the same tagname, in order of preference
    # (the chain exits once an element has been replaced).
    ["FunctionalPerl::Htmlgen::Linking::Anchors",
     "FunctionalPerl::Htmlgen::Toc", # <with_toc>
     ["FunctionalPerl::Htmlgen::PerlTidy",
      "FunctionalPerl::Htmlgen::Linking::code"],
     "FunctionalPerl::Htmlgen::Linking::a_href",
    ];

fun pxml_name_to_mapper (@PXMLMapper_args) {
    purehash(
        map {
            if (ref $_) { # subarray given (autobox coming into play)
                my $ms= $_->map(the_method "new_", @PXMLMapper_args);
                my $elnames= $ms->first->match_element_names;
                $ms->rest->every(fun ($v) { equal $elnames, $v->match_element_names})
                    or die "not all have the same elnames";
                # chain element $e through them until it was processed:
                my $fn= $ms->fold_right (
                    fun ($m, $prev) {
                        fun ($e, $uplist) {
                            #warn "checking out $m..";
                            my $e2= $m->map_element($e, $uplist);
                            if (pointer_eq $e, $e2) {
                                &$prev($e, $uplist)
                            } else {
                                $e2
                            }
                        }
                    },
                    fun ($e, $uplist) { $e });
                map {
                    ($_, $fn)
                } @$elnames
            } else {
                # instantiate a mapper
                my $m= $_->new_(@PXMLMapper_args);
                # register it for all the element names it wants to see
                map {
                    ($_, sub { $m->map_element(@_)})
                } @{$m->match_element_names}
            }
        } @$pxml_mappers)
}

fun default_pxml_name_to_mapper() {
    # fake instance for tests only
    pxml_name_to_mapper(path0=> "NOPATH",
                        maybe_have_path0=> sub{die"NOIMPL"},
                        perhaps_filename_to_path0=> sub{die"NOIMPL"},
                        pathtranslate=> $pathtranslate)
}

fun process_body ($v,
                  $pxml_name_to_mapper=default_pxml_name_to_mapper(),
                  $mediawikitoken="NOTOKEN",
                  $mediawikitable={}) {
    __  "([PXML::Element],..) -> [PXML::Element] ".
        "-- applies the transformations in $pxml_mappers";

    # HACK: can't mediawiki_expand the whole document in string format
    # before the markdown parsing, since it would expand examples in
    # code sections as well. So instead leave the [[ ]] in (unharmed
    # by markdown) and expand it here on individual text segments,
    # then map it (and here comes the hacky part, you will forget to
    # update here when prepending another mapping phase or so, right?) 
    # the same way the rest of the document is treated.

    my $map_text_mediawiki= fun ($v, $uplist) {
        # ($uplist might be empty in tests)
        if (is_pair $uplist and $uplist->first->name eq "code") {
            # don't expand it in code segments
            mediawiki_replace($v, $mediawikitoken, $mediawikitable)
        } else {
            my $body=
                mediawiki_rexpand($v, $mediawikitoken, $mediawikitable);
            array_map (
                fun ($e) {
                    pxml_map_elements_exhaustively
                        ($e, $pxml_name_to_mapper, undef);
                },
                $body)
        }
    };

    pxml_map_elements_exhaustively ($v,
                                    $pxml_name_to_mapper,
                                    $map_text_mediawiki)
}

TEST { HTML( process_body
             (["Hello",
               WITH_TOC({level=>1},
                        H1 "world")]))
         ->string }
  '<html>Hello<div class="toc_box"><dir class="toc"><h3 class="toc_title">Contents</h3><li><dir class="toc"><a href="#world">1. world</a></dir></li></dir></div><a name="world"><h1>1. world</h1></a></html>';

TEST { HTML( process_body
             (["Hello", WITH_TOC ["some", H2 "world"]]))
         ->string }
  '<html>Hello<div class="toc_box"><dir class="toc"><h3 class="toc_title">Contents</h3><li><dir class="toc"><a href="#world">1. world</a></dir></li></dir></div>some<a name="world"><h2>1. world</h2></a></html>';

TEST { HTML( process_body  ([P("Hello"),
                             WITH_TOC
                             {level=>1},
                             [" ",
                              P ("blabla"),
                              A({name=>"a"}," ",DIV H1 ("for one")),
                             ]]))->string }
  '<html><p>Hello</p><div class="toc_box"><dir class="toc"><h3 class="toc_title">Contents</h3><li><dir class="toc"><a href="#for_one">1. for one</a></dir></li></dir></div> <p>blabla</p><a name="a"> <div><a name="for_one"><h1>1. for one</h1></a></div></a></html>';

TEST { HTML( process_body  ([P("Hello"),
                             WITH_TOC
                             {level=>1},
                             [" ",
                              P ("blabla"),
                              H1 ("for one"),
                              H2 ("more one"),
                              TABLE(TR
                                    TD P ("blah")
                                    ,  H1 ("sub two")
                                    ,  DIV ("bla")),
                             ]]))->string }
  '<html><p>Hello</p>'.
  '<div class="toc_box"><dir class="toc"><h3 class="toc_title">Contents</h3><li><dir class="toc"><a href="#for_one">1. for one</a><li><dir class="toc"><a href="#more_one">1.1. more one</a></dir></li></dir></li><li><dir class="toc"><a href="#sub_two">2. sub two</a></dir></li></dir></div>'.
  ' <p>blabla</p><a name="for_one"><h1>1. for one</h1></a><a name="more_one"><h2>1.1. more one</h2></a><table><tr><td><p>blah</p><a name="sub_two"><h1>2. sub two</h1></a><div>bla</div></td></tr></table></html>';




# Note: the cost range feature is not used on the Functional Perl
# website. It could be used to connect issues to a cost for budgeting.

package FunctionalPerl::Htmlgen::_::Genfilestate {
    use FP::Docstring;

    use FP::Struct ['filesinfo',
                    'groupedfiles',
                    'nonbugfiles',
                    'costranges', # path0 -> costrange-string; filled
                                  # in by mutation when processing
                                  # non-buglist groups
        ];

    method set_costrange ($path0,$maybe_costrange) {
        __ '~ugly, mutates';
        $$self{costranges}{$path0}= $maybe_costrange;
    }
    method costrange ($path0) {
        $$self{costranges}{$path0}
    }

    _END_
}



package FunctionalPerl::Htmlgen::_::Filesinfo {
    use FP::Hash "hash_perhaps_ref";
    use FP::Array qw(array_to_hash_group_by);
    use FunctionalPerl::Htmlgen::PathUtil qw(path_add path_diff path0);
    use FP::PureArray;
    use FP::Docstring;

    fun groupkey ($path) {
        __  'a string key for grouping this path amongst other files, to '.
            'process them in an order that satisfies dependency on costranges';
        my $p0= path0 $path;
        if ($p0=~ m|^bugs/|) {
            "bugs"
        } elsif ($p0 =~ m|^docs/bugs.*\.md$|) {
            "buglist"
        } else {
            "normal"
        }
    }

    use FP::Struct ['files',
                    'filename_to_path0',
                    'all_path0_exists',
                    'path0_exists', # path0=> ()
                    'all_path0_used', # path0 => usecount, mutated
        ];
    method filename_to_path0 ($filename) {
        $$self{filename_to_path0}{$filename}
          // die "no mapping for filename '$filename'"
    }
    method filename_to_maybe_path0 ($filename) {
        $$self{filename_to_path0}{$filename}
    }
    # still very unclear about the exact name styling. Prefer perhaps,
    # and "then" also move the qualificator to the front? (but leave
    # the one for hash_ where it is since hash_ is the type prefix?) :
    method perhaps_filename_to_path0 ($filename) {
        hash_perhaps_ref ($$self{filename_to_path0}, $filename)
    }
    method all_path0_exists ($path0) {
        defined $$self{all_path0_exists}{$path0}
          or
        defined $$self{all_path0_exists}{$path0."/"}
    }
    method path0_is_directory ($path0) {
        $path0=~ s|/+$||s;
        defined $$self{all_path0_exists}{$path0."/"}
    }
    method path0_exists ($path0) {
        defined $$self{path0_exists}{$path0}
    }
    method all_path0_used_inc ($path0) {
        __ '~ugly, mutates';
        $$self{all_path0_used}{$path0}++
    }

    method new_genfilestate () {
        my $groupedfiles= array_to_hash_group_by $self->files, \&groupkey;

        my $nonbugfiles= purearray( @{$$groupedfiles{normal}},
                                    @{$$groupedfiles{buglist}||[]} );

        FunctionalPerl::Htmlgen::_::Genfilestate->new
            ($self, # just so as to bundle it up, too, ugly?
             $groupedfiles,
             $nonbugfiles,
             {} # costranges (mutated)
            )
    }

    _END_
}

fun get_filesinfo () {
    __  '() -> Filesinfo '.
        '-- read info about files from disk as immutable struct';

    my $all_files= $gitrepository->ls_files->array;

    my $files= array_filter (cut_method($pathtranslate,"is_md"),
                             $all_files);

    my $filename_to_path0=
      +{map {
          basename ($_)=> path0($_)
      } @$files};

    my $all_path0_exists=
      +{
        map {
            path0($_)=>1
        }
        @$all_files,
        # and their directories, ok? Any directory that has files
        # from git will be ok as link target, ok?
        map {
            dirname($_)."/"
        }
        @$all_files
       };

    my $path0_exists=
      +{map {
          path0($_)=>1
      } @$files};

    FunctionalPerl::Htmlgen::_::Filesinfo->new(
        $files,
        $filename_to_path0,
        $all_path0_exists,
        $path0_exists,
        {}, # all_path0_used
        )
}


# Navigation:

fun nav_bar ($items_in_level, $item_selected, $viewed_at_item) {
    UL({class=> "menu"},
       $items_in_level->map_with_islast
       (
        fun ($is_last, $item) {
            my $filetitle= $pathtranslate->path0_to_title($item->path0);
            my $is_viewed= equal($item, $viewed_at_item);
            my $is_open= equal($item, $item_selected);

            LI({class=> ($is_last ? "menu_last" : "menu")},
               ($is_viewed ?
                SPAN({class=> "menu_selected"},
                     $filetitle)
                : A ({class=> ($is_open ? "menu_open" : "menu"),
                      href=>
                      File::Spec->abs2rel
                      ($pathtranslate->xsuffix_md_to_html($item->path0,0),
                       dirname($viewed_at_item->path0))},
                     $filetitle)),
               " ")
        }))
}

# For access from main:: by the code in the configuration file (hacky):
use FunctionalPerl::Htmlgen::Nav qw(_nav entry);

sub nav {
    _nav (list(@_), \&nav_bar)
}
# /for access from main:: by the code in the configuration file.


our $HEAD= pxmlpre 3, fun ($title, $csspath, $user_additions) {
    HEAD (TITLE ($title),
          LINK ({rel=> "stylesheet",
                 href=> $csspath,
                 type=> "text/css"}),
          $user_additions)
};

fun genfile ($path, $groupname, $genfilestate) {
    __ '($path, $groupname, $genfilestate) -> () '.
        '-- convert markdown file at $path to xhtml file at '.
        'corresponding output path';

    my $path0= path0 $path;
    my $outpath= path0_to_outpath($path0);
    mkdir dirname( $outpath);

    my $filetitle= $pathtranslate->path0_to_title($path0);

    my $str= xgetfile_utf8 "$inbase/$path";

    if ($$config{warn_hint}) {
        $str=~ s/^\(?Check the.*?website.*?---\s+//s
          or $path=~/COPYING|bugs|licenses\//
            or warn "'$path' is missing hint";
    }

    if (my $hdl= $config->{path0_handlers}->{$path0}) {
        $str= $hdl->($path,$path0,$str);
    }

    my $maybe_costrange= do {
        # extract Cost indicators:
        my $namere= qr/\w+/;
        my $nameplusre= qr/\(?$namere\)?/;
        my $possibly_nameplus_to_name= fun ($maybe_nameplus) {
            if (defined $maybe_nameplus) {
                my ($name)= $maybe_nameplus=~ qr/($namere)/
                  or die "bug";
                $name
            } else {
                undef
            }
        };
        local our $costs=[];
        while ($str=~ m{\b[Cc]ost
                        # name: parentheses for "library cost"
                        (?:\s+($nameplusre))?
                        :
                        \s*
                        # base costs
                        ((?:$nameplusre\s*\+\s*)*)
                        \s*
                        # amount
                        \$\s*(\d+)
                   }gx) {
            my ($nameplus,$basecosts,$val)=($1,$2,$3);
            my $name= &$possibly_nameplus_to_name($nameplus);
            my @basecosts= map { &$possibly_nameplus_to_name($_) }
              split /\s*\+\s*/, $basecosts;
            push @$costs, new FunctionalPerl::Htmlgen::Cost::_::Cost ($name,
                                         (not $nameplus
                                          or not($nameplus=~ /^\(/)),
                                         \@basecosts,
                                         $val);
        }
        @$costs ? FunctionalPerl::Htmlgen::Cost::_::Totalcost->new($costs)->range : undef
    };
    if (defined $maybe_costrange) {
        $genfilestate->set_costrange($path0, $maybe_costrange);
    }

    my $mediawikitoken= rand; # not fork safe!
    my ($h1,$body,$mediawikitable)=
        markdownplus_parse ($str,
                            lazy { $pathtranslate->path0_to_title($path0) },
                            $mediawikitoken);

    my $maybe_buglist= $groupname eq "buglist" && do {
        my $bugs=
          array_sort
            (array_map
             (
              fun ($path) {
                  my $path0= path0 $path;
                  my $title= $pathtranslate->path0_to_title($path0);
                  [$title,$path0,$genfilestate->costrange($path0)]
              },
              $genfilestate->groupedfiles->{bugs}),
             on sub{$_[0][0]}, \&string_cmp # XX not a good cmp.
            );

        TABLE
          ({class=> "costlist"},
           THEAD (TH ("Type"), TH ("Title"),TH ("Cost range (USD)")),
           map {
               my ($title,$p0,$costrange)= @$_;
               my $relurl= File::Spec->abs2rel
                 ($pathtranslate->xsuffix_md_to_html($p0,0),
                  basename ($path0));
               TR (TD ($pathtranslate->path0_to_bugtype($p0)),
                   TD (A({href=>$relurl},$title)),
                   TD ({align=>"center"},$costrange))
           } @$bugs
          )
    };

    my $filesinfo= $genfilestate->filesinfo;
    my $pxml_name_to_mapper=
      pxml_name_to_mapper (path0=> $path0,
                           maybe_have_path0=>
                           fun ($path0) {
                               if ($filesinfo->all_path0_exists ($path0)) {
                                   $filesinfo->all_path0_used_inc($path0);
                                   $path0
                               } else {
                                   undef
                               }
                           },
                           perhaps_filename_to_path0=>
                           fun ($filename) {
                               $filesinfo->perhaps_filename_to_path0
                                 ($filename)
                           },
                           map_code_body=>
                           hash_maybe_ref ($config, "map_code_body"),
                           pathtranslate=>
                           $pathtranslate,
                          );

    my $nav= $$config{nav};
    my $nav_index= $nav->index;
    # ^ this could be cached across all documents (but measurements
    # haves shown it to be insignificant)
    my $nav_upitems=  $nav_index->path0_to_upitems($path0);
    my $nav_self= $nav_upitems->first;

    my $html=
      HTML (
            &$HEAD([$config->{title}->($filetitle)],
                   scalar path_diff ($path0, $css_path),
                   scalar $config->{head}->($path0)),
            BODY(
                 $config->{header}->($path0),

                 (1 ?
                  # make the top nav level contain all unknown pages
                  # (and don't include pages declared in the nav that
                  # don't exist)
                  (
                   $nav->nav_bar_level0
                   ($genfilestate->nonbugfiles->map
                    (fun($p0) {$nav_index->path0_to_item($p0)}),
                    $nav_upitems->last,
                    $nav_upitems->first),

                   $nav->nav_bar_levels
                   ($nav_self, $nav_upitems)
                   ->rest
                  )
                  :
                  # strictly follow the navigation declaration
                  $nav->nav_bar_levels ($nav_self, $nav_upitems)
                 ),

                 $config->{belownav}->($path0),
                 $h1,
                 process_body ($body, $pxml_name_to_mapper,
                               $mediawikitoken, $mediawikitable),
                 $maybe_buglist,
                 BR,
                 HR,
                 ($maybe_costrange ? P("\x{21d2} Cost range: \$",
                                       $maybe_costrange) : ()),
                 DIV({class=>"footer_date"},
                     $gitrepository->author_date ($path)),
                 $config->{footer}->($path0)));

    puthtmlfile($outpath, $html);
}


fun genfiles ($filesinfo) {
    my $genfilestate= $filesinfo->new_genfilestate;
    for my $groupname (qw(bugs normal buglist)) {
        for (@{$genfilestate->groupedfiles->{$groupname}}) {
            genfile $_,$groupname,$genfilestate
        }
    }
}

# copy referenced non-.md files:
fun copyfiles ($filesinfo) {
    for my $path0 (hashset_keys
                   hashset_union($filesinfo->all_path0_used,
                                 array_to_hashset
                                 (hash_ref_or ($config, "copy_paths", [])))) {
        next if $filesinfo->path0_exists($path0); # md path
        next if $filesinfo->path0_is_directory($path0);
        create_parent_dirs ($path0, \&path0_to_outpath);
        xcopyfile (path0_to_inpath($path0), path0_to_outpath($path0));
    }
    if (my ($separate)= hash_perhaps_ref($config, "copy_paths_separate")) {
        for my $root (keys %$separate) {
            for my $path0 (@{$$separate{$root}}) {
                xcopyfile "$root/$path0", path0_to_outpath $path0
            }
        }
    }
    # copy htmlgen CSS file
    xcopyfile (existingpath_or (path0_to_inpath($css_path),
                                path0_to_inpath("htmlgen/$css_path")),
               path0_to_outpath($css_path));
}

fun main () {
    mkdir $outbase;
    warn "running get_filesinfo..";
    my $filesinfo= get_filesinfo;
    warn "running genfiles..";
    genfiles ($filesinfo);
    warn "running copyfiles..";
    copyfiles ($filesinfo);
}


perhaps_run_tests __PACKAGE__
  or do {
      $opt_repl ? do {
          require FP::Repl;
          require FP::Repl::Trap;
          FP::Repl::repl();
      } : main;
};

