path: root/Makefile.scm

#|
#!/usr/bin/env sh
exec chibi-scheme -A utils/ $0 $@
|#
(import (chibi)
        (chibi json)
        (chibi string)
        (only (chibi filesystem)
              directory-files
              create-directory*
              file-directory?)
        (chibi process)
        (only (chibi pathname) path-strip-directory path-extension make-path)
        ;(chibi app)
        (prefix (chibi io) io:)
        (utils cover cover)
        (srfi 1)
        (srfi 16)
        (srfi 95))

(define debug #t)

(define (directory-files-not-hidden dir)
  (filter
    (lambda (x) (not (string-prefix? "." x)))
    (directory-files dir)))

(define (directory-sources lang dir)
  (map (lambda (x) (make-path dir lang x))
       (sort (filter
               (lambda (x)
                 (let ((extension (or (path-extension x) "")))
                   (any (lambda (x) (string=? x extension))
                        '("latex" "tex" "md"))))
               (directory-files-not-hidden (make-path dir lang))) string<?)))

(define (directory-meta lang dir)
  (make-path dir lang "Metadata.yaml"))

(define (process->string-or-fail call errmsg)
  (let* ((res (process->output+error+status call))
         (out (first res))
         (err (second res))
         (strcall (string-join call " "))
         (status (third res)))
    (if (= status 0)
        (begin
          (if debug
            (display
              (string-append "\nDEBUG: Called: " strcall "\n" err)
              (current-error-port)))
          out)
        (error (string-append
                 "\n"
                 errmsg
                 "\nIn call: " strcall
                 "\n" err)))))

(define (read-meta file)
  (string->json
    (process->string-or-fail
      `("./utils/yaml2json.py" ,file)
      "Error parsing Metadata file")))

(define (pandoc-web-simple lang output input)
  (let ((outpath  (make-path output lang))
        (files    (directory-sources lang input))
        (metafile (directory-meta lang input)))
    (create-directory* outpath)
    (process->string-or-fail
      (append
        (list
          "pandoc"
          "--to=html"
          "-o" (make-path outpath "web-simple.html")
          "--standalone"
          "--embed-resources"
          ;"--self-contained" ; Old way to do --embed-resources
          "--mathml"
          "--no-highlight"
          "--data-dir=."
          (string-append "--resource-path=" input)
          ; "--base-header-level=2" This is the old way
          "--shift-heading-level-by=1" ;is the new way
          "--template=web-simple.html"
          "--lua-filter=toc.lua"
          "--lua-filter=anchored-h.lua"
          "--lua-filter=appendixes.lua"
          "--metadata-file" metafile)
        files)
      "Error in web-page creation")))


(define (pandoc-web lang output input)
  (let ((outpath  (make-path output lang))
        (files    (directory-sources lang input))
        (metafile (directory-meta lang input)))
    (create-directory* outpath)
    (process->string-or-fail
      (append
        (list
          "pandoc"
          "--to=html"
          "-o" (make-path outpath "web.html")
          "--standalone"
          "--mathml"
          "--embed-resources"
          ;"--self-contained" ; Old way to do --embed-resources
          ; "--base-header-level=2" This is the old way
          "--shift-heading-level-by=1" ;is the new way
          "--data-dir=."
          (string-append "--resource-path=./templates/web/:"
                         "./templates:"
                         input)
          "--template=web.html"
          "--lua-filter=toc.lua"
          "--lua-filter=anchored-h.lua"
          "--lua-filter=appendixes.lua"
          "--metadata-file" metafile)
        files)
      "Error in simple web-page creation")))

(define (pandoc-book lang output input)
  (let ((outpath  (make-path output lang))
        (files    (directory-sources lang input))
        (metafile (directory-meta lang input)))
    (create-directory* outpath)
    (process->string-or-fail
      (append
        (list
          "pandoc"
          "-o" (make-path outpath "book.pdf")
          "--standalone"
          "--pdf-engine=xelatex"
          "--data-dir=."
          (string-append "--resource-path=" input)
          "--template=book.latex"
          "--lua-filter=appendixes.lua"
          "--metadata-file" metafile)
        files)
      "Error in book creation")))

(define (pandoc-book-simple lang output input)
  (let ((outpath  (make-path output lang))
        (files    (directory-sources lang input))
        (metafile (directory-meta lang input)))
    (create-directory* outpath)
    (process->string-or-fail
      (append
        (list
          "pandoc"
          "-o" (make-path outpath "book-simple.pdf")
          "--standalone"
          "--pdf-engine=xelatex"
          "--data-dir=."
          (string-append "--resource-path=" input)
          "--template=book-simple.latex"
          "--lua-filter=appendixes.lua"
          "--metadata-file" metafile)
        files)
      "Error in simple book creation")))

(define (pandoc-epub lang output input)
  (let ((outpath  (make-path output lang))
        (files    (directory-sources lang input))
        (metafile (directory-meta lang input)))
    (create-directory* outpath)
    (process->string-or-fail
      (append
        (list
          "pandoc"
          "-o" (make-path outpath "book.epub")
          "--standalone"
          "--data-dir=."
          (string-append "--resource-path=" input)
          "--css=./templates/ebook/epub.css"
          "--template=book.epub"
          "--lua-filter=appendixes.lua"
          "--metadata-file" metafile)
        files)
      "Error in ebook creation")))

(define (get-print-box svg-file)
  "SVG covers have a rectangle `meta-content-box` prepared to serve as the
  printing bounding box. Its position is the (x0,y0) and (width,height) is
  (x1,y1). This function extracts that information."
  (string-join
    (string-split
      (process->string-or-fail
        `("inkscape"
          ,svg-file
          "-I" "meta-content-box"
          "-XYWH")
        "Error: impossible to extract cover printing bounding box")
      #\newline)
    ":"))
(define (make-cover lang output input)
  (let* ((outpath  (make-path output lang))
         (files    (directory-sources lang input))
         (metafile (directory-meta lang input))
         (metadata (read-meta metafile))
         (svg-file (make-path outpath "cover.svg")))
    (create-directory* outpath)
    (call-with-output-file
      svg-file
      (lambda (out)
        (metadata->svg metadata out)))
    (process->string-or-fail
      (append
        `("inkscape"
          "--export-filename" ,(make-path outpath "cover.pdf")
          "--export-type=pdf"
          ,svg-file))
      "Error in PDF cover creation")

    (process->string-or-fail
      (append
        `("inkscape"
          ,svg-file
          "--export-filename" ,(make-path outpath "cover.png")
          "--export-type=png"
          "--export-background=white"
          "--export-background-opacity=1.0"
          "--export-area" ,(get-print-box svg-file)))
      "Error in PNG cover creation")))

(define (build-lang lang output input)
  (pandoc-web         lang output input)
  (pandoc-web-simple  lang output input)
  (pandoc-book        lang output input)
  (pandoc-book-simple lang output input)
  (pandoc-epub        lang output input)
  (make-cover         lang output input))

(define (get-langs input)
  (filter
    (lambda (l) (and (file-directory? (make-path input l))
                     (= 2 (string-length l))))
    (directory-files-not-hidden input)))

(define (build input)
  (let* ((bookname  (path-strip-directory (string-trim-right input #\/)))
         (output    (make-path "out" bookname)))
    (map (lambda (lang)
           (build-lang lang output input))
         (get-langs input))))




;; RUN THIS LIKE:
;; chibi-scheme Makefile.scm src/BOOK_FOLDER ...
;;
;; It will dump the compiled book to .out/BOOK_FOLDER/LANG/FORMAT.EXT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(map build (cdr (command-line)))