My first BuckleScript thingie

index.bs.js

// Generated by BUCKLESCRIPT VERSION 4.0.5, PLEASE EDIT WITH CARE
'use strict';

var Old_hash_redirector = require("./old_hash_redirector.bs.js");

var change_url = function (new_url){window.location.href = new_url};

function run() {
  return change_url(Old_hash_redirector.run_hash_check(window.location.hash));
}

change_url(Old_hash_redirector.run_hash_check(window.location.hash));

exports.change_url = change_url;
exports.run = run;
/*  Not a pure module */

index.ml

external window_hash: string = "hash" [@@bs.val][@@bs.scope "window", "location"]

let change_url: (string -> unit) = [%raw fun new_url -> "window.location.href = new_url"]

let run = fun () ->
  let new_hash = Old_hash_redirector.run_hash_check window_hash in
  change_url new_hash

let () = run()

old_hash_redirector.bs.js

// Generated by BUCKLESCRIPT VERSION 4.0.5, PLEASE EDIT WITH CARE
'use strict';


var hash_re_000 = /* record */[
  /* old_hash */(/^\#\!\/(\d{4})\/(\d\d)\/(\d\d)\/(.*)$/),
  /* new_hash */"/$1/$2/$3/$4"
];

var hash_re_001 = /* :: */[
  /* record */[
    /* old_hash */(/^\#\!\/tag\/([^\/]+)$/),
    /* new_hash */"/tag/$1"
  ],
  /* :: */[
    /* record */[
      /* old_hash */(/^\#\!\/tag\/([^\/]+)(\/\d+)$/),
      /* new_hash */"/tag/$1/p/$2"
    ],
    /* :: */[
      /* record */[
        /* old_hash */(/^\#\!\/archives\/(\d{4})$/),
        /* new_hash */"/archive/$1"
      ],
      /* :: */[
        /* record */[
          /* old_hash */(/^\#\!\/archives\/(\d{4})\/(\d\d)$/),
          /* new_hash */"/archive/$1/$2"
        ],
        /* :: */[
          /* record */[
            /* old_hash */(/^\#\!\/archives\/(\d{4})(\/\d+)$/),
            /* new_hash */"/archive/$1/p/$2"
          ],
          /* :: */[
            /* record */[
              /* old_hash */(/\#\!\/archives\/(\d{4})\/(\d\d)(\/\d+)$/),
              /* new_hash */"/archive/$1/$2/p/$3"
            ],
            /* :: */[
              /* record */[
                /* old_hash */(/^\#\!\/(.*)$/),
                /* new_hash */"/$1"
              ],
              /* [] */0
            ]
          ]
        ]
      ]
    ]
  ]
];

var hash_re = /* :: */[
  hash_re_000,
  hash_re_001
];

function check_single_hash(_hash_list, current_hash) {
  while(true) {
    var hash_list = _hash_list;
    if (hash_list) {
      var matcher = hash_list[0];
      var is_match = matcher[/* old_hash */0].test(current_hash);
      if (is_match) {
        return current_hash.replace(matcher[/* old_hash */0], matcher[/* new_hash */1]);
      } else {
        _hash_list = hash_list[1];
        continue ;
      }
    } else {
      return "/";
    }
  };
}

function run_hash_check(hash) {
  return check_single_hash(hash_re, hash);
}

exports.hash_re = hash_re;
exports.check_single_hash = check_single_hash;
exports.run_hash_check = run_hash_check;
/* hash_re Not a pure module */

old_hash_redirector.ml

(*
 * This script will check old Laine-style hashes when the page has been loaded and redirects
 * to the correct address if such a hash is found.
 * This is done in JS because the hash is not sent to the server.
 *)

type hash_matcher =
  { old_hash : Js.Re.t;
    new_hash : string;
  }

let hash_re = [
  { old_hash = [%re "/^\\#\\!\\/(\\d{4})\\/(\\d\\d)\\/(\\d\\d)\\/(.*)$/"];
    new_hash = "/$1/$2/$3/$4";
  };
  { old_hash = [%re "/^\\#\\!\\/tag\\/([^\\/]+)$/"];
    new_hash = "/tag/$1";
  };
  { old_hash = [%re "/^\\#\\!\\/tag\\/([^\\/]+)(\\/\\d+)$/"];
    new_hash = "/tag/$1/p/$2";
  };
  { old_hash = [%re "/^\\#\\!\\/archives\\/(\\d{4})$/"];
    new_hash = "/archive/$1";
  };
  { old_hash = [%re "/^\\#\\!\\/archives\\/(\\d{4})\\/(\\d\\d)$/"];
    new_hash = "/archive/$1/$2";
  };
  { old_hash = [%re "/^\\#\\!\\/archives\\/(\\d{4})(\\/\\d+)$/"];
    new_hash = "/archive/$1/p/$2";
  };
  { old_hash = [%re "/\\#\\!\\/archives\\/(\\d{4})\\/(\\d\\d)(\\/\\d+)$/"];
    new_hash = "/archive/$1/$2/p/$3";
  };
  { old_hash = [%re "/^\\#\\!\\/(.*)$/"];
    new_hash = "/$1";
  }
]

let rec check_single_hash hash_list current_hash = match hash_list with
  | matcher :: tail ->
    let is_match = Js.Re.test current_hash matcher.old_hash in
      if is_match
        then Js.String.replaceByRe matcher.old_hash matcher.new_hash current_hash
        else check_single_hash tail current_hash
  | [] -> "/"

let run_hash_check = fun hash ->
  check_single_hash hash_re hash

let run_hash_check hash =
  match List.find_opt (fun matcher -> Js.Re.test hash matcher.old_hash) hash_re with
  | None -> "/"
  | Some matcher -> Js.String.replaceByRe matcher.old_hash matcher.new_hash hash

  match List.find (fun matcher -> Js.Re.test hash matcher.old_hash) hash_re with
  | matcher -> Js.String.replaceByRe matcher.old_hash matcher.new_hash hash
  | exception Not_found -> "/"