(use awful sxml-transforms doctype)
(use awful-sql-de-lite sql-de-lite)
(use spiffy)
(use regex)
  ;TODO: Disable the spiffy filesystem handler

; Use SXML transforms to generate the pages.
(define (define-sxml-page path contents)
  (define-page path
    (lambda args
      (with-output-to-string
        (lambda ()
          (SXML->HTML `(body ,(apply contents args)))
          (awful-response-headers '((content-type "text/html")))))) ; content-type persists in a reused thread
    doctype: doctype-xhtml-1.0-transitional
    css: (++ (main-page-path) "pdam.css")))


;(enable-session #t)

(enable-session-inspector "session-inspector")
(session-inspector-access-control
 (lambda ()
   #f))


(enable-db)
(db-credentials "photo-assets.sqlite")


(define-login-trampoline "/login-trampoline")

(valid-password?
  (lambda (user password)
    (equal? user password)))

(define-page (login-page-path)
  (lambda ()
    (login-form))
  no-session: #t)


; Procedures

; Take a piece of text and render it into a series of html lines.
(define (render-text text)
  (if (string? text)
    (let ((lines (string-split text "\n")))
      (append (list (car lines)) (map (lambda (line) `((br) ,line)) (cdr lines))))
    #f)
  )

; Call the iterator to get an alist. Render the a list according to the headings.
; Produce an SXML table with each alist returned from the iterator rendered as an SXML row.
(define (render-row-as-row iter headings)
  ; Turn the results of the query into table rows.
  (let ((rows '()))
    (let loop ((row (iter)))
      (if (not (null? row))
        (begin
          (set! rows (append! rows
                              `((tr
                                  ,(map (lambda (col)
                                          (let ((col_href (alist-ref (string->symbol (++ col "_href")) row))
                                                (col_data (alist-ref (string->symbol col) row)))
                                            (if (string? col_href)
                                              `(td (a (@ href ,(++ (main-page-path) col_href)) ,col_data))
                                              `(td ,(render-text col_data))
                                              )))
                                        headings)))
                              ))
          (loop (iter)))))
    `(table
       ; Create table headings for the column names that don't end with "_href".
       ,(map (lambda (col) `(th ,col)) headings)
       ; Populate the rows of the table with the rows generated from the query.
       ,rows
       )
    ))

; Call the iterator to get an alist. Render the a list according to the headings.
; Produce an SXML table with each alist returned from the iterator rendered as a set of SXML rows.
(define (render-row-as-col iter headings)
  (let ((rows '())
        (imgs '()))
    (let loop ((row (iter)))
      (if (not (null? row))
        (begin
          (set! rows (append! rows
                              (map (lambda (col)
                                     (let ((col_href (alist-ref (string->symbol (++ col "_href")) row))
                                           (col_data (alist-ref (string->symbol col) row)))
                                       `(tr
                                          (th ,col)
                                          ,(if (string? col_href)
                                             `(td (a (@ href ,(++ (main-page-path) col_href)) ,col_data))
                                             `(td ,(render-text col_data))
                                             ))))
                                   headings)))
          (set! imgs (append! imgs (let ((img (alist-ref (string->symbol "_img") row)))
                                     (if img `(img (@ src ,(++ (main-page-path) img))) '()))))
          (loop (iter)))))
    `(
      ,imgs
      (table
        ,rows))))

; Call the iterator once. Set the content type and return an appropriately
; stringified blob.
; We can only have one of these per response.
(define (render-row-as-image iter headings)
  (let* ((row (iter))
         (img (alist-ref (string->symbol "img") row))
         (img_mime (alist-ref (string->symbol "img_mime_type") row)))
    (awful-response-headers `((content-type ,img_mime)))
   (blob->string img)))

(define (render-row-as-image-sender iter headings)
  (let* ((row (iter))
         (directory (alist-ref (string->symbol "directory") row))
         (filename (alist-ref (string->symbol "filename") row))
         (img_mime (alist-ref (string->symbol "mime_type") row)))
    (awful-response-headers `((content-type ,img_mime)))
    (parameterize ((root-path directory))
                  (send-static-file filename))
   ))


; Return a procedure that runs a query of the form "SELECT * FROM <table>;" and tries to render it with the supplied renderer.
(define (create-view-renderer renderer)
  (lambda (stmt . args)
    (let*
      ;((stmt (prepare (db-connection) (++ "select * from " table ";")))
      ((stmt (prepare (db-connection) stmt))
       ; List of columns whose names don't end with _href
       (columns (filter (lambda (col) (and (= 0 (string-prefix-length col "_")) (= 0 (string-suffix-length col "_href"))))
                        (map symbol->string (column-names stmt))))
       (rows '()))

      (apply bind-parameters stmt args)
      (set! rows (renderer (lambda () (fetch-alist stmt)) columns))
      (finalize stmt)
      rows
      )))

; Run a query of the form "SELECT * FROM <table>;" and try to render it into an SXML table.
(define render-view (create-view-renderer render-row-as-row))

; Run a query and render each result column as an SXML row.
; This is useful for queries that return a single result.
(define render-row (create-view-renderer render-row-as-col))

; Run a query and render the result as an image.
; Set the awful-response-header content-type.
(define render-image (create-view-renderer render-row-as-image))

; Run a query, find the file mentioned in the results and send it to the browser.
; Set the awful-response-header content-type.
(define send-image (create-view-renderer render-row-as-image-sender))



; Page defintions follow


(define-sxml-page (main-page-path)
  (lambda ()
   `((h1 "Photo Digital Asset Management v0.1")
     (ul
      (li (a (@ href "/assets/") "Asset List"))
      (li (a (@ href "/tags/") "Tag List"))
      ))
  ))

(define-sxml-page "assets"
 (lambda ()
  `((h1 "Full Asset List")
    (p "This report lists all assets in the system.")
    ,(render-view "select * from v_assets;"))
   ))

(define-sxml-page (regexp "/assets/[^/]+")
 (lambda (path)
  (let* ((paths (string-split path "/"))
         (asset_id (second paths))
         )
    `((h1 "Asset " ,asset_id)
      ,(render-row "select * from v_assets where asset_id=@AI;" asset_id)
      (img (@ (src ,(string-append "/files/" asset_id "/THUMBNAIL")) (alt "THUMBNAIL")))
      ,(render-view "select * from v_images where asset_id=@AI;" asset_id)
      )
  )))

;(define-page (regexp "/files/[^/]+/[^/]+")
; (lambda (path)
;  (let* ((paths (string-split path "/"))
;         (asset_id (second paths))
;         (type     (third paths)))
;    (send-image "select * from v_images where asset_id = @asset_id and type = @type;" asset_id type)
;    "")) no-template: #t)