#lang racket/base

(require db
         json
         racket/file
         racket/list
         racket/path
         racket/string
         "config.rkt"
         "database.rkt"
         "todo.rkt")

(provide ensure-wiki-data!
         valid-slug?
         title->slug
         list-pages
         read-page
         create-page!
         update-page!
         archive-page!
         page-history
         read-version
         search-pages
         list-todos
         save-upload!
         uploaded-file)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Ensure writable installation directories exist.
; pre    : config is a wiki-config value and its data directory is writable.
; post   : The data directory and writable static directory exist.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (ensure-wiki-data! config)
  (for ((directory (in-list (list (wiki-config-data-dir config)
                                  (data-static-directory config)))))
    (make-directory* directory)))

(define (slug-alphanumeric? char)
  (or (char-alphabetic? char)
      (char-numeric? char)))

(define (combining-mark? char)
  (if (member (char-general-category char) '(mn mc me))
      #t
      #f))

(define (valid-slug-character? char)
  (or (slug-alphanumeric? char)
      (char=? char #\.)
      (char=? char #\_)
      (char=? char #\-)))

(define (valid-slug? slug)
  (and (> (string-length slug) 0)
       (<= (string-length slug) 120)
       (slug-alphanumeric? (string-ref slug 0))
       (for/and ((char (in-string slug)))
         (valid-slug-character? char))
       (not (member slug '("." "..")))))

(define (title->slug title)
  (define normalized
    (string-downcase
     (string-normalize-nfkd (string-trim title))))
  (define out (open-output-string))
  (define separator-needed? #f)
  (define wrote-character? #f)
  (for ((char (in-string normalized)))
    (cond
      ((slug-alphanumeric? char)
       (when (and separator-needed? wrote-character?)
         (write-char #\- out))
       (write-char char out)
       (set! separator-needed? #f)
       (set! wrote-character? #t))
      ((combining-mark? char)
       (void))
      (else
       (set! separator-needed? #t))))
  (define slug (get-output-string out))
  (define limited
    (if (> (string-length slug) 120)
        (substring slug 0 120)
        slug))
  (regexp-replace #px"-+$" limited ""))

(define (tags->text tags)
  (jsexpr->string tags))

(define (text->tags text)
  (with-handlers ((exn:fail? (λ (_e) '())))
    (define value (string->jsexpr text))
    (if (list? value) value '())))

(define (row->page row [include-markdown? #t])
  (define result
    (hash 'slug (vector-ref row 0)
          'title (vector-ref row 1)
          'createdAt (vector-ref row 3)
          'updatedAt (vector-ref row 4)
          'createdBy (vector-ref row 5)
          'updatedBy (vector-ref row 6)
          'tags (text->tags (vector-ref row 7))
          'currentVersion (vector-ref row 8)))
  (if include-markdown?
      (hash-set result 'markdown (vector-ref row 2))
      result))

(define page-columns
  "slug, title, markdown, created_at, updated_at, created_by, updated_by, tags, current_version")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List current wiki page metadata.
; pre    : The PostgreSQL schema is initialized.
; post   : The pages table has only been read.
; result : A title-sorted list of page metadata hashes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-pages config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (query-rows db
                                  (string-append "SELECT " page-columns
                                                 " FROM pages WHERE archived = FALSE ORDER BY lower(title), title")))))
       (row->page row #f)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read the current form of one wiki page.
; pre    : slug is a valid page slug.
; post   : The pages table has only been read.
; result : Page metadata with Markdown, or #f when the page does not exist.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-page config slug)
  (if (not (valid-slug? slug))
      #f
      (call-with-wiki-database
       config
       (λ (db)
         (define row
           (query-maybe-row db
                            (string-append "SELECT " page-columns
                                           " FROM pages WHERE slug = $1 AND archived = FALSE")
                            slug))
         (if row (row->page row) #f)))))


(define (replace-todos! db page-id markdown)
  (query-exec db "DELETE FROM todo_items WHERE page_id = $1" page-id)
  (for ((item (in-list (extract-todos markdown))))
    (query-exec db
                "INSERT INTO todo_items(page_id, item_number, line_number, text) VALUES ($1, $2, $3, $4)"
                page-id
                (hash-ref item 'number)
                (hash-ref item 'line)
                (hash-ref item 'text))))

(define (insert-version! db page-id version title markdown author action summary now tags)
  (query-exec db
              #<<SQL
INSERT INTO page_versions(page_id, version, title, markdown, tags, author, action, summary, created_at)
VALUES ($1, $2, $3, $4, $5, $6, $7, $8, $9)
SQL
              page-id version title markdown (tags->text tags) author action summary now))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Create a wiki page and its first version.
; pre    : slug is valid and unused.
; post   : Current page state and version 1 are committed atomically.
; result : The new page metadata with Markdown.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (create-page! config slug title markdown author [summary "Created page"] [tags '()])
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define now (current-seconds))
        (define page-id
          (query-value db
                       #<<SQL
INSERT INTO pages(slug, title, markdown, tags, current_version,
                  created_at, updated_at, created_by, updated_by, search_document)
VALUES ($1, $2, $3, $4, 1, $5, $5, $6, $6,
        setweight(to_tsvector('simple', coalesce($2, '')), 'A') ||
        setweight(to_tsvector('simple', coalesce($3, '')), 'B'))
RETURNING id
SQL
                       slug title markdown (tags->text tags) now author))
        (insert-version! db page-id 1 title markdown author "create" summary now tags)
        (replace-todos! db page-id markdown)))))
  (read-page config slug))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Save a new version of an existing wiki page.
; pre    : The page exists and base-version equals its current version.
; post   : Current page and version history are committed atomically.
; result : The updated page metadata with Markdown.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-page! config slug title markdown author base-version [summary "Edited page"] [tags #f])
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define row
          (query-maybe-row db
                           "SELECT id, current_version, tags FROM pages WHERE slug = $1 AND archived = FALSE FOR UPDATE"
                           slug))
        (unless row
          (error 'update-page! "unknown page: ~a" slug))
        (define current-version (vector-ref row 1))
        (define supplied-version
          (if (number? base-version)
              base-version
              (string->number (format "~a" base-version))))
        (unless (and supplied-version (= current-version supplied-version))
          (error 'update-page! "version-conflict"))
        (define page-tags
          (if tags tags (text->tags (vector-ref row 2))))
        (define next-version (+ current-version 1))
        (define now (current-seconds))
        (query-exec db
                    #<<SQL
UPDATE pages
SET title = $1, markdown = $2, tags = $3, current_version = $4,
    updated_at = $5, updated_by = $6,
    search_document = setweight(to_tsvector('simple', coalesce($1, '')), 'A') ||
                      setweight(to_tsvector('simple', coalesce($2, '')), 'B')
WHERE id = $7
SQL
                    title markdown (tags->text page-tags) next-version now author (vector-ref row 0))
        (insert-version! db (vector-ref row 0) next-version title markdown author "edit" summary now page-tags)
        (replace-todos! db (vector-ref row 0) markdown)))))
  (read-page config slug))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Archive an existing wiki page.
; pre    : The page exists.
; post   : The page is marked archived while its versions and attachments remain stored.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (archive-page! config slug author)
  (call-with-wiki-database
   config
   (λ (db)
     (define id
       (query-maybe-value db
                          #<<SQL
UPDATE pages
SET archived = TRUE, archived_at = $1, archived_by = $2
WHERE slug = $3 AND archived = FALSE
RETURNING id
SQL
                          (current-seconds) author slug))
     (unless id
       (error 'archive-page! "unknown page: ~a" slug))))
  (void))

(define (page-id config slug)
  (call-with-wiki-database
   config
   (λ (db)
     (query-maybe-value db
                        "SELECT id FROM pages WHERE slug = $1 AND archived = FALSE"
                        slug))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read the version history for a wiki page.
; pre    : The page exists.
; post   : Page version rows have only been read.
; result : A newest-first list of version metadata hashes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (page-history config slug)
  (call-with-wiki-database
   config
   (λ (db)
     (define id
       (query-maybe-value db "SELECT id FROM pages WHERE slug = $1 AND archived = FALSE" slug))
     (unless id
       (error 'page-history "unknown page: ~a" slug))
     (for/list ((row (in-list
                      (query-rows db
                                  #<<SQL
SELECT version, title, author, action, summary, tags, created_at
FROM page_versions
WHERE page_id = $1
ORDER BY version DESC
SQL
                                  id))))
       (hash 'version (vector-ref row 0)
             'title (vector-ref row 1)
             'author (vector-ref row 2)
             'action (vector-ref row 3)
             'summary (vector-ref row 4)
             'tags (text->tags (vector-ref row 5))
             'createdAt (vector-ref row 6))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read one stored page version.
; pre    : slug and version identify a possible stored version.
; post   : Version rows have only been read.
; result : Version metadata with Markdown, or #f when the version is absent.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-version config slug version)
  (define version-number
    (if (number? version) version (string->number version)))
  (and version-number
       (call-with-wiki-database
        config
        (λ (db)
          (define row
            (query-maybe-row db
                             #<<SQL
SELECT v.version, v.title, v.markdown, v.author, v.action, v.summary, v.tags, v.created_at
FROM page_versions v
JOIN pages p ON p.id = v.page_id
WHERE p.slug = $1 AND p.archived = FALSE AND v.version = $2
SQL
                             slug version-number))
          (and row
               (hash 'version (vector-ref row 0)
                     'title (vector-ref row 1)
                     'markdown (vector-ref row 2)
                     'author (vector-ref row 3)
                     'action (vector-ref row 4)
                     'summary (vector-ref row 5)
                     'tags (text->tags (vector-ref row 6))
                     'createdAt (vector-ref row 7)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Search current wiki pages using PostgreSQL full-text search.
; pre    : query-text is a string and the database schema is initialized.
; post   : Page content has only been read.
; result : Up to 50 relevance-sorted search result hashes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (search-pages config query-text)
  (if (string=? (string-trim query-text) "")
      '()
      (call-with-wiki-database
       config
       (λ (db)
         (for/list ((row (in-list
                          (query-rows db
                                      #<<SQL
WITH q AS (SELECT websearch_to_tsquery('simple', $1) AS query)
SELECT p.slug,
       p.title,
       ts_rank(p.search_document, q.query) AS rank,
       ts_headline('simple', p.markdown, q.query,
                   'StartSel=[[[, StopSel=]]], MaxWords=28, MinWords=8, ShortWord=2') AS snippet
FROM pages p, q
WHERE p.archived = FALSE
  AND p.search_document @@ q.query
ORDER BY rank DESC, lower(p.title), p.title
LIMIT 50
SQL
                                      query-text))))
           (hash 'slug (vector-ref row 0)
                 'title (vector-ref row 1)
                 'rank (vector-ref row 2)
                 'snippet (vector-ref row 3)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List unresolved todo(...) markers from all current wiki pages.
; pre    : PostgreSQL schema 3 or newer is initialized.
; post   : Todo and page rows have only been read.
; result : A page/title sorted list of todo item hashes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-todos config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (query-rows db
                                  #<<SQL
SELECT p.slug, p.title, t.item_number, t.line_number, t.text
FROM todo_items t
JOIN pages p ON p.id = t.page_id
WHERE p.archived = FALSE
ORDER BY lower(p.title), p.title, t.item_number
SQL
                                  ))))
       (hash 'slug (vector-ref row 0)
             'title (vector-ref row 1)
             'number (vector-ref row 2)
             'line (vector-ref row 3)
             'text (vector-ref row 4))))))

(define (safe-file-name name)
  (define clean
    (regexp-replace* #px"[^A-Za-z0-9._ -]" name "_"))
  (if (or (string=? clean "")
          (string=? clean ".")
          (string=? clean ".."))
      "upload.bin"
      clean))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Store an uploaded file in PostgreSQL.
; pre    : The page exists and content is a byte string.
; post   : Attachment metadata and bytes are stored in one PostgreSQL row.
; result : A hash containing original name, stored name and page-local URL.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (save-upload! config slug original-name content author)
  (define id (page-id config slug))
  (unless id
    (error 'save-upload! "unknown page: ~a" slug))
  (define stored-name
    (format "~a-~a-~a" (current-seconds) (random 1000000) (safe-file-name original-name)))
  (define mime-type
    (cond
      ((regexp-match? #px"(?i:[.]png)$" stored-name) "image/png")
      ((regexp-match? #px"(?i:[.](jpg|jpeg))$" stored-name) "image/jpeg")
      ((regexp-match? #px"(?i:[.]gif)$" stored-name) "image/gif")
      ((regexp-match? #px"(?i:[.]webp)$" stored-name) "image/webp")
      ((regexp-match? #px"(?i:[.]pdf)$" stored-name) "application/pdf")
      ((regexp-match? #px"(?i:[.]txt)$" stored-name) "text/plain; charset=utf-8")
      (else "application/octet-stream")))
  (call-with-wiki-database
   config
   (λ (db)
     (query-exec db
                 #<<SQL
INSERT INTO attachments(page_id, original_name, stored_name, mime_type, content,
                        size, uploaded_at, uploaded_by)
VALUES ($1, $2, $3, $4, $5, $6, $7, $8)
SQL
                 id
                 original-name
                 stored-name
                 mime-type
                 content
                 (bytes-length content)
                 (current-seconds)
                 author)))
  (hash 'name original-name
        'storedName stored-name
        'url (format "/uploads/~a/~a" slug stored-name)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read one stored attachment from PostgreSQL.
; pre    : slug and stored-name come from an upload request path.
; post   : PostgreSQL has only been read.
; result : A hash containing bytes, MIME type and names, or #f when absent.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (uploaded-file config slug stored-name)
  (and (valid-slug? slug)
       (not (regexp-match? #px"[/\\\\]" stored-name))
       (call-with-wiki-database
        config
        (λ (db)
          (define row
            (query-maybe-row db
                             #<<SQL
SELECT a.original_name, a.stored_name, a.mime_type, a.content, a.size
FROM attachments a
JOIN pages p ON p.id = a.page_id
WHERE p.slug = $1 AND p.archived = FALSE AND a.stored_name = $2
SQL
                             slug stored-name))
          (if row
              (hash 'originalName (vector-ref row 0)
                    'storedName (vector-ref row 1)
                    'mimeType (vector-ref row 2)
                    'content (vector-ref row 3)
                    'size (vector-ref row 4))
              #f)))))