#lang racket/base

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

(require db
         json
         racket/list
         racket/string
         "concept-id.rkt"
         "database.rkt"
         "people.rkt"
         "storage.rkt")

(provide list-concept-maps
         list-archived-concept-maps
         list-concept-usage
         list-concept-todos
         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!
         restore-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")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Concept-map documents and shared concept definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Encodes a CMap document as size-limited JSON text for PostgreSQL.
(define (document->text document)
  (unless (jsexpr? document)
    (raise-argument-error 'document->text "jsexpr?" document))
  (let ((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))

;;; Decodes a stored JSON object, including documents encoded twice by older versions.
(define (text->document text)
  (with-handlers ((exn:fail?
                   (λ (e)
                     (error 'text->document
                            "invalid stored concept map document: ~a"
                            (exn-message e)))))
    (let* ((parsed (string->jsexpr text))
           (document (if (string? parsed)
                         (string->jsexpr parsed)
                         parsed)))
      (unless (hash? document)
        (error 'text->document "stored concept map document is not a JSON object"))
      document)))

;;; Returns the concepts array, treating a malformed or absent value as empty.
(define (document-concepts document)
  (let ((concepts (hash-ref document 'concepts '())))
    (if (list? concepts) concepts '())))

;;; Returns the items array, treating a malformed or absent value as empty.
(define (document-items document)
  (let ((items (hash-ref document 'items '())))
    (if (list? items) items '())))

(define concept-content-keys
  '(id label synopsis aspects tags descriptionPageSlug pageSlug cmapSlug externalUrl
       imageSource))

(define placement-content-keys
  '(label synopsis aspects tags descriptionPageSlug pageSlug cmapSlug externalUrl
          imageSource))

;;; Recognizes complete HTTP and HTTPS links accepted as shared concept content.
(define (valid-external-url? value)
  (and (string? value)
       (regexp-match? #px"(?i:^https?://[^\\s]+$)" value)))

;;; Selects and sanitizes the part of a concept stored in concept_definitions.
(define (concept-content concept)
  (let* ((has-external-url? (hash-has-key? concept 'externalUrl))
         (external-url (hash-ref concept 'externalUrl #f)))
    (when (and has-external-url?
               external-url
               (not (eq? external-url 'null))
               (not (equal? external-url ""))
               (not (valid-external-url? external-url)))
      (error 'concept-content "externalUrl must be a complete http or https URL"))
    (let copy-content ((keys concept-content-keys)
                       (content (hash)))
      (cond
        ((null? keys) content)
        ((not (hash-has-key? concept (car keys)))
         (copy-content (cdr keys) content))
        (else
         (let* ((key (car keys))
                (value (hash-ref concept key))
                (tags? (eq? key 'tags))
                (stored-value
                 (cond
                   ((not tags?) value)
                   ((list? value)
                    (filter (λ (tag)
                              (and (hash? tag)
                                   (equal? (hash-ref tag 'type #f) "person")))
                            value))
                   (else '()))))
           (copy-content (cdr keys) (hash-set content key stored-value))))))))

;;; Recognizes a non-phrase item that refers to a concept by string identifier.
(define (concept-placement? item)
  (and (hash? item)
       (string? (hash-ref item 'conceptId #f))
       (not (equal? (hash-ref item 'kind "concept") "phrase"))))

;;; Returns every distinct concept identifier referenced by document placements.
(define (document-item-concept-ids document)
  (remove-duplicates
   (map (λ (item) (hash-ref item 'conceptId))
        (filter concept-placement? (document-items document)))))

;;; Removes the supplied keys from an immutable hash.
(define (remove-hash-keys value keys)
  (foldl (λ (key result) (hash-remove result key)) value keys))

;; A persisted CMap owns structure and presentation only. Full concept content
;; is stored once, in concept_definitions. The concepts array is retained as an
;; explicit set of references so the JSON document remains self-describing.
;;; Reduces an editor document to placement data and shared-concept references.
(define (concept-map-storage-document document)
  (let* ((placement-items
          (map (λ (item)
                 (if (and (hash? item)
                          (not (equal? (hash-ref item 'kind "concept") "phrase")))
                     (remove-hash-keys item placement-content-keys)
                     item))
               (document-items document)))
         (defined-concept-ids
          (map (λ (concept) (hash-ref concept 'id))
               (filter (λ (concept)
                         (and (hash? concept)
                              (string? (hash-ref concept 'id #f))
                              (not (string=? (hash-ref concept 'id) ""))))
                       (document-concepts document))))
         (concept-ids
          (remove-duplicates
           (append defined-concept-ids (document-item-concept-ids document)))))
    (for-each
     (λ (concept-id)
       (unless (concept-id? concept-id)
         (error 'concept-map-storage-document "invalid concept UUID: ~a" concept-id)))
     concept-ids)
    (hash-set (hash-set document 'items placement-items)
              'concepts
              (map (λ (concept-id) (hash 'id concept-id)) concept-ids))))

;;; Reads and sanitizes one shared concept definition by its canonical UUID.
(define (concept-definition-by-id db concept-id)
  (let ((row
         (query-maybe-row
          db
          "SELECT document::text FROM concept_definitions WHERE id = $1"
          concept-id)))
    (if row
        (concept-content (text->document (vector-ref row 0)))
        #f)))

;;; Chooses the best available label for matching a source to a shared concept.
(define (concept-source-label source repository-concept)
  (cond
    ((and repository-concept
          (string? (hash-ref repository-concept 'label #f)))
     (hash-ref repository-concept 'label))
    ((string? (hash-ref source 'label #f))
     (hash-ref source 'label))
    (else "")))

;;; Finds the most recently updated shared concept with the normalized label.
(define (concept-id-by-label db name-key)
  (if (string=? name-key "")
      #f
      (query-maybe-value
       db
       #<<SQL
SELECT id
FROM concept_definitions
WHERE lower(trim(document ->> 'label')) = $1
ORDER BY updated_at DESC, id DESC
LIMIT 1
SQL
       name-key)))

;;; Maps document-local concept identifiers to canonical shared identifiers.
(define (document-concept-id-map db document)
  (let* ((concepts
          (filter (λ (concept)
                    (and (hash? concept) (string? (hash-ref concept 'id #f))))
                  (document-concepts document)))
         (concepts-by-id
          (foldl (λ (concept result)
                   (hash-set result (hash-ref concept 'id) concept))
                 (hash)
                 concepts))
         (item-sources
          (map (λ (item) (hash-set item 'id (hash-ref item 'conceptId)))
               (filter (λ (item)
                         (and (hash? item)
                              (string? (hash-ref item 'conceptId #f))))
                       (document-items document))))
         (sources (append (document-concepts document) item-sources))
         (valid-sources
          (filter (λ (source)
                    (and (hash? source) (string? (hash-ref source 'id #f))))
                  sources)))
    (let map-identifiers ((remaining valid-sources)
                          (by-id (hash))
                          (by-name (hash)))
      (if (null? remaining)
          by-id
          (let* ((source (car remaining))
                 (concept-id (hash-ref source 'id))
                 (repository-concept (hash-ref concepts-by-id concept-id #f))
                 (label (concept-source-label source repository-concept))
                 (name-key (string-downcase (string-trim label)))
                 (stored-id (concept-id-by-label db name-key))
                 (known-name-id
                  (if (string=? name-key "") #f (hash-ref by-name name-key #f)))
                 (canonical-id
                  (or stored-id
                      known-name-id
                      (hash-ref by-id concept-id #f)
                      (normalized-or-new-concept-id concept-id)))
                 (next-by-name
                  (if (string=? name-key "")
                      by-name
                      (hash-set by-name name-key canonical-id))))
            (map-identifiers (cdr remaining)
                             (hash-set by-id concept-id canonical-id)
                             next-by-name))))))

;;; Rewrites repository concepts and placements to their canonical identifiers.
(define (canonicalize-document-concepts db document)
  (let* ((id-map (document-concept-id-map db document))
         (concepts
          (filter (λ (concept)
                    (and (hash? concept) (string? (hash-ref concept 'id #f))))
                  (document-concepts document)))
         (canonical-concepts
          (foldl
           (λ (concept by-id)
             (let* ((original-id (hash-ref concept 'id))
                    (canonical-id (hash-ref id-map original-id original-id))
                    (stored-definition
                     (and (not (string=? canonical-id original-id))
                          (concept-definition-by-id db canonical-id)))
                    (content (or stored-definition (concept-content concept))))
               (hash-set by-id canonical-id (hash-set content 'id canonical-id))))
           (hash)
           concepts))
         (canonical-items
          (map (λ (item)
                 (let ((concept-id
                        (and (hash? item) (hash-ref item 'conceptId #f))))
                   (if (string? concept-id)
                       (hash-set item 'conceptId (hash-ref id-map concept-id concept-id))
                       item)))
               (document-items document))))
    (hash-set (hash-set document 'concepts (hash-values canonical-concepts))
              'items canonical-items)))

;; Content belongs to a concept, not to one of its placements. Position, size,
;; colour and typography remain in the CMap item/layout document.
;;; Inserts or updates the canonical definition of every concept in a document.
(define (sync-concept-definitions! db document author now)
  (let ((concepts
         (filter (λ (concept)
                   (and (hash? concept)
                        (string? (hash-ref concept 'id #f))
                        (not (string=? (hash-ref concept 'id) ""))))
                 (document-concepts document))))
    (for-each
     (λ (concept)
       (let ((concept-id (hash-ref concept 'id)))
         (unless (concept-id? concept-id)
           (error 'sync-concept-definitions! "invalid concept UUID: ~a" concept-id))
         (query-exec
          db
          #<<SQL
INSERT INTO concept_definitions(id, document, updated_at, updated_by)
VALUES ($1, $2::text::jsonb, $3, $4)
ON CONFLICT (id) DO UPDATE
SET document = EXCLUDED.document,
    updated_at = EXCLUDED.updated_at,
    updated_by = EXCLUDED.updated_by
SQL
          concept-id
          (document->text (concept-content concept))
          now
          author)))
     concepts)))

;;; Replaces stored references with canonical concept definitions for the editor.
(define (hydrate-concept-definitions db document)
  (let* ((canonical-document (canonicalize-document-concepts db document))
         (local-concepts
          (foldl
           (λ (concept result)
             (if (and (hash? concept) (string? (hash-ref concept 'id #f)))
                 (hash-set result
                           (hash-ref concept 'id)
                           (concept-content concept))
                 result))
           (hash)
           (document-concepts canonical-document)))
         (concept-ids
          (remove-duplicates
           (append (hash-keys local-concepts)
                   (document-item-concept-ids canonical-document))))
         (hydrated
          (map (λ (concept-id)
                 (let ((definition (concept-definition-by-id db concept-id)))
                   (or definition
                       (hash-ref local-concepts concept-id (hash 'id concept-id)))))
               concept-ids)))
    ;; Sanitize legacy documents on the read path too. An editor can therefore
    ;; never receive item-level content that competes with the central record.
    (hash-set (concept-map-storage-document canonical-document)
              'concepts hydrated)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Database rows and write support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Converts a concept_maps result row to the hash returned by this module.
(define (row->concept-map row [include-document? #t])
  (let ((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)))

;;; Read the latest SVG render for one database CMap and version.
(define (cmap-render-by-version db cmap-slug version)
  (let ((row (query-maybe-row db
                              #<<SQL
SELECT r.content
FROM cmap_renders r
JOIN concept_maps m ON m.id = r.concept_map_id
WHERE m.slug = $1 AND r.document_version = $2
SQL
                              cmap-slug version)))
    (and row (vector-ref row 0))))

;;; Converts SQL NULL to JSON null and otherwise returns the selected row value.
(define (nullable-row-value row index)
  (let ((value (vector-ref row index)))
    (if (sql-null? value) 'null value)))

;;; Extends concept-map metadata with the administrative archive audit fields.
(define (row->archived-concept-map row)
  (hash-set (hash-set (row->concept-map row #f)
                      'archivedAt (nullable-row-value row 8))
            'archivedBy (let ((value (nullable-row-value row 9)))
                          (if (eq? value 'null) "" value))))

;;; Converts one grouped placement row to a concept-usage result.
(define (row->concept-usage row)
  (hash 'conceptId (vector-ref row 0)
        'cmapSlug (vector-ref row 1)
        'cmapTitle (vector-ref row 2)
        'label (vector-ref row 3)
        'pageSlug (nullable-row-value row 4)
        'count (vector-ref row 5)))

;;; Converts a shared TODO concept and its representative placement to JSON data.
(define (row->concept-todo row)
  (hash 'type "concept"
        'conceptId (vector-ref row 0)
        'title (vector-ref row 1)
        'text (vector-ref row 2)
        'descriptionPageSlug (nullable-row-value row 3)
        'pageSlug (nullable-row-value row 4)
        'cmapSlug (nullable-row-value row 5)
        'externalUrl (nullable-row-value row 6)
        'placementCmapSlug (vector-ref row 7)
        'placementCmapTitle (vector-ref row 8)))

;;; Converts one full-text query row to the result shape shared with wiki search.
(define (row->search-result row)
  (hash 'slug (vector-ref row 0)
        'title (vector-ref row 1)
        'rank (vector-ref row 2)
        'snippet (vector-ref row 3)
        'type "cmap"))

;;; Converts one user-visible version row to history metadata.
(define (row->history-entry row)
  (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)))

;;; Converts one immutable version row to metadata plus its editor document.
(define (row->concept-map-version 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)))

;;; Validates the address, title, shape, JSON encoding, and size of editor input.
(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))

;;; Converts a number or numeric string to a version number, otherwise #f.
(define (version-number value)
  (if (number? value) value (string->number (format "~a" value))))

;;; Inserts one immutable user-visible version within the current transaction.
(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))

;;; Retains only the five newest manual versions while leaving snapshots intact.
(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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: Selects active rows using concept-map-columns and maps each row
;            through row->concept-map with document conversion disabled.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-maps config)
  (call-with-wiki-database
   config
   (λ (db)
     (map (λ (row) (row->concept-map row #f))
          (query-rows
           db
           (string-append
            "SELECT " concept-map-columns
            " FROM concept_maps WHERE archived = FALSE"
            " ORDER BY lower(title), title"))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List archived concept-map metadata for administration.
; pre    : Database schema migration 9 has been installed.
; post   : No database state is changed and documents are not transferred.
; result : A newest-archived-first list including archive audit fields.
; internals: Selects archived rows with their audit columns and converts them
;            through row->archived-concept-map, including SQL NULL handling.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-archived-concept-maps config)
  (call-with-wiki-database
   config
   (λ (db)
     (map row->archived-concept-map
          (query-rows
           db
           #<<SQL
SELECT slug, title, document::text, current_version,
       created_at, updated_at, created_by, updated_by,
       archived_at, archived_by
FROM concept_maps
WHERE archived = TRUE
ORDER BY archived_at DESC, lower(title), title
SQL
           )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: PostgreSQL expands each active map's items array, joins shared
;            concept_definitions, groups placements and row->concept-usage
;            converts the grouped rows.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-usage config)
  (call-with-wiki-database
   config
   (λ (db)
     (map row->concept-usage
          (query-rows
           db
           #<<SQL
WITH placements AS (
  SELECT cm.slug,
         cm.title AS cmap_title,
         item ->> 'conceptId' AS concept_id,
         coalesce(nullif(definition.document ->> 'label', ''),
                  nullif(repository.document ->> 'label', ''),
                  nullif(item ->> 'label', ''),
                  'Concept') AS concept_label,
         coalesce(nullif(definition.document ->> 'pageSlug', ''),
                  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
  LEFT JOIN concept_definitions definition
    ON definition.id = item ->> 'conceptId'
  WHERE cm.archived = FALSE
    AND nullif(item ->> 'conceptId', '') IS NOT NULL
    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
)
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
           )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List globally defined concepts carrying the TODO aspect.
; pre    : Concept definitions and current CMap documents are available.
; post   : No database state is changed and every concept occurs at most once.
; result : Concept todo hashes with shared content and a current map location.
; internals: PostgreSQL selects definitions whose aspects contain TODO and a
;            lateral join chooses one active placement; row->concept-todo
;            converts nullable links to JSON null.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-todos config)
  (call-with-wiki-database
   config
   (λ (db)
     (map row->concept-todo
          (query-rows
           db
           #<<SQL
SELECT definition.id,
       coalesce(nullif(definition.document ->> 'label', ''), 'Concept') AS label,
       coalesce(definition.document ->> 'synopsis', '') AS synopsis,
       nullif(definition.document ->> 'descriptionPageSlug', '') AS description_page_slug,
       nullif(definition.document ->> 'pageSlug', '') AS page_slug,
       nullif(definition.document ->> 'cmapSlug', '') AS linked_cmap_slug,
       nullif(definition.document ->> 'externalUrl', '') AS external_url,
       placement.cmap_slug,
       placement.cmap_title
FROM concept_definitions definition
JOIN LATERAL (
  SELECT cm.slug AS cmap_slug, cm.title AS cmap_title
  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
  WHERE cm.archived = FALSE
    AND item ->> 'conceptId' = definition.id
    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
  ORDER BY lower(cm.title), cm.title, cm.slug
  LIMIT 1
) placement ON TRUE
WHERE EXISTS (
  SELECT 1
  FROM jsonb_array_elements_text(
    CASE WHEN jsonb_typeof(definition.document -> 'aspects') = 'array'
         THEN definition.document -> 'aspects' ELSE '[]'::jsonb END
  ) AS aspect(value)
  WHERE lower(trim(aspect.value)) = 'todo'
)
ORDER BY lower(coalesce(definition.document ->> 'label', '')),
         coalesce(definition.document ->> 'label', ''),
         definition.id
SQL
           )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: Orders active concept_maps by updated_at, applies the SQL limit
;            and maps the resulting rows without loading their documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-recent-concept-maps config [limit 50])
  (call-with-wiki-database
   config
   (λ (db)
     (map (λ (row) (row->concept-map row #f))
          (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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: PostgreSQL builds weighted full-text vectors from map identity and
;            canonical concept text; row->search-result returns the ranked
;            headline and metadata used by combined wiki search.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (search-concept-maps config query-text)
  (if (string=? (string-trim query-text) "")
      '()
      (call-with-wiki-database
       config
       (λ (db)
         (map row->search-result
              (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(' ', coalesce(definition.document, concept) ->> 'label',
                                   coalesce(definition.document, concept) ->> 'synopsis'),
                    ' ')
           FROM jsonb_array_elements(
             CASE
               WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
                 THEN cm.document -> 'concepts'
               ELSE '[]'::jsonb
             END) AS concept
           LEFT JOIN concept_definitions definition
             ON definition.id = concept ->> 'id'
         ), '') 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))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: Reads the active concept_maps row, row->concept-map decodes its
;            document and hydrate-concept-definitions replaces references with
;            the canonical shared concept content required by the editor.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-concept-map config slug)
  (if (not (valid-slug? slug))
      #f
      (call-with-wiki-database
       config
       (λ (db)
         (let ((row
                (query-maybe-row
                 db
                 (string-append
                  "SELECT " concept-map-columns
                  " FROM concept_maps WHERE slug = $1 AND archived = FALSE")
                 slug)))
             (if row
               (hash-set
              (hash-update (row->concept-map row)
                     'document
                     (λ (document) (hydrate-concept-definitions db document)))
              'renderedSvg
              (or (cmap-render-by-version db (vector-ref row 0) (vector-ref row 3)) ""))
               #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.
; internals: Inside one transaction, canonicalize-document-concepts resolves
;            shared UUIDs, sync-concept-definitions! and sync-person-tags!
;            update shared registries, and concept-map-storage-document strips
;            duplicate content before insertion. read-concept-map hydrates the result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (create-concept-map! config slug title document author [rendered-svg ""])
  (let* ((clean-slug (string-trim slug))
         (clean-title (string-trim title))
         (now (current-seconds)))
    (validate-concept-map-input 'create-concept-map! clean-slug clean-title document)
    (call-with-wiki-database
     config
     (λ (db)
       (call-with-transaction
        db
        (λ ()
          (let* ((canonical-document
                  (canonicalize-document-concepts db document))
                 (document-text
                  (document->text
                   (concept-map-storage-document canonical-document))))
            (sync-concept-definitions! db canonical-document author now)
            (sync-person-tags! db canonical-document)
            (let ((cmap-id (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)))
              (unless (string=? rendered-svg "")
                (query-exec db
                            "INSERT INTO cmap_renders (concept_map_id, document_version, mime_type, content, created_at) VALUES ($1, $2, $3, $4, $5)"
                            cmap-id 1 "image/svg+xml" rendered-svg now))
              cmap-id))))))
    (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.
; internals: Locks the active concept_maps row, compares version-number with
;            current_version, increments the version and audit fields, then
;            uses read-concept-map to return the unchanged hydrated document.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (rename-concept-map! config slug title author base-version)
  (let ((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
        (λ ()
          (let ((row
                 (query-maybe-row
                  db
                  #<<SQL
SELECT id, current_version, document::text
FROM concept_maps
WHERE slug = $1 AND archived = FALSE
FOR UPDATE
SQL
                  slug)))
            (unless row
              (error 'rename-concept-map! "unknown concept map: ~a" slug))
            (let* ((current-version (vector-ref row 1))
                   (supplied-version (version-number base-version)))
              (unless (and supplied-version (= supplied-version current-version))
                (error 'rename-concept-map! "version-conflict"))
              (let ((next-version (+ current-version 1))
                    (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.
; internals: Locks and version-checks the active row, canonicalizes concepts,
;            synchronizes shared definitions and people, stores the reduced
;            document, and writes history according to action. Manual history
;            is pruned by prune-manual-concept-map-versions! before read-back.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-concept-map! config slug title document author base-version
                             [summary "Edited CMap"] [action "manual"] [rendered-svg ""])
  (unless (member action '("autosave" "manual" "snapshot"))
    (error 'update-concept-map! "invalid save action: ~a" action))
  (let ((clean-title (string-trim title)))
    (validate-concept-map-input 'update-concept-map! slug clean-title document)
    (call-with-wiki-database
     config
     (λ (db)
       (call-with-transaction
        db
        (λ ()
          (let ((row
                 (query-maybe-row
                  db
                  #<<SQL
SELECT id, current_version
FROM concept_maps
WHERE slug = $1 AND archived = FALSE
FOR UPDATE
SQL
                  slug)))
            (unless row
              (error 'update-concept-map! "unknown concept map: ~a" slug))
            (let* ((current-version (vector-ref row 1))
                   (supplied-version (version-number base-version)))
              (unless (and supplied-version (= supplied-version current-version))
                (error 'update-concept-map! "version-conflict"))
              (let* ((next-version (+ current-version 1))
                     (now (current-seconds))
                     (canonical-document
                      (canonicalize-document-concepts db document))
                     (document-text
                      (document->text
                       (concept-map-storage-document canonical-document))))
                (sync-concept-definitions! db canonical-document author now)
                (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))
                (sync-person-tags! db canonical-document)
                (unless (string=? rendered-svg "")
                  (query-exec db
                              "INSERT INTO cmap_renders (concept_map_id, document_version, mime_type, content, created_at) VALUES ($1, $2, $3, $4, $5) ON CONFLICT (concept_map_id, document_version) DO UPDATE SET content = EXCLUDED.content, created_at = EXCLUDED.created_at"
                              (vector-ref row 0) next-version "image/svg+xml" rendered-svg now))
                (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.
; internals: Resolves the active map id, selects snapshot and manual rows only,
;            and maps them through row->history-entry without decoding documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (concept-map-history config slug)
  (call-with-wiki-database
   config
   (λ (db)
     (let ((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))
       (map row->history-entry
            (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))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: version-number validates the requested value; a joined query keeps
;            archived maps inaccessible and row->concept-map-version decodes
;            the selected immutable document.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-concept-map-version config slug version)
  (let ((requested-version (version-number version)))
    (if requested-version
        (call-with-wiki-database
         config
         (λ (db)
           (let ((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 requested-version)))
             (if row (row->concept-map-version row) #f))))
        #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
; internals: version-number validates the request and one joined DELETE limits
;            removal to user-visible history belonging to an active map.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (delete-concept-map-version! config slug version)
  (let ((requested-version (version-number version)))
    (if requested-version
        (call-with-wiki-database
         config
         (λ (db)
           (if (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 requested-version)
               #t
               #f)))
        #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Archive one concept map after explicit identity confirmation.
; pre    : slug, exact title and base-version identify the current map.
; post   : The map is excluded from normal list/read operations atomically.
; result : void.
; internals: Locks the active row, verifies the exact title and current version,
;            then sets archive and audit columns in the same transaction.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (archive-concept-map! config slug expected-title author base-version)
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (let ((row
               (query-maybe-row
                db
                #<<SQL
SELECT id, title, current_version
FROM concept_maps
WHERE slug = $1 AND archived = FALSE
FOR UPDATE
SQL
                slug)))
          (unless row
            (error 'archive-concept-map! "unknown concept map: ~a" slug))
          (unless (and (string? expected-title)
                       (string=? expected-title (vector-ref row 1)))
            (error 'archive-concept-map! "title-confirmation-mismatch"))
          (let ((supplied-version (version-number base-version)))
            (unless (and supplied-version (= supplied-version (vector-ref row 2)))
              (error 'archive-concept-map! "version-conflict"))
            (let ((now (current-seconds)))
              (query-exec
               db
               #<<SQL
UPDATE concept_maps
SET archived = TRUE, archived_at = $1, archived_by = $2,
    updated_at = $1, updated_by = $2
WHERE id = $3
SQL
               now author (vector-ref row 0))))))))
  (void)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Restore one archived concept map.
; pre    : slug identifies an archived map.
; post   : Archive markers are cleared; content, version and history survive.
; result : The restored current concept-map hash.
; internals: UPDATE clears the archive audit columns and returns the restored id;
;            read-concept-map then returns the normal hydrated representation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (restore-concept-map! config slug author)
  (call-with-wiki-database
   config
   (λ (db)
     (let ((restored-id
            (query-maybe-value
             db
             #<<SQL
UPDATE concept_maps
SET archived = FALSE, archived_at = NULL, archived_by = NULL,
    updated_at = $1, updated_by = $2
WHERE slug = $3 AND archived = TRUE
RETURNING id
SQL
             (current-seconds) author slug)))
       (unless restored-id
         (error 'restore-concept-map! "unknown archived concept map: ~a" slug)))))
  (read-concept-map config slug))

(module+ test
  (require rackunit)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Tests for module cmap-storage.rkt.
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define concept-a "11111111-1111-4111-8111-111111111111")
  (define concept-b "22222222-2222-4222-8222-222222222222")

  (define stored-document
    (concept-map-storage-document
     (hash 'metadata (hash 'summary "Map summary")
           'concepts (list (hash 'id concept-a
                                 'label "Shared concept"
                                 'synopsis "Central content"))
           'items (list (hash 'id 1
                              'conceptId concept-a
                              'kind "submap"
                              'label "Stale item label"
                              'synopsis "Stale item content"
                              'externalUrl "https://example.com/shared"
                              'x 40
                              'backgroundColor "#ffffff")
                        (hash 'id 2
                              'conceptId concept-b
                              'kind "concept"
                              'label "Item-only concept")
                        (hash 'id 3
                              'kind "phrase"
                              'label "relates to")))))

  (check-equal? (hash-ref stored-document 'concepts)
                (list (hash 'id concept-a) (hash 'id concept-b)))
  (define stored-items (hash-ref stored-document 'items))
  (check-false (hash-has-key? (first stored-items) 'label))
  (check-false (hash-has-key? (first stored-items) 'synopsis))
  (check-false (hash-has-key? (first stored-items) 'externalUrl))
  (check-equal? (hash-ref (first stored-items) 'x) 40)
  (check-equal? (hash-ref (first stored-items) 'backgroundColor) "#ffffff")
  (check-equal? (hash-ref (third stored-items) 'label) "relates to")
  (check-equal? (hash-ref (hash-ref stored-document 'metadata) 'summary)
                "Map summary")
  (check-true (concept-id? concept-a))
  (check-true (concept-id? "A3C4F0D1-22E5-4C42-9A40-CC864993F785"))
  (check-false (concept-id? "concept-a"))
  (check-equal? (version-number 7) 7)
  (check-equal? (version-number "7") 7)
  (check-false (version-number "invalid"))
  (check-equal?
   (hash-ref (text->document (jsexpr->string (jsexpr->string (hash 'value 7))))
             'value)
   7)
  (check-equal? (document-items (hash 'items "invalid")) '())
  (check-equal? (hash-ref (concept-content
                           (hash 'id concept-a
                                 'label "Linked concept"
                                 'externalUrl "https://example.com/path"))
                          'externalUrl)
                "https://example.com/path")
  (check-equal?
   (hash-ref
    (concept-content
     (hash 'id concept-a
           'tags (list (hash 'type "person" 'value "Alex")
                       (hash 'type "label" 'value "Architecture"))))
    'tags)
   (list (hash 'type "person" 'value "Alex")))
  (check-exn exn:fail?
             (λ ()
               (concept-content
                (hash 'id concept-a
                      'label "Unsafe concept"
                      'externalUrl "javascript:alert(1)"))))
  (check-exn exn:fail?
             (λ ()
               (concept-map-storage-document
                (hash 'concepts (list (hash 'id "legacy:map:concept-1"))
                      'items '())))))