#lang racket/base

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PostgreSQL-backed concept-map storage.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require db
         json
         racket/string
         "database.rkt"
         "storage.rkt")

(provide list-concept-maps
         list-concept-usage
         list-recent-concept-maps
         search-concept-maps
         read-concept-map
         concept-map-history
         read-concept-map-version
         delete-concept-map-version!
         create-concept-map!
         rename-concept-map!
         update-concept-map!
         archive-concept-map!)

(define maximum-document-size (* 10 1024 1024))

(define concept-map-columns
  "slug, title, document::text, current_version, created_at, updated_at, created_by, updated_by")

(define (document->text document)
  (unless (jsexpr? document)
    (raise-argument-error 'document->text "jsexpr?" document))
  (define text (jsexpr->string document))
  (when (> (bytes-length (string->bytes/utf-8 text)) maximum-document-size)
    (error 'document->text "concept map document exceeds 10 MiB"))
  text)

(define (text->document text)
  (with-handlers ((exn:fail?
                   (λ (e)
                     (error 'text->document
                            "invalid stored concept map document: ~a"
                            (exn-message e)))))
    (define parsed (string->jsexpr text))
    (define document
      (if (string? parsed)
          (string->jsexpr parsed)
          parsed))
    (unless (hash? document)
      (error 'text->document "stored concept map document is not a JSON object"))
    document))

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

(define (validate-concept-map-input who slug title document)
  (unless (valid-slug? slug)
    (error who "invalid concept map address: ~a" slug))
  (when (string=? (string-trim title) "")
    (error who "title is required"))
  (unless (hash? document)
    (raise-argument-error who "hash?" document))
  (document->text document)
  (void))

(define (insert-concept-map-version! db map-id version title document-text author action summary now)
  (query-exec db
              #<<SQL
INSERT INTO concept_map_versions
  (concept_map_id, version, title, document, author, action, summary, created_at)
VALUES ($1, $2, $3, $4::text::jsonb, $5, $6, $7, $8)
SQL
              map-id version title document-text author action summary now))

(define (prune-manual-concept-map-versions! db map-id)
  (query-exec
   db
   #<<SQL
DELETE FROM concept_map_versions
WHERE concept_map_id = $1
  AND action = 'manual'
  AND version NOT IN (
    SELECT version
    FROM concept_map_versions
    WHERE concept_map_id = $1 AND action = 'manual'
    ORDER BY version DESC
    LIMIT 5
  )
SQL
   map-id))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List current concept-map metadata.
; pre    : Database schema migration 9 has been installed.
; post   : No database state is changed.
; result : A title-sorted list without the potentially large documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-maps config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (query-rows
                       db
                       (string-append
                        "SELECT " concept-map-columns
                        " FROM concept_maps WHERE archived = FALSE"
                        " ORDER BY lower(title), title")))))
       (row->concept-map row #f)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Count current concept placements across every active CMap.
; pre    : Concept-map documents use an items array when placements exist.
; post   : No database state is changed.
; result : Rows containing global concept identity, linked page, concept/map
;          labels, CMap slug and placement count.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-usage config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (query-rows
                       db
                       #<<SQL
WITH placements AS (
  SELECT cm.slug,
         cm.title AS cmap_title,
         CASE
           WHEN item ->> 'conceptId' ~ '^concept-[0-9]+$'
             THEN concat('legacy:', cm.slug, ':', item ->> 'conceptId')
           ELSE item ->> 'conceptId'
         END AS concept_id,
         coalesce(nullif(repository.document ->> 'label', ''),
                  nullif(item ->> 'label', ''),
                  'Concept') AS concept_label,
         coalesce(nullif(repository.document ->> 'pageSlug', ''),
                  nullif(item ->> 'pageSlug', '')) AS page_slug
  FROM concept_maps cm
  CROSS JOIN LATERAL jsonb_array_elements(
    CASE
      WHEN jsonb_typeof(cm.document -> 'items') = 'array'
        THEN cm.document -> 'items'
      ELSE '[]'::jsonb
    END
  ) AS item
  LEFT JOIN LATERAL (
    SELECT concept_value AS document
    FROM jsonb_array_elements(
      CASE
        WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
          THEN cm.document -> 'concepts'
        ELSE '[]'::jsonb
      END
    ) AS concept_entry(concept_value)
    WHERE concept_value ->> 'id' = item ->> 'conceptId'
    LIMIT 1
  ) repository ON TRUE
  WHERE cm.archived = FALSE
    AND nullif(item ->> 'conceptId', '') IS NOT NULL
    AND coalesce(item ->> 'kind', 'concept') NOT IN ('phrase', 'submap')
)
SELECT concept_id, slug, cmap_title, concept_label, page_slug, count(*)
FROM placements
GROUP BY concept_id, slug, cmap_title, concept_label, page_slug
ORDER BY concept_id, lower(cmap_title), cmap_title
SQL
                       ))))
       (hash 'conceptId (vector-ref row 0)
             'cmapSlug (vector-ref row 1)
             'cmapTitle (vector-ref row 2)
             'label (vector-ref row 3)
             'pageSlug (if (sql-null? (vector-ref row 4))
                           'null
                           (vector-ref row 4))
             'count (vector-ref row 5))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List recently edited current concept maps.
; pre    : Database schema migration 9 has been installed.
; post   : Concept-map rows have only been read.
; result : At most limit metadata hashes, newest first.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-recent-concept-maps config [limit 50])
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (query-rows
                       db
                       (string-append
                        "SELECT " concept-map-columns
                        " FROM concept_maps WHERE archived = FALSE"
                        " ORDER BY updated_at DESC, lower(title), title"
                        " LIMIT $1")
                       limit))))
       (row->concept-map row #f)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Search current concept maps by map title, address and concept text.
; pre    : query-text is a string and database schema 9 is installed.
; post   : Concept-map documents have only been read.
; result : Up to 50 relevance-sorted search result hashes without documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (search-concept-maps 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
), map_documents AS (
  SELECT cm.slug,
         cm.title,
         coalesce((
           SELECT string_agg(
                    concat_ws(' ', item ->> 'label', item ->> 'synopsis'),
                    ' ')
           FROM jsonb_array_elements(
             CASE
               WHEN jsonb_typeof(cm.document -> 'items') = 'array'
                 THEN cm.document -> 'items'
               ELSE '[]'::jsonb
             END) AS item
         ), '') AS concept_text
  FROM concept_maps cm
  WHERE cm.archived = FALSE
), ranked AS (
  SELECT slug,
         title,
         concept_text,
         setweight(to_tsvector('simple', coalesce(title, '') || ' ' || coalesce(slug, '')), 'A') ||
         setweight(to_tsvector('simple', concept_text), 'B') AS search_document
  FROM map_documents
)
SELECT ranked.slug,
       ranked.title,
       ts_rank(ranked.search_document, q.query) AS rank,
       ts_headline(
         'simple',
         concat_ws(' ', ranked.title, ranked.concept_text),
         q.query,
         'StartSel=[[[, StopSel=]]], MaxWords=28, MinWords=8, ShortWord=2') AS snippet
FROM ranked, q
WHERE ranked.search_document @@ q.query
ORDER BY rank DESC, lower(ranked.title), ranked.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)
                 'type "cmap"))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read one current concept map including its editor document.
