pollen/command.rkt

#lang racket/base
(require pollen/world)
(provide (all-defined-out))

(define (handle-test)
  `(displayln "raco pollen is installed correctly"))

(define (handle-help)
  `(displayln (format "Pollen commands:
help                  show this message
start  [dir] [port]   starts project server in dir (default is current dir) 
                          (default port is ~a)
render [dir] [dest]   render project in dir (default is current dir) 
                          to dest (default is desktop)
render filename       render filename only (can be source or output name)
clone                 copy project to desktop without source files" ,(world:current-server-port))))

(define (handle-render dir-or-path rest-args)  
  `(begin 
     (require pollen/render pollen/world pollen/file sugar pollen/pagetree racket/list)
     (parameterize ([current-directory (world:current-project-root)])
       (define dir-or-path ,dir-or-path)
       (apply render-batch (map ->complete-path (if (not (directory-exists? dir-or-path))
                                                    (begin
                                                      (displayln (format "Rendering ~a" dir-or-path)) 
                                                      (cons dir-or-path ',rest-args))
                                                    (let ([dir dir-or-path]) ; now we know it's a dir
                                                      (displayln (format "Rendering preproc & pagetree files in directory ~a" dir))
                                                      (define preprocs (filter preproc-source? (directory-list dir)))
                                                      (define static-pagetrees (filter pagetree-source? (directory-list dir)))
                                                      ;; if there are no static pagetrees, use make-project-pagetree
                                                      ;; (which will synthesize a pagetree if needed, which includes all sources)
                                                      (define pagetrees (if (empty? static-pagetrees)
                                                                            (list (make-project-pagetree dir))
                                                                            static-pagetrees))
                                                      (append* preprocs pagetrees))))))))


(define (handle-start directory [port #f])
  (if (not (directory-exists? directory))
      (error (format "~a is not a directory" directory))
      `(begin 
         (require pollen/server pollen/world)
         (parameterize ([world:current-project-root ,directory]
                        ,@(if port (list `(world:current-server-port ,port)) null))
           (start-server)))))


(define (handle-clone directory rest-args)
  (define target-path (or 
                       (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args))))
                       (build-path (find-system-path 'desk-dir) (string->path world:clone-directory-name))))
  
  `(begin
     (require racket/file pollen/file racket/list)
     (define (delete-it path)
       (cond
         [(directory-exists? path) (delete-directory/files path)]
         [(file-exists? path) (delete-file path)]))
     (define (contains-directory? possible-superdir possible-subdir)
       (define (has-prefix? xs prefix)
         (and (>= (length xs) (length prefix))
              (andmap equal? prefix (take xs (length prefix)))))
       ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir)))
     (define source-dir (simplify-path ,directory))
     (when (not (directory-exists? source-dir)) (error 'clone (format "source directory ~a does not exist" source-dir)))
     (define target-dir (simplify-path ,target-path))
     (when (source-dir . contains-directory? . target-dir) (error 'clone "aborted because target directory for cloning (~a) can't be inside source directory (~a)" target-dir source-dir))
     (displayln "Cloning ...")
     (when (directory-exists? target-dir) (delete-directory/files target-dir))
     (copy-directory/files source-dir target-dir)
     (for-each delete-it (find-files pollen-related-file? target-dir))
     (displayln (format "Completed to ~a" target-dir))))

(define (handle-else command)
  `(if (regexp-match #rx"(shit|fuck)" ,command)
       (displayln (let ([responses '("Cursing at free software? Really?" "How uncouth." "Same to you, buddy.")])
                    (list-ref responses (random (length responses)))))
       (displayln (format "unknown command ~a" ,command))))