website/lib/DB.rakumod

use v6.e.PREVIEW;

#| Post database
unit module DB;

use Pandoc;
use JSON::Class:auth<zef:vrurg>;
use XML;
use XQ;

use DB::Post;
use DB::Series;
use DB::BlogMeta;
use DB::MarkdownPost;
use DB::IdrisPost;
use DB::PlaceholderPost;
use Render::Series;
use Atom;
use Config;

subset PostTypes where MarkdownPost:D | IdrisPost:D | PlaceholderPost:D;

#| The top level posts database
class PostDB {
   #| The metadata for the blog
   has BlogMeta:D $.meta is required;
   #| A mapping from post ids to posts
   # has %.posts is Posts;
   has %.posts{Int} of PostTypes = %();
   #| A mapping from series ids to series
   has %.series{Int} of Series = %();
   #| The post id to use for placeholder posts
   has Int $.placeholder-id = 0;

   #| Get the next unused post ID
   method next-post-id(--> Int) {
       if %!posts.elems > 0 {
           %!posts.keys.max + 1
       } else {
           0
       }
   }

   #| Get the next unused series ID
   method next-series-id(--> Int) {
       if %!series.elems > 0 {
           %!series.keys.max + 1
       } else {
           0
       }
   }

   #| Insert a new post to the DB, returning its id
   method insert-post(PostTypes $post --> Int) {
       my $id = self.next-post-id;
       %!posts{$id} = $post;
       $id
   }

   #| Insert a new series to the DB, returning its id
   method insert-series(Series:D $series --> Int) {
       my $id = self.next-series-id;
       %!series{$id} = $series;
       $id
   }

   #| Initialize a new database
   method init(BlogMeta:D $meta --> PostDB:D) {
       my %posts{Int} of PostTypes = %();
       %posts{0} = PlaceholderPost.empty;
       PostDB.new(
           meta => $meta,
           posts => %posts,
       )
   }

   #| Write a database to a directory
   method write(IO::Path:D $dir) {
       my $posts-dir = $dir.add('posts/');
       my $series-dir = $dir.add('series/');
       # Make sure directory structrue exists
       mkdir $dir unless $dir.e;
       mkdir $posts-dir unless $posts-dir.e;
       mkdir $series-dir unless $series-dir.e;
       # Write out metadata
       # TODO: Track changes and only write changed files
       $dir.add('meta.json').spurt: $!meta.to-json(:sorted-keys);
       # Write out posts (ids are the filename)
       for %!posts.kv -> $key, $value {
          $posts-dir.add("$key.json").spurt: $value.to-json(:sorted-keys);
       }
       # Write out the series
       for %!series.kv -> $key, $value {
          $series-dir.add("$key.json").spurt: $value.to-json(:sorted-keys);
       }
   }

   #| Render the site to the provided output directory
   method render(IO::Path:D $out-dir, Config:D :$config = Config.new) {
       ## Consistency checks
       # Check to make sure all the slugs are unique
       my @all-the-slugs = %!posts.values.map(*.all-slugs).flat;
       die "Duplicate slug detected"
           unless @all-the-slugs.unique.elems == @all-the-slugs.elems;
       ## Rendering
       my $posts = $out-dir.add('posts/');
       my $by-id = $posts.add('by-id/');
       my $by-slug = $posts.add('by-slug/');
       # Make sure the directory structure exists
       mkdir $out-dir unless $out-dir.e;
       mkdir $posts unless $posts.e;
       mkdir $by-id unless $by-id.e;
       mkdir $by-slug unless $by-slug.e;
       # Render all the posts and make symlinks
       for %!posts.kv -> $id, $post {
           my $html = $config.generate-post: $id, $post, self;
           my $id-path = $by-id.add: "$id.html";
           $id-path.spurt: $html;
           for $post.all-slugs -> $slug {
              # remove the symlink if it already exists
              my $slug-path = $by-slug.add: "$slug.html";
              $slug-path.unlink if $slug-path.l;
              $id-path.symlink: $slug-path;
           }
       }
       # Render the index
       $out-dir.add('index.html').spurt: $config.generate-index(self);
       # Render the archive
       $out-dir.add('archive.html').spurt: $config.generate-archive(self);
       # Symlink the about article
       my $about-path = $out-dir.add('about.html');
       $about-path.unlink if $about-path.l;
       $by-id.add("{$!meta.about-id}.html").symlink: $about-path;
       # Generate the tags pages
       my @tags = %!posts.values.map(*.tags).flat.unique.sort;
       $out-dir.add('tags.html').spurt: $config.generate-tags-page(self, @tags);
       my $tags-dir = $out-dir.add('tags/');
       mkdir $tags-dir unless $tags-dir.e;
       for @tags -> $tag {
           $tags-dir.add("$tag.html").spurt:
               $config.generate-tag-page(self, $tag);
       }
       # Generate the series pages
       my $series-dir = $out-dir.add('series/');
       mkdir $series-dir unless $series-dir.e;
       for %!series.kv -> $key, $value {
           $series-dir.add("$key.html").spurt:
               series-page($key, self);
       }
       # Generate the main series page
       $out-dir.add('series.html').spurt:
           series-list-page self;
       # Render the rss/atom feed
       my $atom-path = $out-dir.add('atom.xml');
       my $atom = posts-to-atom self;
       $atom-path.spurt: format-xml(~$atom);
       # Create the resources folder and copy over our style sheets
       my $res-dir = $out-dir.add('resources/');
       mkdir $res-dir unless $res-dir.e;
       # symlink the resources directory to make "interactive" styling eaiser
       # TODO: Directories support
       %?RESOURCES<colors.css>.IO.symlink: $res-dir.add('colors.css');
       %?RESOURCES<main.css>.IO.symlink: $res-dir.add('main.css');
       %?RESOURCES<code.css>.IO.symlink: $res-dir.add('code.css');
       %?RESOURCES<admonitions.css>.IO.symlink: $res-dir.add('admonitions.css');
   }

   #| Get a list of posts sorted by date
   method sorted-posts() {
      %!posts.sort(*.value.posted-at).reverse
   }
}

#| Read the database out of a directory
sub read-db(IO::Path:D $dir --> PostDB:D) is export {
   my $posts-dir = $dir.add('posts/');
   my $series-dir = $dir.add('series/');
   die "DB directory does not exist" unless $dir.e;
   die "posts directory does not exist" unless $posts-dir.e;
   # Read metadata
   my $meta = BlogMeta.from-json: $dir.add('meta.json').slurp;
   # Read posts
   my %posts{Int} of PostTypes = %();
   for dir $posts-dir -> $post {
       my $id = $post.extension("").basename.Int;
       # TODO: Dejankify this, maybe see if we can work with parsed, but
       # unmarshalled json
       given $post.slurp {
           when /'"placeholder": true'/ {
               %posts{$id} = PlaceholderPost.from-json: $_;
           }
           when /'"markdown": true'/ {
               %posts{$id} = MarkdownPost.from-json: $_;
           }
           when /'"idris": true'/ {
               %posts{$id} = IdrisPost.from-json: $_;
           }
           default {
               die "Unsupported post type: $post";
           }
       }
   }
   # Read series
   my %series{Int} of Series:D = %();
   # For backwards compatability, the series directory is optional. It will be
   # created on the next db operation, but we don't need it to read the site
   if $series-dir.e {
       for dir $series-dir -> $series {
           my $id = $series.extension("").basename.Int;
           %series{$id} = Series.from-json: $series.slurp;
       }
   }
   # Build db structure
   PostDB.new: meta => $meta, posts => %posts, series => %series
}