; pre    : slug is a string.
; post   : No database state is changed.
; result : Concept-map hash, or #f when no current map has that slug.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-concept-map config slug)
  (if (not (valid-slug? slug))
      #f
      (call-with-wiki-database
       config
       (λ (db)
         (define row
           (query-maybe-row
            db
            (string-append
             "SELECT " concept-map-columns
             " FROM concept_maps WHERE slug = $1 AND archived = FALSE")
            slug))
         (if row (row->concept-map row) #f)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Create a persistent concept map.
; pre    : slug is unused, title is non-empty and document is a JSON object.
; post   : One concept_maps row exists at version 1; history starts only when
;          the user explicitly saves or creates a snapshot.
; result : The newly stored concept-map hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (create-concept-map! config slug title document author)
  (define clean-slug (string-trim slug))
  (define clean-title (string-trim title))
  (validate-concept-map-input 'create-concept-map! clean-slug clean-title document)
  (define document-text (document->text document))
  (define now (current-seconds))
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (query-value
         db
         #<<SQL
INSERT INTO concept_maps
  (slug, title, document, current_version, created_at, updated_at, created_by, updated_by)
VALUES ($1, $2, $3::text::jsonb, 1, $4, $4, $5, $5)
RETURNING id
SQL
         clean-slug clean-title document-text now author)))))
  (read-concept-map config clean-slug))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Rename a concept map without storing unsaved editor content.
; pre    : slug identifies a current map and base-version is current.
; post   : Title, version and audit fields are updated atomically without
;          adding a user-facing history item.
; result : The renamed concept-map hash with its unchanged document.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (rename-concept-map! config slug title author base-version)
  (define clean-title (string-trim title))
  (when (string=? clean-title "")
    (error 'rename-concept-map! "title is required"))
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define row
          (query-maybe-row
           db
           "SELECT id, current_version, document::text FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
           slug))
        (unless row
          (error 'rename-concept-map! "unknown concept map: ~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 (= supplied-version current-version))
          (error 'rename-concept-map! "version-conflict"))
        (define next-version (+ current-version 1))
        (define now (current-seconds))
        (query-exec
         db
         #<<SQL
UPDATE concept_maps
SET title = $1,
    current_version = $2,
    updated_at = $3,
    updated_by = $4
WHERE id = $5
SQL
         clean-title
         next-version
         now
         author
         (vector-ref row 0))
        (void)))))
  (read-concept-map config slug))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Store the current state of an existing concept map.
