Browse Source

Initial commit

main
Dylan Baker 1 year ago
commit
e810623bb2
10 changed files with 122 additions and 0 deletions
  1. 5
    0
      .gitignore
  2. 3
    0
      Makefile
  3. 15
    0
      build.scm
  4. 12
    0
      config.scm
  5. 16
    0
      io.scm
  6. 18
    0
      lament.scm
  7. 11
    0
      paths.scm
  8. 16
    0
      render.scm
  9. 14
    0
      templates.scm
  10. 12
    0
      utils.scm

+ 5
- 0
.gitignore View File

@@ -0,0 +1,5 @@
1
+*.so
2
+*.o
3
+*.link
4
+*.import.scm
5
+lament

+ 3
- 0
Makefile View File

@@ -0,0 +1,3 @@
1
+lament:
2
+	csm -static -program lament
3
+	rm -f *.o *.so *.import.scm *.link

+ 15
- 0
build.scm View File

@@ -0,0 +1,15 @@
1
+(module build (build-posts build-post)
2
+  (import scheme (chicken io))
3
+
4
+  (import config paths)
5
+
6
+  (define (build-post config post)
7
+    (let* ([path (car post)]
8
+           [content (cdr post)]
9
+           [absolute-path (absolute-build-path config path)])
10
+      (call-with-output-file
11
+        absolute-path
12
+        (lambda (port) (write-string content #f port)))))
13
+
14
+  (define (build-posts config posts)
15
+    (map (lambda (post) (build-post config post)) posts)))

+ 12
- 0
config.scm View File

@@ -0,0 +1,12 @@
1
+(module config *
2
+  (import scheme)
3
+
4
+  (import (chicken base))
5
+
6
+  (define-record config posts-dir build-dir)
7
+  
8
+  (define (build-config args)
9
+    (let* ([source-dir (car args)]
10
+           [posts-dir (string-append source-dir "/posts")]
11
+           [build-dir (string-append source-dir "/build")])
12
+      (make-config posts-dir build-dir))))

+ 16
- 0
io.scm View File

@@ -0,0 +1,16 @@
1
+(module io *
2
+  (import scheme (chicken file) (chicken io))
3
+
4
+  (import config paths)
5
+
6
+  (define (read-post-file config path)
7
+    (let ([absolute-path (absolute-post-path config path)])
8
+      (call-with-input-file absolute-path (lambda (port) (read-string #f port)))))
9
+
10
+  (define (fetch-posts config)
11
+    (let* ([posts-path (config-posts-dir config)]
12
+           [post-paths (directory posts-path)])
13
+      (map
14
+        (lambda (path)
15
+          (cons path (read-post-file config path)))
16
+        post-paths))))

+ 18
- 0
lament.scm View File

@@ -0,0 +1,18 @@
1
+(module lament *
2
+  (import scheme (chicken process-context))
3
+
4
+  (import config build io paths render templates utils)
5
+
6
+  (define (template content)
7
+    `(html
8
+      (head
9
+        (title "My Website"))
10
+      (body
11
+        (div ,content))))
12
+   
13
+  (if (> (length (command-line-arguments)) 0)
14
+    (let* ([config (build-config (command-line-arguments))]
15
+           [posts (fetch-posts config)]
16
+           [rendered-posts (render-posts posts template)])
17
+      (build-posts config rendered-posts))
18
+    (display "Error: path to source directory is required\n")))

+ 11
- 0
paths.scm View File

@@ -0,0 +1,11 @@
1
+(module paths (absolute-post-path absolute-build-path)
2
+  (import scheme)
3
+
4
+  (import config utils)
5
+
6
+  (define (absolute-post-path config path)
7
+    (string-append (config-posts-dir config) "/" path))
8
+
9
+  (define (absolute-build-path config path)
10
+    (string-append
11
+      (config-build-dir config) "/" (replace-extension path ".md" ".html"))))

+ 16
- 0
render.scm View File

@@ -0,0 +1,16 @@
1
+(module render *
2
+  (import scheme)
3
+
4
+  (import templates utils)
5
+
6
+  (define (render post template)
7
+    (let ([rendered-markdown (render-markdown post)])
8
+      (render-template (template rendered-markdown))))
9
+
10
+  (define (render-posts posts template)
11
+    (map
12
+      (lambda (post)
13
+        (let ([title (car post)]
14
+              [body (cdr post)])
15
+          (cons title (render body template))))
16
+      posts)))

+ 14
- 0
templates.scm View File

@@ -0,0 +1,14 @@
1
+(module templates (render-template)
2
+  (import scheme (chicken string))
3
+
4
+  (define (render-template node)
5
+    (cond
6
+      ((eq? node '()) "")
7
+      ((string? node) node)
8
+      (else 
9
+        (let* ([tag (symbol->string (car node))]
10
+               [body (cdr node)])
11
+          (string-append
12
+            "<" tag ">"
13
+            (string-intersperse (map render-template body) "")
14
+            "</" tag ">"))))))

+ 12
- 0
utils.scm View File

@@ -0,0 +1,12 @@
1
+(module utils (render-markdown replace-extension)
2
+  (import
3
+    scheme
4
+    lowdown
5
+    (chicken port)
6
+    (chicken string))
7
+
8
+  (define (replace-extension s old new)
9
+    (string-append (string-chomp s old) new))
10
+
11
+  (define (render-markdown content)
12
+    (with-output-to-string (lambda () (markdown->html content)))))

Loading…
Cancel
Save