73 lines
2.8 KiB
Racket
73 lines
2.8 KiB
Racket
#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))))
|