viable first brush at breaking code into modules

This commit is contained in:
pho4cexa 2023-02-04 21:40:06 -08:00
parent 3d17ca5d78
commit 936a37bc76
4 changed files with 126 additions and 85 deletions

View file

@ -1,15 +1,28 @@
DEPS = utf8 lowdown sxml-transforms clojurian symbol-utils scss srfi-1 srfi-13 srfi-14 ersatz
SRC = main.scm
LOCAL_MODULES = utils
DIR_INSTALL ?= /usr/local/bin
DIR_BUILD = .
BIN = repo2html
all: compile
default: compile
compile:
mkdir -p $(DIR_BUILD)/
csc -O3 -static ./$(SRC) -o $(DIR_BUILD)/$(BIN)
foo: foo.scm utils.import.scm utils.o
csc -O5 -I . -static -uses utils $< -o $@
# Note: things break if you use -O5 here.
%.import.scm: %.scm
csc -O4 -static -c -unit $* -j $* $<
$(DIR_BUILD)/$(BIN): $(SRC) $(DIR_BUILD) $(addsuffix .import.scm,$(LOCAL_MODULES))
csc -I . -static -uses utils $< -o $@ -strip
$(DIR_BUILD):
mkdir -p $@/
compile: $(DIR_BUILD)/$(BIN)
rm ./$(DIR_BUILD)/$(BIN).link
@ls -sh $(DIR_BUILD)/$(BIN)
@echo "Finished compiling a static binary in $(DIR_BUILD)/$(BIN)!"
dependencies:
@ -22,7 +35,7 @@ uninstall:
rm $(DIR_INSTALL)/$(PROG)
clean:
rm $(DIR_BUILD)/$(BIN)
rm -f $(DIR_BUILD)/$(BIN) foo repo2html *.link *.o *.import.scm
compile-on-debian-11:
# builds repo2html compatible with systems running glibc-2.31 and higher.

5
foo.scm Normal file
View file

@ -0,0 +1,5 @@
#!/usr/bin/csi -s
(import (utils))
(print (substring* "foo" 1 2))

View file

