Commits

Anonymous committed 699b474

initial commit

Comments (0)

Files changed (9)

+(import chicken scheme)
+(use files posix extras)
+
+(define pages
+  (make-parameter '()))
+
+(define page-readers
+  (make-parameter
+   '(("md" . ,read-markdown-page))))
+
+(define-record page
+  type ; a symbol denoting this file's type (static, dynamic or directory)
+  source-path                           ; path to  the source file
+  path ; TODO: base path (i.e. the path leading up to page.scm) - separate slot? attr?
+  attrs              ; attributes as passed to define-page
+  parts)             ; some representation of the different page parts
+
+(define-record-printer (page page out)
+  (display "#<page " out)
+  (write (page-type page))
+  (display " ")
+  (write (page-path page) out)
+  (display ">" out))
+
+(define current-page-path
+  (make-parameter #f))
+
+(define (register-page! type path #!optional (attrs '()))
+  (let* ((source-path (make-pathname (current-directory) path))
+         (page (make-page type source-path path attrs '())))
+    (pages (cons page (pages)))))
+
+(define (define-page . attrs)
+  (register-page! 'dynamic (current-page-path) attrs))
+
+(define (dynamic-page-file? f)
+  (and (equal? (pathname-file f) "page")
+       (equal? (pathname-extension f) "scm")))
+
+(define (page-part-file? f)
+  (equal? (pathname-extension (pathname-file f)) "part"))
+
+(define (load-pages! root)
+  (pages '())
+  (parameterize ((current-directory root))
+    (find-files ""
+                action: (lambda (file _)
+                          (cond ((dynamic-page-file? file)
+                                 (parameterize ((current-page-path file))
+                                   (load file)))
+                                ((directory? file)
+                                 (register-page! 'directory file))
+                                ((not (page-part-file? file))
+                                 (register-page! 'static file)))
+                          (void)))))
+
+(define (page-attr page attr)
+  (let loop ((attrs (page-attrs page)))
+    (and (pair? attrs)
+         (if (eq? attr (car attrs))
+             (cadr attrs)
+             (loop (cddr attrs))))))
+
+;; Used to obtain a target path for a page part. By default it
+;; generates <page-path>/index.<ext>.
+(define make-page-path
+  (make-parameter
+   (lambda (page part)
+     (make-pathname (page-path page)
+                    (if (eq? 'content part) "index" (symbol->string part))
+                    (page-attr page extension:)))))
+
+
+;; Reads a page part, 'content by default, and returns its SXML
+;; representation. There will be a parameter (page-readers) or
+;; something which is an alist of file extensions to reader
+;; procedures. Those are checked in order for presence and the first
+;; matching one is used.
+(define (read-page page #!optional (part 'content))
+  page)
+
+;; The default page rendering function. A page rendering function must
+;; return a list of pairs with the car being the target path and the
+;; cdr being the SXML HTML representation of the page. By default it
+;; renders the page's `content` part and wraps it in the `default`
+;; layout and uses the current `make-page-path` function to generate
+;; its name.
+#;
+(define (render-page page #!key title extension path)
+  (list (cons ((make-page-path) page 'content)
+              (default-layout (read-page page 'content)))))
+
+
+(define (compile-page page dest)
+  (let ((page-dest-path (make-pathname dest (page-path page))))
+    (case (page-type page)
+      ((directory)
+       (print "creating directory " page-dest-path)
+       (create-directory page-dest-path))
+      ((static)
+       (print "copying to " page-dest-path)
+       (file-copy (page-source-path page) page-dest-path #t))
+      ((else (fprintf (current-error-port)
+                      "skipping page of unknown type: ~S"
+                      page))))))
+
+(define (compile-site #!key (src "src") (dest "out"))
+  (let ((dest (normalize-pathname dest))
+        (src  (normalize-pathname src)))
+    (load-pages! src)
+    (create-directory dest #t)
+    (for-each (lambda (page)
+                (compile-page page dest))
+              (reverse (pages)))))
+
+((synopsis "Ate is an SXML based static website compiler")
+ (author "Moritz Heidkamp")
+ (category web)
+ (license "BSD")
+ (depends)
+ (test-depends)
+ (foreign-depends))
+(module ate
+
+()
+
+"ate-impl.scm"
+
+)
+(compile -d0 -O2 -J -s ate.scm)
+(compile -d0 -O2 -s ate.import.scm)
+
+(install-extension
+ 'ate
+ '("ate.so" "ate.import.so")
+ '((version "0.0.1")))
+* postprocessing links
+  The final SXML (i.e. HTML) is transformed so that all `href`
+  attributes of `a` elements are checked whether the URI scheme is
+  `ate`. The path is then resolved according to the site's URI rules.
+
+  Example:
+    (path-prefix "/my-site/")
+    (a (@ (href "ate:foo/bar"))) => (a (@ (href "/my-site/foo/bar.html")))

ideas/page-dir/src/a-nice-page/content.part.md

+This is the content of a-nice-page/page.scm. It's discovered by Ate
+because its name is "content" followed by ".part" and an extension Ate
+knows about.

ideas/page-dir/src/a-nice-page/foo.txt

+hehe

ideas/page-dir/src/a-nice-page/page.scm

+;; (with-input-from-file "content.md" read-markdown)
+
+;; Adds an entry to a global (pages) alist parameter. The key will be
+;; the directory this file lives in (i.e. "/a-nice-page"), the value
+;; will be a page record (much like the one in hyde).
+(define-page
+  extension: "html" ;; (match-pages '((* extension: "html")))
+  title: "A nice page"
+  ;; this is the default
+  ;;  render: (list (with-template (part 'content 'index) 'default))
+  )
+
+;; (define (part name)
+;;   (lambda (page)
+;;     (read-part page name)))
+
+;; (with-template (part 'content) 'default) => 
+;; (lambda (page . attrs)
+;;   (apply read-template
+;;          'default
+;;          page: page
+;;          content: ((part 'content) page)
+;;          attrs))

ideas/page-dir/templates/default.scm

+(define-template (title content)
+  `(html
+    (head (title ,title))
+    (body
+     (header
+      (h1 ,title))
+     (section
+      (@ (id "content"))
+      ,content))))