build-book

#!/usr/bin/env raku

use File::Temp;
use Shell::Command;
use paths;

unit sub MAIN(Bool :$upload, Bool :$skip-katla?);

my $tempdir = tempdir.IO;
my $ttc-number = dir('build/ttc').first.basename;
my $ttc = "build/ttc/$ttc-number".IO;

# Copy a file from the current directory to the temporary directory, preserving
# realtive path. Resolves symlinks in source, but does not reflect symlink
# resoultion in the output path
sub copy-to-dest($src) {
   my $src-path = do given $src {
       when Str {
           $src.IO
       }
       when IO::Path {
           $src
       }
       default {
           die "Invalid source $src, {$src.WHAT}"
       }
   }
   my $output-path = $tempdir.add($src-path.relative).IO;
   # Create the parent directory if needed
   if !$output-path.parent.d {
       $output-path.parent.mkdir;

   }
   # Copy the file
   $src-path.resolve.copy: $output-path;
}

# Copy our metadata files
copy-to-dest "book.toml";

# Katla over the source files, just plain copying them if the ttm doesn't exist
# Implement special handling for idr files
paths("src").race(batch => 1).map( -> $path {
    my $rel-path = $path.IO.relative;
    my $ttc-path = $ttc.add($path.IO.relative: "src").extension: "ttm";
    given $path.IO.extension {
        when "md" {
            # Use the presense of a ttm file to detect if this markdown file was a regular
            # markdown file or a literate idris document
            if $ttc-path ~~ :e {
                # ttm found, this is a literate idris document
                say "Running katla on ", $rel-path, " with ttc at ", $ttc-path.relative;
                katla-markdown $path.IO.relative, $ttc-path.relative;
            } else {
                say "ttc not found for ", $rel-path, " copying verbaitm";
                copy-to-dest $rel-path;
            }
        }
        when "idr" {
            die "Idris file ", $rel-path, " didn't have ttm: ", $ttc-path
                unless $ttc-path ~~ :e;

            say "Running katla on ", $rel-path,
                " with ttc at ", $ttc-path.relative,
                " sending to ", $path.IO.extension('md').relative;
            katla-html $path.IO.relative, $ttc-path.relative, $path.IO.extension('md').relative;
            # katla $path.IO.relative,
            $ttc-path.relative,
            output-name => $path.IO.extension('md').relative;
        }
        default {
            say "Copying ", $rel-path, " verbatim";
        }
    }
}).sink;

# Build the book

indir $tempdir, {
    my $mdbook = run <mdbook build>;
    die "Ooops" unless $mdbook;
}

# Copy it over
rm_rf "book";
cp $tempdir.add("book"), "book", :r;

# Invoke katla on an idris source file, mangling the output into a markdown file
sub katla-html($src, $ttc-src, $out-path) {
    # Prepare the output location
    my $output-path = $tempdir.add: $out-path;
    if !$output-path.parent.d {
        $output-path.parent.mkdir;
    }
    # Short circut if requested
    if $skip-katla {
        say 'Skipping katla for input at ', $src;
        $output-path.spurt($src.IO.slurp);
        return;
    }
    # Run katla and collect the output
    # TODO: Detect and handle katla errors
    my $katla = run 'katla', 'html', $src, $ttc-src, :out;
    my $raw-output = $katla.out.slurp(:close);
    # Extract just the code from the output
    my $output = ($raw-output ~~ /'<code' .* '</code>'/ ).Str;
    # Rerrange into a markdown document
    $output = process-katla-output($output);
    $output = qq:to/END/;
    # $src
    $output
    END
    # Strip line numbering
    $output.=subst(
        /'<div id="line' \d+ '"><a href="#line' \d+ '" class="IdrisLineNumber">' [ '&nbsp;' | \s ]+ \d+ ' | </a>'/,
        '',
        :g
    );
    $output.=subst(/'</div>'$$/,'',:g);
    # Spurt the output to the temporary directory
    $output-path.spurt($output);
}

# Invoke katla on a markdown source file, streaming its output to the temporary directory
sub katla-markdown($src, $ttc-src) {
    # Prepare the output location
    my $output-path = $tempdir.add: $src;
    if !$output-path.parent.d {
        $output-path.parent.mkdir;
    }
    # Short circut if requested
    if $skip-katla {
        say 'Skipping katla for input at ', $src;
        $output-path.spurt($src.IO.slurp);
        return;
    }
    # Run katla and collect the output
    # TODO: Detect and handle katla errors
    my $katla = run 'katla', 'markdown', $src, $ttc-src, :out;
    my $output = $katla.out.slurp(:close);
    $output = process-katla-output($output);
    # Spurt the output to the temporary directory
    $output-path.spurt($output);
}

# Process the output from katla
sub process-katla-output($orig-output) {
    my $output = $orig-output;
    # Post process katla output to set themeing correctly
    $output ~~ s:g/'<style>' .* '</style>'//;
    $output ~~ s:g/'<br />'//;
    $output ~~ s:g/'\\*'/*/;
    $output ~~ s:g/'\\_'/_/;
    $output ~~ s:g/'\\\\'/\\/;
    $output ~~ s:g/'<code'/<pre><code/;
    $output ~~ s:g/'</code>'/<\/code><\/pre>/;
    $output ~~ s:g/'="IdrisKeyword"'/="hljs-keyword"/;
    $output ~~ s:g/'="IdrisModule"'/="hljs-symbol hljs-emphasis"/;
    $output ~~ s:g/'="IdrisComment"'/="hljs-comment"/;
    $output ~~ s:g/'="IdrisFunction"'/="hljs-symbol"/;
    $output ~~ s:g/'="IdrisBound"'/="hljs-name"/;
    $output ~~ s:g/'="IdrisData"'/="hljs-title"/;
    $output ~~ s:g/'="IdrisType"'/="hljs-type"/;
    $output ~~ s:g/'="IdrisNamespace"'/="hljs-symbol hljs-emphasis"/;
    $output.=subst(/'<code class="IdrisCode">'\s*/, '<code class="IdrisCode">', :g);
    $output.=subst('&nbsp;', ' ', :g);
    $output
}