#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SHP: Hypertext Processor
;;
;; a PHP like web framework for PLT Scheme
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; script.ss - managing the generated script object (along with the path)
;;             this module replaces part of the handler.ss
;; yc 7/7/2010 - first version.
(require "base.ss"
         "depend.ss"
         "request.ss"
         "response.ss"
         "cookie.ss"
         "convert.ss" 
         )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BASE structs for path & script manipulation

;; *path holds the abstraction of server path.
;; base is the actual starting root, virtual is what's passed in, full is the actual absolute path
;; and mtime is the last modified time.
(define-struct *path (base virtual full mtime))

;; script holds the representation of the script
;; inner is the compiled procedure from the script
;; path is an *path object.
;; script is also a procedure wrapper that will call inner.
(define-struct script (inner path)  
  #:property prop:procedure 0)

;; script-mtime
;; a helper to determine the mtime
(define (script-mtime s) 
  (*path-mtime (script-path s))) 

(provide/contract 
 (struct *path ((base path-string?)
                (virtual path-equiv?)
                (full path-string?)
                (mtime exact-nonnegative-integer?)))
 (struct script ((inner procedure?)
                 (path *path?)))
 (script-mtime (-> script? exact-nonnegative-integer?)) 
 )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; path related functions
;; takes a path and break it up into segments.
(define (path->segments path)
  (define (helper segments) 
    (filter (lambda (segment)
              (not (equal? segment "")))
            segments))
  ;; remove the "" at the beginning and the end, but not in the middle
  (helper (if (url? path)
              (map path/param-path (url-path path))
              (regexp-split #px"\\/" 
                            (if (path? path)
                                (path->string path)
                                path)))))

;; partially matching the path from the beginning of the path
(define (segments->partial-path segments base default orig)
  (define (helper rest path default)
    ;; if we did not find any match return not-found
    (cond ((null? rest) 
           (raise-http-not-found! orig))
          ;; then we test to see if this is a directory path & whether the default file exists for the directory
          ((file-exists? (build-path path (car rest))) ;; otherwise the segment is a file and see if it exists...
           ($pathinfo (cdr rest)) ;; udpdating the pathinfo so it can be accessed.
           (build-path path (car rest)))
          ((not (directory-exists? (build-path path (car rest))))
           (raise-http-not-found! orig))
          ((file-exists? (build-path path (car rest) default)) 
           ($pathinfo (cdr rest)) ;; updating the pathinfo so it can be accessed.
           (build-path path (car rest) default))
          (else
           (helper (cdr rest) (build-path path (car rest)) default))))
  (helper segments base default))

;; convert segments to path.
(define (segments->path segments base default partial? orig)
  ;; test for full path first and then partial path.
  (let ((script (apply build-path base segments)))
    (cond ((file-exists? script) script)
          ((and (directory-exists? script)
                (file-exists? (build-path script default)))
           (build-path script default))
          (partial? 
           (segments->partial-path segments base default orig)) 
          (else 
           (raise-http-not-found! orig)))))

;; resolve the path (which is not a list of segments) - wraps segments->path
(define (resolve-path path base default (partial? #t)) 
  (segments->path (path->segments path) base default partial? path)) 
;; (trace resolve-path)

;; (->* (shp? path-string-url?) (boolean?) *path?)
(define (build-script-path server path (partial? #t)) 
  (let ((full (resolve-path path (shp-base server) (shp-default server) partial?)))
    (make-*path (shp-base server) 
                path
                full 
                (mtime full)))) 

(provide/contract 
 (build-script-path (->* (shp? path-equiv?)
                         (boolean?)
                         *path?))
 )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; script compilation
;; parse and converts the script file into the script object based on the syntax.

;; (-> require-specs? any)
;; run required modules.
(define (require-modules! terms)
  (define (require! module)
    (namespace-require module))
  (define (helper listof-modules)
    (for-each (lambda (modules)
                (for-each require! modules))
              listof-modules))
  (helper (map cdr (filter require-exp? terms))))

;; determine whether the exp is a require expression.
(define (require-exp? term)
  (and (pair? term) (equal? (car term) 'require)))

;; determine whether the expression is an :args expression
(define (args-exp? term)
  (and (pair? term) (equal? (car term) ':args)))

;; filter the exps into the args expression.
(define (terms->args terms) 
  (define (helper args)
    (cond ((null? args) '()) ;; if none just return null
          ((not (null? (cdr args))) ;; cannot have more than one
           (error 'filter-args "multiple args statement: ~a" args))
          (else (cdr (car args))))) 
  (helper (filter args-exp? terms)))

;; determine whether the exp is an :api-args exp
(define (api-args-exp? term) 
  (and (pair? term) (equal? (car term) ':api-args)))

;; filter the expressions to get the api-args expression
(define (terms->api-args terms) 
  (define (helper args)
    (cond ((null? args) '()) ;; if none just return null
          ((not (null? (cdr args))) ;; cannot have more than one
           (error 'filter-api-args "multiple args statement: ~a" args))
          (else (cdr (car args))))) 
  (helper (filter api-args-exp? terms)))

;; filter the expression so we are left with the exps we want to compile into the procedure
(define (terms->exps terms)
  (let ((exps (filter (lambda (exp)
                        (and (not (require-exp? exp))
                             (not (args-exp? exp))
                             (not (api-args-exp? exp))))
                      terms)))
    (if (null? exps) 
        '("") ;; ensure there is at least one exp in the lambda.
        exps)))

;; compile the procedure - wraps around the whole filter process.
(define (evaluate-terms terms path namespace)
  (define (build-webcall args path exps) 
    (eval `(call! ,args 
                  (parameterize ((__PATH__ ,path))
                    . ,exps))))
  (parameterize ((current-namespace namespace))
    (require-modules! terms) ;; first register the required modules
    ;; we need to determine whether this is a regular page, a include function, or
    ;; an API.
    ;; an regular page has no :args or :api-args.
    ;; if both are null we go with the non call version!
    (let ((args (terms->args terms))
          (api-args (terms->api-args terms))
          (exps (terms->exps terms))
          (path (path->string path)))
      (if (null? api-args) ;; APIs are only declared when there are params... 
          (eval `(lambda ,args 
                   (parameterize ((__PATH__ ,path))
                     . ,exps))
                namespace)
          (build-webcall api-args path exps)))))

;; convert the path & namespace into the script.
(define (evaluate-script path namespace)
  (evaluate-terms (file->values path) path namespace))

;; build the script based on taking in a *path object.
(define (build-script/*path shp path)
  (make-script (evaluate-script (*path-full path) (shp-namespace shp))
               path))

;; build the script when we do not have a path-string-url? instead of *path object.
(define (build-script shp path (partial? #t)) 
  (build-script/*path shp (build-script-path shp path partial?)))

;; ensure the path exists (or throw not-found), and verify the timestamp of the script
;; to recompile as required, and return the script object.
(define (ensure-script-handler! shp path)
  (let* ((p (build-script-path shp path))
         (full (*path-full p)))
    (let ((it (registry-ref (shp-handlers shp) full #f))) 
      (cond ((or (not it) (> (*path-mtime p) (script-mtime it))) 
             (registry-set! (shp-handlers shp) full (build-script/*path shp p))
             (registry-ref (shp-handlers shp) full 
                           (lambda () 
                             (raise-http-not-found! path))))
            (else it)))))
;; (trace ensure-script-handler!)

;; include! is used to include other scripts from within a script.
(define (include! path . args) 
  (let ((script (ensure-script-handler! ($server) path))) 
    (apply script args)))


(provide/contract 
 (require-modules! (-> any/c any)) 
 (build-script/*path (-> shp? *path? script?))
 (build-script (->* (shp? path-equiv?)
                    (boolean?)
                    script?))
 (ensure-script-handler! (-> shp? path-equiv? script?))
 (include! (->* (path-equiv?)
                ()
                #:rest (listof any/c)
                any))
 )