#lang racket/base
(require
  racket/string
  net/url
  web-server/web-server
  web-server/dispatchers/filesystem-map
  web-server/dispatchers/dispatch
  (prefix-in servlet: web-server/dispatchers/dispatch-servlets)
  (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
  (prefix-in files: web-server/dispatchers/dispatch-files)
  web-server/servlet/setup
  web-server/stuffers
  web-server/managers/none
  web-server/http/redirect
  web-server/http/request-structs
  web-server/private/mime-types
  "../collection/tree.rkt"
  "weblet-parameter.rkt"
  "website.rkt"
)

(provide
  make-webcontainer
  webcontainer-start
  webcontainer-add-weblet! webcontainer-set-404-weblet!
  webcontainer-add-symlink! webcontainer-add-redirection!
  webcontainer-add-matching-weblet!
  webcontainer-add-website!)

; webcontainer - a webserver to run weblets
; A weblet is a procedure taking a weblet-parameter and returning a response
(struct webcontainer
  (server-port ; Port to listen
   server-address ; Address to listen
   static ; Path to non-dynamic assets
   weblets ; weblets - dynamic pages
   symlinks ; symlinks for path linking to another weblet
   redirections ; redirections for path going to another website
   matching-weblets ; like weblets, but extract parameters from the url
   dispatcher ; servlet dispatcher
   not-found-dispatcher ; Dispatcher for not found elements
  ))

; Helper: Make a servlet
(define (make-servlet function)
  (make-stateless.servlet
    "."
    default-stuffer
    (create-none-manager #f)
    function))

; Helper: convert to a string list path, remove the empty elements in the path
(define (url->path url)
  (filter
    non-empty-string?
    (map
      path/param-path
      (url-path url))))

; Helper: check if the path match an element in the tree
(define (has-matching? tr path)
  (not (not (get-matching tr path))))

; Helper: produce a pair of weblet and hash table of params
(define (make-weblet-params weblet params)
  (let ((hparams (make-hash)))
    (if weblet
      (begin
        (for-each
          (lambda (x)
            (hash-set! hparams (car x) (cdr x)))
          params)
        (cons weblet hparams))
      #f)))

; Helper: get the weblet and extracted parameters if the path match an element in the tree
(define (get-matching tr path [params (list)])
  (cond
    ((and (eq? #f (tree-key tr)) (null? path))
     ; ROOT of the tree, and itself asked for
     (if (tree-value tr)
         (cons (tree-value tr) (make-hash))
         #f))
    ((null? path)
      ; Should not happen outside the ROOT => not found...
      #f)
    ((eq? #f (tree-key tr))
     ; ROOT of the tree, but not itself asked => pass to children with the same path
     (let ((ret
             (filter
               (lambda (x) x)
               (map
                 (lambda (x)
                   (get-matching x path params))
                 (tree-children tr)))))
       (if (null? ret)
         #f
         (car ret))))
    ((and (symbol? (tree-key tr)) (null? (cdr path)))
     ; match pattern, node found
     (make-weblet-params
       (tree-value tr)
       (cons (cons (tree-key tr) (car path))
             params)))
    ((symbol? (tree-key tr))
     ; match pattern + check children
     (let* ((p (cons (cons (tree-key tr) (car path)) params))
            (ret
              (filter
                (lambda (x) x)
                (map
                  (lambda (x)
                    (get-matching x (cdr path) p))
                  (tree-children tr)))))
        (if (null? ret)
          #f
          (car ret))))
    ((and (equal? (tree-key tr) (car path)) (null? (cdr path)))
      ; Node found
      (make-weblet-params (tree-value tr) params))
    ((equal? (tree-key tr) (car path))
      ; Check children
      (let ((ret
             (filter
               (lambda (x) x)
               (map
                 (lambda (x)
                   (get-matching x (cdr path) params))
                 (tree-children tr)))))
       (if (null? ret)
         #f
         (car ret))))
    (#t #f)
  ))

; Webcontainer constructor
(define (make-webcontainer
          #:port [port 8080]
          #:address [address #f]
          #:static [static (make-immutable-hash '(("" . "./static")))]
          )
  (let* ((weblets (make-hash))
         (symlinks (make-hash))
         (redirections (make-hash))
         (matching-weblets (make-tree))
         ; Servlet for weblets
         (weblet-servlet
           (make-servlet
             (lambda (req)
                (let* ((path (url->path (request-uri req)))
                       (weblet (hash-ref weblets path)))
                  (weblet (make-weblet-parameter #:request req #:path path))))))
         ; Servlet for symlinks
         (symlink-servlet
           (make-servlet
             (lambda (req)
                (let* ((path (url->path (request-uri req)))
                       (real-path (hash-ref symlinks path))
                       (weblet (hash-ref weblets real-path)))
                  (weblet (make-weblet-parameter #:request req #:path real-path))))))
         ; Servlet for redirections
         (redirection-servlet
           (make-servlet
            (lambda (req)
              (let* ((path (url->path (request-uri req)))
                     (to (hash-ref redirections path)))
                (redirect-to to permanently)))))
         ; Servlet for using matching servlets
         (matching-servlet
           (make-servlet
            (lambda (req)
              (let* ((path (url->path (request-uri req)))
                     (weblet-params (get-matching matching-weblets path)))
                ((car weblet-params) (make-weblet-parameter #:request req #:path path #:match (cdr weblet-params)))))))
         ; Not found servlet
         (not-found-servlet
           (make-servlet
             (lambda (req)
                (let* ((path (url->path (request-uri req)))
                       (weblet (hash-ref weblets 404)))
                  (weblet (make-weblet-parameter #:request req #:path path))))))
        )
    (webcontainer
      port
      address
      static
      weblets
      symlinks
      redirections
      matching-weblets
      ; dispatcher
      (lambda (url)
        (let ((path (url->path url)))
          (cond
            ((hash-has-key? redirections path) redirection-servlet)
            ((hash-has-key? symlinks path) symlink-servlet)
            ((hash-has-key? weblets path) weblet-servlet)
            ((has-matching? matching-weblets path) matching-servlet)
            (#t (next-dispatcher)))))
      ; not-found-dispatcher
      (lambda (url)
        not-found-servlet)
      )))

(define (remove-prefix path pfx)
  (cond
    ((null? pfx) path)
    ((null? path) path)
    ((equal? (car path) (car pfx))
     (remove-prefix (cdr path) (cdr pfx)))
    (#t path)))

; Start the server - do not return
(define (webcontainer-start wcontainer)
  (serve
    #:dispatch
      (apply
        sequencer:make
        (append
          ; File dispatchers for each entry in the static map
          (hash-map
            (webcontainer-static wcontainer)
            (lambda (root dir)
              (define root-path (clean-path root))
              (define dir-path (string->path dir))
              (files:make
                #:url->path (lambda (url)
                              ; Remove the root from the url
                              (define path-without-root
                                (remove-prefix
                                  (url->path url)
                                  root-path))
                              ; Build the new url
                              (define url-without-root
                                (path->url
                                  (string->path
                                    (string-join path-without-root "/" #:before-first "/"))))
                              ;
                              ((make-url->path dir-path) url-without-root))
                #:path->mime-type (make-path->mime-type "./mime.types"))))
          (list
            ; Servlet dispatcher
            (servlet:make (webcontainer-dispatcher wcontainer))
            ; 404 error servlet
            (servlet:make (webcontainer-not-found-dispatcher wcontainer))
            )))
    #:port (webcontainer-server-port wcontainer)
    #:listen-ip (webcontainer-server-address wcontainer))
  (do-not-return))

; Helper when defining a path to remove the unnecessary "/"
(define (clean-path str)
  (filter
    non-empty-string?
    (string-split str "/")))

; Add a weblet to the container
(define (webcontainer-add-weblet! wcontainer path weblet)
  (hash-set!
    (webcontainer-weblets wcontainer)
    (clean-path path)
    weblet))

; Set the 404 error page weblet
(define (webcontainer-set-404-weblet! wcontainer weblet)
  (hash-set!
    (webcontainer-weblets wcontainer)
    404
    weblet))

; Add an internal redirection: the link given refer to another weblet
(define (webcontainer-add-symlink! wcontainer from to)
  (hash-set!
    (webcontainer-symlinks wcontainer)
    (clean-path from)
    (clean-path to)))

; Add an external redirection: the link given goes to another website
(define (webcontainer-add-redirection! wcontainer from to)
  (hash-set!
    (webcontainer-redirections wcontainer)
    (clean-path from)
    to))

; Matching weblet: the path contain parameters to extract when matching
(define (webcontainer-add-matching-weblet! wcontainer path weblet)
  (tree-set!
    (webcontainer-matching-weblets wcontainer)
    (map
      (lambda (x)
        (if (and (string-prefix? x "{")
                 (string-suffix? x "}"))
          (string->symbol
            (substring x 1 (- (string-length x) 1)))
          x))
      (clean-path path))
    weblet))

; Add a full website to the webcontainer
(define (webcontainer-add-website! wcontainer wsite [parent-path ""])
  (define node (tree-value wsite))
  (define path (string-append parent-path "/" (website-node-url node)))
  (define type (website-node-type node))
  (define weblet (website-node-weblet node))
  (case type
    ((weblet)
     (webcontainer-add-weblet! wcontainer path weblet))
    ((symlink)
     (webcontainer-add-symlink! wcontainer path weblet))
    ((redirection)
     (webcontainer-add-redirection! wcontainer path weblet))
    ((matching-weblet)
     (webcontainer-add-matching-weblet! wcontainer path weblet))
    (else
      (error "Unexpected type: " type)))
  (for-each
    (lambda (child)
      (webcontainer-add-website! wcontainer child path))
    (tree-children wsite)))
