Delete useful.scm

1 files changed, 0 insertions, 247 deletions

diff --git a/useful.scm b/useful.scm
deleted file mode 100644
index 52dd94c..0000000
--- a/useful.scm
+++ /dev/null
@@ -1,247 +0,0 @@
-;;; -*- coding: utf-8 -*-
-;;; 
-;;; This program is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation; either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (useful)
-  #:use-module (haunt html)
-  #:use-module (haunt reader)
-  #:use-module (haunt utils)
-  #:use-module (haunt asset)
-  #:use-module (haunt builder blog)
-  #:use-module (haunt page)
-  #:use-module (haunt post)
-  #:use-module (haunt site)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)
-  #:use-module (web uri)
-  #:use-module (ice-9 match)
-  #:use-module (sxml match)
-  #:use-module (sxml transform)
-  #:use-module (commonmark)
-  #:export (link*
-            default-theme
-            static-page
-            research-posts
-            projects-posts
-            centered-image
-            commonmark-reader*
-            date))
-
-;;; HTML utilities ---------------------------------------------------
-
-(define (link* name uri)
-  "Create a link with NAME to url URI."
-  `("[" (a (@ (href ,uri)) ,name) "]"))
-
-(define (stylesheet name)
-  "Use the stylesheet NAME.css saved locally in css/."
-  `(link (@ (rel "stylesheet")
-            (href ,(string-append "/css/" name ".css")))))
-
-(define (centered-image image)
-  "Create a centered image from source IMAGE."
-  `((div (@ (style "text-align: center")) (img (@ (src ,image))))))
-
-;;; Post processing utilities ----------------------------------------
-
-(define (date year month day)
-  "Create a SRFI-19 date for the given YEAR, MONTH, DAY"
-  (let ((tzoffset
-          (tm:gmtoff
-            (localtime (time-second (current-time))))))
-    (make-date 0 0 0 0 day month year tzoffset)))
-
-(define (first-paragraph post)
-  "Extract the first paragraph from POST."
-  (let loop ((sxml (post-sxml post)) (result '()))
-    (match sxml
-           (() (reverse result))
-           ((or (('p ...) _ ...) (paragraph _ ...))
-            (reverse (cons paragraph result)))
-           ((head . tail) (loop tail (cons head result))))))
-
-(define (contains? l m)
-  "Check if LIST contains MEMBER."
-  (if (null? l)
-    #f
-    (or (equal? (first l) m)
-        (contains? (drop l 1) m))))
-
-(define (research? post)
-  "Check if POST has a research tag."
-  (contains? (post-ref post 'tags) "research"))
-
-(define (projects? post)
-  "Check if POST has a projects tag."
-  (contains? (post-ref post 'tags) "projects"))
-
-(define (research-posts posts)
-  "Returns POSTS that contain research tag in reverse chronological order."
-  (posts/reverse-chronological
-   (filter research? posts)))
-
-(define (projects-posts posts)
-  "Returns POSTS that contain projects tag in reverse chronological order."
-  (posts/reverse-chronological
-   (filter projects? posts)))
-
-;;; Links ------------------------------------------------------------
-
-(define (github)
-  (link* "GitHub" "https://github.com/cristiancmoises"))
-
-(define (linkedin)
-  (link* "LinkedIn" "https://www.linkedin.com/in/cristiancezarmoises"))
-
-(define (orcid)
-  (link* "ResearchGate" "https://www.researchgate.net/profile/Cristian-Moises/research"))
-
-(define (arxiv)
-  (link* "TOR" "http://secopscj53y6qltbysxt2bhnr2ohwzi6bh6wbxonycgc6tdemj4xkmyd.onion/"))
-
-(define (ads)
-  (link* "Youtube" "https://youtube.com/@securityops"))
-
-(define (cc-by-sa)
-  (link* "CC BY-SA 4.0" "https://creativecommons.org/licenses/by-sa/4.0/"))
-
-;;; Website layout ---------------------------------------------------
-
-(define (header-box)
-  `(div (@ (id "block"))
-        (p "+>---------------------------<+")
-        (p ,(link* "About" "/about.html")--
-           ,(link* "Research" "/research.html")--
-           ,(link* "Projects" "/projects.html"))
-        (p "+>---------------------------<+")
-        (br)))
-
-(define (footer-box)
-  `(div (@ (id "block"))
-        (br)
-        (p "+>---------------------------<+")
-        (div ,(github)--
-             ,(linkedin))
-        (div ,(orcid)--
-             ,(arxiv)--
-             ,(ads))
-        (p "© 2024 Cristian Cezar Moises")
-        (p ,(cc-by-sa))
-        (p "Built with "
-           ,(link* "Haunt" "http://haunt.dthompson.us")
-           " in "
-           ,(link* "Scheme" "https://www.gnu.org/software/guile/guile.html"))
-        (p "+>---------------------------<+")))
-
-(define default-theme
-  (theme #:name
-         "default-theme"
-         #:layout
-         (lambda (site title body)
-           `((doctype "html")
-             (head (meta (@ (charset "utf-8")))
-		   (meta (@ (name "description")
-			    (content "C.C.M. personal website")))
-                   (meta (@ (name "viewport")
-                            (content "width=device-width, initial-scale=1")))
-                   (title ,(string-append title " — " (site-title site)))
-                   ,(stylesheet "default"))
-             (body (header ,(header-box))
-                   (div (@ (id "block")) ,body)
-                   (footer ,(footer-box)))))
-         #:post-template
-         (lambda (post)
-           `((h1 ,(post-ref post 'title))
-             (div ,(date->string (post-date post) "~B ~d, ~Y"))
-             (div ,(post-sxml post))))
-         #:collection-template
-         (lambda (site title posts prefix)
-           (define (post-uri post)
-             (string-append
-	      "/"
-	      (or prefix "")
-	      (site-post-slug site post)
-	      ".html"))
-           `((h1 ,title)
-             ,(map (lambda (post)
-                     (let ((uri (string-append
-				 "/"
-				 (site-post-slug site post)
-				 ".html")))
-                       `(div (h2 (a (@ (href ,uri)
-                                       (style "text-decoration: none;"))
-                                    ,(post-ref post 'title)))
-                             (div ,(date->string (post-date post) "~B ~d, ~Y"))
-                             (div ,(first-paragraph post))
-			     ,(link* "read more..." uri)
-			     (br)
-			     (p (@ (style "text-align: center;")) "-->--<--"))))
-                   posts)))))
-
-(define (static-page title file-name body)
-  "Create a static page with TITLE at html file FILENAME using page BODY."
-  (lambda (site posts)
-    (make-page
-     file-name
-     (with-layout default-theme site title body)
-     sxml->html)))
-
-;;; Custom markdown reader --------------------------------------------------
-
-(define (sxml-identity . args) args)
-
-;; Code block
-(define (code-block . tree)
-  (sxml-match
-   tree
-   ((pre (code ,source))
-    `(div (@ (id "code"))
-	  (pre (@ (style "overflow: auto")) (code ,source))))
-   (,other other)))
-
-;; Convert hrefs to custom hoverable link
-(define (hover-link . tree)
-  (sxml-match
-   tree
-   ((a (@ (href ,uri) unquote _) unquote name)
-    `(,(link* name uri)))))
-
-;; Center all images
-(define (center-images . tree)
-  (sxml-match
-   tree
-   ((img (@ (src ,uri) unquote _))
-    `(,(centered-image uri)))))
-
-(define %commonmark-rules
-  `((pre unquote code-block)
-    (a unquote hover-link)
-    (img unquote center-images)
-    (*text* unquote (lambda (tag str) str))
-    (*default* unquote sxml-identity)))
-
-(define (post-process-commonmark sxml)
-  (pre-post-order sxml %commonmark-rules))
-
-(define commonmark-reader*
-  (make-reader
-   (make-file-extension-matcher "md")
-   (lambda (file)
-     (call-with-input-file
-	 file
-       (lambda (port)
-	 (values
-	  (read-metadata-headers port)
-	  (post-process-commonmark (commonmark->sxml port))))))))