#!/usr/bin/env -S csi -s
;; Copyright (c) 2025 Amin Bandali <
[email protected]>
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved. This file is offered as-is,
;; without any warranty.
(import
(chicken io)
(chicken irregex)
(chicken pathname)
(chicken port)
(chicken process)
(chicken process-context)
(chicken string)
(chicken time posix)
scheme
utf8)
(import (except scheme display))
(define MD)
(define MD-opts)
(define cur-dir)
(define khorshidi-months
'("فروردین" "اردیبهشت" "خرداد"
"تیر" "مرداد" "شهریور"
"مهر" "آبان" "آذر"
"دی" "بهمن" "اسفند"))
(define miladi-months
'("ژانویه" "فوریه" "مارس"
"آوریل" "مه" "ژوئن"
"ژوئیه" "اوت" "سپتامبر"
"اکتبر" "نوامبر" "دسامبر"))
(define en-digits "0123456789")
(define fa-digits "۰۱۲۳۴۵۶۷۸۹")
(define langs-dirs '("fa"))
(define (irregex-split-once irx s)
(let ((match (irregex-search irx s)))
(if match
(list (substring s 0 (irregex-match-start-index match))
(substring s (irregex-match-end-index match)))
(list s))))
(define (get-short-date date-str)
(if (member cur-dir langs-dirs) ; e.g. "fa"
(begin
(let* ((year (substring date-str 0 4))
(month (substring date-str 5 7))
(month-index (- (string->number month) 1))
(date-khorshidi? (equal? (substring year 0 1) "1"))
(month-name (list-ref (if date-khorshidi?
khorshidi-months
miladi-months)
month-index))
(year-fa (string-translate year en-digits fa-digits)))
(string-append month-name " " year-fa)))
(begin
(let ((date-time (string->time date-str "%Y/%m/%d")))
(time->string date-time "%b %Y")))))
(define (process-line line)
(when (and (> (string-length line) 0)
(not (equal? (substring line 0 1) "#")))
(let* ((link-title (irregex-split-once " " line))
(link (car link-title))
(title (cadr link-title))
(link-no-../-prefix (irregex-replace "([.][.]/)+(.*)" link 2))
(en-link? (not (equal? link link-no-../-prefix)))
(non-en-dir? (member cur-dir langs-dirs))
(date (substring link-no-../-prefix 0 10))
(short-date (get-short-date date)))
(define title-md)
(let-values (((i o _) (process MD (string-split MD-opts))))
(display (string-append title "\n") o)
(close-output-port o)
(set! title-md (apply string-append (read-lines i)))
(close-input-port i))
(set! title-md (irregex-replace "<p>(.*)</p>" title-md 1))
(print "<tr><td>" short-date "</td>\n"
"<td><a href=\"" link "\""
(if (and (member cur-dir langs-dirs) ; e.g. "fa"
en-link?)
" hreflang=\"en\""
"")
">" title-md "</a>"
(if (and (equal? cur-dir "fa")
en-link?)
" <small>(انگلیسی)</small>"
"")
"</td></tr>\n"))))
(define (usage prog exit-code)
(print "usage: " prog " filename")
(exit exit-code))
(define (main)
(let ((args (command-line-arguments)))
(when (null? args)
(usage (program-name) 1))
(set! MD (or (get-environment-variable "MD") "lowdown"))
(set! MD-opts (or (get-environment-variable "MD_opts") ""))
(set! cur-dir (pathname-strip-directory (current-directory)))
(call-with-input-file (car args)
(lambda (port)
(for-each process-line (read-lines port))))))
(main)
