#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")

(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 (document-concepts document)
  (define concepts (hash-ref document 'concepts '()))
  (if (list? concepts) concepts '()))

(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))

(define (valid-external-url? value)
  (and (string? value)
       (regexp-match? #px"(?i:^https?://[^\\s]+$)" value)))

(define (concept-content concept)
  (when (and (hash-has-key? concept 'externalUrl)
             (let ([value (hash-ref concept 'externalUrl)])
               (and value
                    (not (eq? value 'null))
                    (not (and (string? value) (string=? value "")))
                    (not (valid-external-url? value)))))
    (error 'concept-content "externalUrl must be a complete http or https URL"))
  (for/fold ([content (hash)]) ([key (in-list concept-content-keys)]
                                #:when (hash-has-key? concept key))
    (hash-set content key
              (if (eq? key 'tags)
                  (let ([tags (hash-ref concept key)])
                    (if (list? tags)
                        (filter (λ (tag)
                                  (and (hash? tag)
                                       (equal? (hash-ref tag 'type #f) "person")))
                                tags)
                        '()))
                  (hash-ref concept key)))))

(define (document-item-concept-ids document)
  (remove-duplicates
   (for/list ([item (in-list (let ([items (hash-ref document 'items '())])
                               (if (list? items) items '())))]
              #:when (and (hash? item)
                          (string? (hash-ref item 'conceptId #f))
                          (not (equal? (hash-ref item 'kind "concept") "phrase"))))
     (hash-ref item 'conceptId))))

(define (remove-hash-keys value keys)
  (for/fold ([result value]) ([key (in-list keys)])
    (hash-remove result key)))

;; 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.
(define (concept-map-storage-document document)
  (define items (hash-ref document 'items '()))
  (define placement-items
    (for/list ([item (in-list (if (list? items) items '()))])
      (if (and (hash? item)
               (not (equal? (hash-ref item 'kind "concept") "phrase")))
          (remove-hash-keys item placement-content-keys)
          item)))
  (define concept-ids
    (remove-duplicates
     (append
      (for/list ([concept (in-list (document-concepts document))]
                 #:when (and (hash? concept)
                             (string? (hash-ref concept 'id #f))
                             (not (string=? (hash-ref concept 'id) ""))))
        (hash-ref concept 'id))
      (document-item-concept-ids document))))
  (for ([concept-id (in-list concept-ids)])
    (unless (concept-id? concept-id)
      (error 'concept-map-storage-document "invalid concept UUID: ~a" concept-id)))
  (hash-set
   (hash-set document 'items placement-items)
   'concepts
   (for/list ([concept-id (in-list concept-ids)])
     (hash 'id concept-id))))

(define (concept-definition-by-id db concept-id)
  (define row
    (query-maybe-row
     db
     "SELECT document::text FROM concept_definitions WHERE id = $1"
     concept-id))
  (and row (concept-content (text->document (vector-ref row 0)))))

(define (document-concept-id-map db document)
  (define concepts-by-id
    (for/hash ([concept (in-list (document-concepts document))]
               #:when (and (hash? concept) (string? (hash-ref concept 'id #f))))
      (values (hash-ref concept 'id) concept)))
  (define items (hash-ref document 'items '()))
  (define sources
    (append
     (document-concepts document)
     (for/list ([item (in-list (if (list? items) items '()))]
                #:when (and (hash? item) (string? (hash-ref item 'conceptId #f))))
       (hash-set item 'id (hash-ref item 'conceptId)))))
  (define by-name (make-hash))
  (for/fold ([by-id (hash)]) ([source (in-list sources)]
                              #:when (and (hash? source)
                                          (string? (hash-ref source 'id #f))))
    (define concept-id (hash-ref source 'id))
    (define repository-concept (hash-ref concepts-by-id concept-id #f))
    (define label
      (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 ""]))
    (define name-key (string-downcase (string-trim label)))
    (define stored-id
      (and (not (string=? name-key ""))
           (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)))
    (define canonical-id
      (or stored-id
          (and (not (string=? name-key "")) (hash-ref by-name name-key #f))
          (hash-ref by-id concept-id #f)
          (normalized-or-new-concept-id concept-id)))
    (unless (string=? name-key "") (hash-set! by-name name-key canonical-id))
    (hash-set by-id concept-id canonical-id)))

(define (canonicalize-document-concepts db document)
  (define id-map (document-concept-id-map db document))
  (define canonical-concepts
    (for/fold ([by-id (hash)]) ([concept (in-list (document-concepts document))]
                                #:when (and (hash? concept)
                                            (string? (hash-ref concept 'id #f))))
      (define original-id (hash-ref concept 'id))
      (define canonical-id (hash-ref id-map original-id original-id))
      (define stored-definition
        (and (not (string=? canonical-id original-id))
             (concept-definition-by-id db canonical-id)))
      (hash-set by-id canonical-id
                (hash-set (or stored-definition (concept-content concept))
                          'id canonical-id))))
  (define items (hash-ref document 'items '()))
  (define canonical-items
    (for/list ([item (in-list (if (list? items) items '()))])
      (define 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)))
  (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.
(define (sync-concept-definitions! db document author now)
  (for ([concept (in-list (document-concepts document))]
        #:when (and (hash? concept)
                    (string? (hash-ref concept 'id #f))
                    (not (string=? (hash-ref concept 'id) ""))))
    (unless (concept-id? (hash-ref concept 'id))
      (error 'sync-concept-definitions! "invalid concept UUID: ~a"
             (hash-ref 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
     (hash-ref concept 'id)
     (document->text (concept-content concept))
     now
     author)))

(define (hydrate-concept-definitions db document)
  (define canonical-document (canonicalize-document-concepts db document))
  (define local-concepts
    (for/hash ([concept (in-list (document-concepts canonical-document))]
               #:when (and (hash? concept) (string? (hash-ref concept 'id #f))))
      (values (hash-ref concept 'id) (concept-content concept))))
  (define concept-ids
    (remove-duplicates
     (append (hash-keys local-concepts) (document-item-concept-ids canonical-document))))
  (define hydrated
    (for/list ([concept-id (in-list concept-ids)])
      (define 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)))
          (hash-ref local-concepts concept-id (hash 'id concept-id)))))
  ;; 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))

(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   : 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-archived-concept-maps config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ((row (in-list
                      (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
                       ))))
       (hash-set
        (hash-set (row->concept-map row #f)
                  'archivedAt (if (sql-null? (vector-ref row 8))
                                  'null
                                  (vector-ref row 8)))
        'archivedBy (or (and (not (sql-null? (vector-ref row 9)))
                             (vector-ref row 9))
                        ""))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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,
         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
                       ))))
       (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 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-todos config)
  (call-with-wiki-database
   config
   (λ (db)
     (for/list ([row (in-list
                      (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
                       ))])
       (define (nullable index)
         (define value (vector-ref row index))
         (if (sql-null? value) 'null value))
       (hash 'type "concept"
             'conceptId (vector-ref row 0)
             'title (vector-ref row 1)
             'text (vector-ref row 2)
             'descriptionPageSlug (nullable 3)
             'pageSlug (nullable 4)
             'cmapSlug (nullable 5)
             'externalUrl (nullable 6)
             'placementCmapSlug (vector-ref row 7)
             'placementCmapTitle (vector-ref row 8))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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(' ', 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))))
           (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
             (hash-update (row->concept-map row)
                          'document
                          (λ (document) (hydrate-concept-definitions db document)))
             #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 now (current-seconds))
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define canonical-document (canonicalize-document-concepts db document))
        (define document-text
          (document->text (concept-map-storage-document canonical-document)))
        (sync-concept-definitions! db canonical-document author now)
        (sync-person-tags! db canonical-document)
        (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)
  (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))
        (define canonical-document (canonicalize-document-concepts db document))
        (define 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=? 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
        (λ (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   : 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (archive-concept-map! config slug expected-title author base-version)
  (call-with-wiki-database
   config
   (λ (db)
     (call-with-transaction
      db
      (λ ()
        (define row
          (query-maybe-row
           db
           "SELECT id, title, current_version FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
           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"))
        (define supplied-version
          (if (number? base-version)
              base-version
              (string->number (format "~a" base-version))))
        (unless (and supplied-version (= supplied-version (vector-ref row 2)))
          (error 'archive-concept-map! "version-conflict"))
        (define 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (restore-concept-map! config slug author)
  (call-with-wiki-database
   config
   (λ (db)
     (define 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)

  (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? (hash-ref (concept-content
                           (hash 'id concept-a
                                 'label "Linked concept"
                                 'externalUrl "https://example.com/path"))
                          'externalUrl)
                "https://example.com/path")
  (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 '())))))