@ -19,88 +19,9 @@
sxml-transforms
symbol-utils ;; (unspecified-value)
utf8
utils
)
;; small utilities ---------------------------------
;; (bail [message [exit-status]])
;; end the program immediately.
;; if a message is provided, print it to the screen.
;; exit-status defaults to 1.
(define (bail #!optional msg (status 1))
(when msg (print msg))
(exit status))
;; clojureish "debugging by print statement" tool since i still haven't reached
;; lisp enlightenment
(define ((inspect #!optional label #!rest args) s)
(display (list label ":" args " => " s) (current-error-port))
(newline (current-error-port))
s)
;; decompose a path s into its constituent parts. returns values:
;;
;; root: "/" if it's an absolute path, "" if relative directory-elements: a list
;; of each directory from root, () if none basename: the filename with extension
;; removed like "readme" or ".bashrc" extension: the file extension with the
;; dot, like ".txt" or "" if none relative-root: the relative path from the
;; given path to the root
;; e.g foo/bar/baz.html -> ../../
;;
;; this is intended to provide default values that make for easier reassembly
;; into filenames.
;;
;; typical use:
;; (->> source-file
;; (pathparts)
;; (define-values (root elements basename extension relative-root)))
;;
(define (pathparts s)
(define-values (dirname basename extension)
(decompose-pathname s))
(define-values (origin root directory-elements)
(decompose-directory (or dirname "")))
;; discarding origin because idgaf about windows
(values (or root "")
(or directory-elements '())
basename
(if extension (string-append "." extension) "")
(->>
(or directory-elements '())
(map (constantly "../"))
(apply string-append))))
;; like (substring) but doesn't break if start and end are too big/small
(define (substring* s start end)
(substring s (max start 0) (min end (string-length s))))
;; merge alists a and b. values in b "win"
(define (alist-merge a b)
(lset-union (lambda (x y) (eq? (car x) (car y))) a b))
;; like alist-ref but works on nested alists by specifying a path (list of keys)
(define (alist-ref-in keys alist #!optional (test eqv?))
(if (null? (cdr keys))
(alist-ref (car keys) alist test)
(alist-ref-in (cdr keys) (alist-ref (car keys) alist test) test)))
;; like alist-update, but works on nested alists by specifying a path (list of
;; keys)
(define (alist-update-in keys value alist #!optional (test eqv?))
(cond
((not alist) #f)
((null? (cdr keys))
(alist-update (car keys) value alist test))
(else
(alist-update (car keys)
(alist-update-in (cdr keys) value (alist-ref (car keys) alist test) test)
alist test))))
(define (unless-equals s1 s2)
;; if s1 == s2, then s1, otherwise #f
(and (equal? s1 s2) s1))
;; auto-apply ids to headings ---------------------------------
(define (slugify inner)
(->

102
utils.scm Normal file
View file

@ -0,0 +1,102 @@
;; small utilities ---------------------------------
(module utils *
(import
scheme
(chicken base)
(chicken file)
(chicken format)
(chicken io)
(chicken pathname)
(chicken port)
(chicken process)
(chicken process-context)
(chicken string)
(clojurian syntax)
ersatz
lowdown
scss
srfi-1 ;; list utils
srfi-13 ;; string utils
srfi-14 ;; charsets
sxml-transforms
symbol-utils ;; (unspecified-value)
utf8)
;; (bail [message [exit-status]])
;; end the program immediately.
;; if a message is provided, print it to the screen.
;; exit-status defaults to 1.
(define (bail #!optional msg (status 1))
(when msg (print msg))
(exit status))
;; clojureish "debugging by print statement" tool since i still haven't reached
;; lisp enlightenment
(define ((inspect #!optional label #!rest args) s)
(display (list label ":" args " => " s) (current-error-port))
(newline (current-error-port))
s)
;; decompose a path s into its constituent parts. returns values:
;;
;; root: "/" if it's an absolute path, "" if relative directory-elements: a list
;; of each directory from root, () if none basename: the filename with extension
;; removed like "readme" or ".bashrc" extension: the file extension with the
;; dot, like ".txt" or "" if none relative-root: the relative path from the
;; given path to the root
;; e.g foo/bar/baz.html -> ../../
;;
;; this is intended to provide default values that make for easier reassembly
;; into filenames.
;;
;; typical use:
;; (->> source-file
;; (pathparts)
;; (define-values (root elements basename extension relative-root)))
;;
(define (pathparts s)
(define-values (dirname basename extension)
(decompose-pathname s))
(define-values (origin root directory-elements)
(decompose-directory (or dirname "")))
;; discarding origin because idgaf about windows
(values (or root "")
(or directory-elements '())
basename
(if extension (string-append "." extension) "")
(->>
(or directory-elements '())
(map (constantly "../"))
(apply string-append))))
;; like (substring) but doesn't break if start and end are too big/small
(define (substring* s start end)
(substring s (max start 0) (min end (string-length s))))
;; merge alists a and b. values in b "win"
(define (alist-merge a b)
(lset-union (lambda (x y) (eq? (car x) (car y))) a b))
;; like alist-ref but works on nested alists by specifying a path (list of keys)
(define (alist-ref-in keys alist #!optional (test eqv?))
(if (null? (cdr keys))
(alist-ref (car keys) alist test)
(alist-ref-in (cdr keys) (alist-ref (car keys) alist test) test)))
;; like alist-update, but works on nested alists by specifying a path (list of
;; keys)
(define (alist-update-in keys value alist #!optional (test eqv?))
(cond
((not alist) #f)
((null? (cdr keys))
(alist-update (car keys) value alist test))
(else
(alist-update (car keys)
(alist-update-in (cdr keys) value (alist-ref (car keys) alist test) test)
alist test))))
(define (unless-equals s1 s2)
;; if s1 == s2, then s1, otherwise #f
(and (equal? s1 s2) s1))
)