; pre    : base-version equals the current database version.
; post   : Current state and version are updated atomically. Autosaves create
;          no history row; snapshots are unlimited; only five manual saves remain.
; result : The updated concept-map hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-concept-map! config slug title document author base-version
                             [summary "Edited CMap"] [action "manual"])
  (unless (member action '("autosave" "manual" "snapshot"))
    (error 'update-concept-map! "invalid save action: ~a" action))
  (define clean-title (string-trim title))
  (validate-concept-map-input 'update-concept-map! slug clean-title document)
  (define document-text (document->text document))
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define row
          (query-maybe-row
           db
           "SELECT id, current_version FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
           slug))
        (unless row
          (error 'update-concept-map! "unknown concept map: ~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 (= supplied-version current-version))
          (error 'update-concept-map! "version-conflict"))
        (define next-version (+ current-version 1))
        (define now (current-seconds))
        (query-exec
         db
         #<<SQL
UPDATE concept_maps
SET title = $1,
    document = $2::text::jsonb,
    current_version = $3,
    updated_at = $4,
    updated_by = $5
WHERE id = $6
SQL
         clean-title
         document-text
         next-version
         now
         author
         (vector-ref row 0))
        (unless (string=? action "autosave")
          (insert-concept-map-version!
           db (vector-ref row 0) next-version clean-title document-text
           author action summary now))
        (when (string=? action "manual")
          (prune-manual-concept-map-versions! db (vector-ref row 0)))))))
  (read-concept-map config slug))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read immutable version metadata for a concept map.
; pre    : slug identifies a current concept map.
; post   : Version rows have only been read.
; result : A newest-first list without the potentially large documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (concept-map-history config slug)
  (call-with-wiki-database
   config
   (λ (db)
     (define map-id
       (query-maybe-value
        db
        "SELECT id FROM concept_maps WHERE slug = $1 AND archived = FALSE"
        slug))
     (unless map-id
       (error 'concept-map-history "unknown concept map: ~a" slug))
     (for/list ((row (in-list
                      (query-rows db
                                  #<<SQL
SELECT version, title, author, action, summary, created_at
FROM concept_map_versions
WHERE concept_map_id = $1 AND action IN ('snapshot', 'manual')
ORDER BY version DESC
SQL
                                  map-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)
             'createdAt (vector-ref row 5))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read one immutable concept-map version.
; pre    : slug and version identify a possible historical version.
; post   : Version rows have only been read.
; result : Version metadata including its editor document, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-concept-map-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 cmv.version, cmv.title, cmv.document::text, cmv.author,
       cmv.action, cmv.summary, cmv.created_at
FROM concept_map_versions cmv
JOIN concept_maps cm ON cm.id = cmv.concept_map_id
WHERE cm.slug = $1 AND cm.archived = FALSE AND cmv.version = $2
SQL
                             slug version-number))
          (and row
               (hash 'version (vector-ref row 0)
                     'title (vector-ref row 1)
                     'document (text->document (vector-ref row 2))
                     'author (vector-ref row 3)
                     'action (vector-ref row 4)
                     'summary (vector-ref row 5)
                     'createdAt (vector-ref row 6)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Delete one user-facing concept-map history item.
; pre    : slug identifies a current map and version is numeric.
; post   : Only the selected snapshot or manual-save row is removed; the
;          current concept_maps document and version are unchanged.
; result : #t when an item was deleted, #f when it did not exist.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (delete-concept-map-version! config slug version)
  (define version-number
    (if (number? version) version (string->number version)))
  (and version-number
       (call-with-wiki-database
        config
        (lambda (db)
          (and
           (query-maybe-value
            db
            #<<SQL
DELETE FROM concept_map_versions cmv
USING concept_maps cm
WHERE cm.id = cmv.concept_map_id
  AND cm.slug = $1
  AND cm.archived = FALSE
  AND cmv.version = $2
  AND cmv.action IN ('snapshot', 'manual')
RETURNING cmv.version
SQL
            slug version-number)
           #t)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Soft-delete one concept map.
; pre    : slug identifies a current map.
; post   : The map is excluded from normal list/read operations.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (archive-concept-map! config slug author)
  (call-with-wiki-database
   config
   (λ (db)
     (define changed
       (query-exec
        db
        #<<SQL
UPDATE concept_maps
SET archived = TRUE, archived_at = $1, archived_by = $2,
    updated_at = $1, updated_by = $2
WHERE slug = $3 AND archived = FALSE
SQL
        (current-seconds) author slug))
     (void changed)))
  (void))