#lang racket/base

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Canonical concept identity helpers.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require racket/string
         uuid)

(provide concept-id?
         normalize-concept-id
         new-concept-id
         normalized-or-new-concept-id)

(define prefixed-uuid-concept-id-pattern
  #px"(?i:^concept-([0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12})$)")

;; Concept ids are stored as plain UUID strings. Validation accepts uppercase
;; input, while normalization always produces the canonical lowercase form.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Check whether a value is a plain UUID concept identifier.
; pre    : value is any Racket value.
; post   : No state is changed.
; result : #t when value is a UUID string, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (concept-id? value)
  (uuid-string? value))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Convert a supported concept identifier to its canonical form.
; pre    : value is any Racket value.
; post   : No state is changed.
; result : A lowercase UUID string, or #f when value is not recognized.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (normalize-concept-id value)
  (cond
    [(uuid-string? value) (string-downcase value)]
    [(and (string? value)
          (regexp-match prefixed-uuid-concept-id-pattern value))
     => (λ (match) (string-downcase (cadr match)))]
    [else #f]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Create a new canonical concept identifier.
; pre    : none.
; post   : No persistent state is changed.
; result : A freshly generated lowercase UUID string.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (new-concept-id)
  (uuid-string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Normalize a concept identifier or create a replacement.
; pre    : value is any Racket value.
; post   : No persistent state is changed.
; result : The normalized identifier, or a fresh UUID when value is invalid.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (normalized-or-new-concept-id value)
  (or (normalize-concept-id value)
      (new-concept-id)))

(module+ test
  (require rackunit)

  (define sample "a3c4f0d1-22e5-4c42-9a40-cc864993f785")
  (check-true (concept-id? sample))
  (check-true (concept-id? (string-upcase sample)))
  (check-false (concept-id? (string-append "concept-" sample)))
  (check-equal? (normalize-concept-id (string-upcase sample)) sample)
  (check-equal? (normalize-concept-id (string-append "concept-" sample)) sample)
  (check-false (normalize-concept-id "legacy:a:concept-1"))
  (check-true (concept-id? (new-concept-id))))