#lang racket/base

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Wiki-wide registry for person tags used by CMap concepts.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require db
         racket/list
         racket/string
         "database.rkt")

(provide list-people
         create-person!
         update-person!
         sync-person-tags!)

(define (row->person row)
  (hash 'id (vector-ref row 0)
        'name (vector-ref row 1)
        'active (vector-ref row 2)))

(define (list-people config [include-inactive? #t])
  (call-with-wiki-database
   config
   (lambda (db)
     (for/list ((row (in-list
                      (query-rows
                       db
                       (string-append
                        "SELECT id, name, active FROM people"
                        (if include-inactive? "" " WHERE active = TRUE")
                        " ORDER BY lower(name), name")))))
       (row->person row)))))

(define (clean-person-name who name)
  (unless (string? name)
    (raise-argument-error who "string?" name))
  (define clean (string-trim name))
  (when (or (string=? clean "") (> (string-length clean) 200))
    (error who "person name must contain between 1 and 200 characters"))
  clean)

(define (create-person! config name)
  (define clean-name (clean-person-name 'create-person! name))
  (call-with-wiki-database
   config
   (lambda (db)
     (define now (current-seconds))
     (row->person
      (query-row
       db
       #<<SQL
INSERT INTO people(name, active, created_at, updated_at)
VALUES ($1, TRUE, $2, $2)
ON CONFLICT (lower(name)) DO UPDATE
SET name = excluded.name, active = TRUE, updated_at = excluded.updated_at
RETURNING id, name, active
SQL
       clean-name now)))))

(define (update-person! config id name active?)
  (define clean-name (clean-person-name 'update-person! name))
  (call-with-wiki-database
   config
   (lambda (db)
     (define row
       (query-maybe-row
        db
        #<<SQL
UPDATE people
SET name = $1, active = $2, updated_at = $3
WHERE id = $4
RETURNING id, name, active
SQL
        clean-name (if active? #t #f) (current-seconds) id))
     (and row (row->person row)))))

(define (person-tag-names document)
  (remove-duplicates
   (for*/list ((concept (in-list
                         (append (hash-ref document 'concepts '())
                                 (hash-ref document 'items '()))))
               #:when (hash? concept)
               (tag (in-list (hash-ref concept 'tags '())))
               #:when (and (hash? tag)
                           (string=? (hash-ref tag 'type "") "person")
                           (string? (hash-ref tag 'value #f))
                           (not (string=? (string-trim (hash-ref tag 'value)) ""))))
     (string-trim (hash-ref tag 'value)))
   string-ci=?))

;; Called inside the concept-map write transaction. New names become active;
;; an explicitly deactivated existing name remains deactivated.
(define (sync-person-tags! db document)
  (define now (current-seconds))
  (for ((name (in-list (person-tag-names document))))
    (query-exec
     db
     #<<SQL
INSERT INTO people(name, active, created_at, updated_at)
VALUES ($1, TRUE, $2, $2)
ON CONFLICT (lower(name)) DO NOTHING
SQL
     name now))
  (void))

(module+ test
  (require rackunit)
  (check-equal?
   (person-tag-names
    (hash 'concepts
          (list (hash 'tags
                      (list (hash 'type "person" 'value " Alex Morgan ")
                            (hash 'type "label" 'value "architecture")))
                (hash 'tags
                      (list (hash 'type "person" 'value "alex morgan")
                            (hash 'type "person" 'value "Sam de Vries"))))
          'items '()))
   '("Alex Morgan" "Sam de Vries")))