refactoring by skill
This commit is contained in:
+220
-224
@@ -62,30 +62,30 @@
|
||||
(define (canonical-datum value)
|
||||
(cond
|
||||
[(hash? value)
|
||||
(define keys
|
||||
(sort (hash-keys value)
|
||||
string<?
|
||||
#:key (λ (key) (format "~a" key))))
|
||||
(for/list ([key (in-list keys)])
|
||||
(list key (canonical-datum (hash-ref value key))))]
|
||||
(let ((keys
|
||||
(sort (hash-keys value)
|
||||
string<?
|
||||
#:key (λ (key) (format "~a" key)))))
|
||||
(for/list ([key (in-list keys)])
|
||||
(list key (canonical-datum (hash-ref value key)))))]
|
||||
[(list? value)
|
||||
(for/list ([item (in-list value)])
|
||||
(canonical-datum item))]
|
||||
[else value]))
|
||||
|
||||
(define (source-hash value)
|
||||
(define source-bytes
|
||||
(string->bytes/utf-8
|
||||
(format "~s" (canonical-datum value))))
|
||||
(bytes->hex-string (sha256-bytes source-bytes)))
|
||||
(let ((source-bytes
|
||||
(string->bytes/utf-8
|
||||
(format "~s" (canonical-datum value)))))
|
||||
(bytes->hex-string (sha256-bytes source-bytes))))
|
||||
|
||||
(define (read-page-source namespace specification)
|
||||
(define slug (hash-ref specification 'slug))
|
||||
(architecture-page
|
||||
(page-reference namespace slug)
|
||||
(hash-ref specification 'title)
|
||||
(file->string (content-path (hash-ref specification 'file)))
|
||||
(hash-ref specification 'tags '())))
|
||||
(let ((slug (hash-ref specification 'slug)))
|
||||
(architecture-page
|
||||
(page-reference namespace slug)
|
||||
(hash-ref specification 'title)
|
||||
(file->string (content-path (hash-ref specification 'file)))
|
||||
(hash-ref specification 'tags '()))))
|
||||
|
||||
(define (read-concept-map-source specification)
|
||||
(architecture-concept-map
|
||||
@@ -96,109 +96,107 @@
|
||||
read-json)))
|
||||
|
||||
(define (load-architecture-content)
|
||||
(define manifest (read-manifest))
|
||||
(unless (hash? manifest)
|
||||
(error 'load-architecture-content "manifest.rktd must contain a hash"))
|
||||
(define namespace (hash-ref manifest 'namespace))
|
||||
(define pages
|
||||
(for/list ([specification (in-list (hash-ref manifest 'pages))])
|
||||
(read-page-source namespace specification)))
|
||||
(define concept-maps
|
||||
(for/list ([specification (in-list (hash-ref manifest 'concept-maps))])
|
||||
(read-concept-map-source specification)))
|
||||
(values namespace pages concept-maps))
|
||||
(let ((manifest (read-manifest)))
|
||||
(unless (hash? manifest)
|
||||
(error 'load-architecture-content "manifest.rktd must contain a hash"))
|
||||
(let* ((namespace (hash-ref manifest 'namespace))
|
||||
(pages
|
||||
(for/list ([specification (in-list (hash-ref manifest 'pages))])
|
||||
(read-page-source namespace specification)))
|
||||
(concept-maps
|
||||
(for/list ([specification (in-list (hash-ref manifest 'concept-maps))])
|
||||
(read-concept-map-source specification))))
|
||||
(values namespace pages concept-maps))))
|
||||
|
||||
(define (duplicate-values values)
|
||||
(define seen (mutable-set))
|
||||
(define duplicates (mutable-set))
|
||||
(for ([value (in-list values)])
|
||||
(if (set-member? seen value)
|
||||
(set-add! duplicates value)
|
||||
(set-add! seen value)))
|
||||
(sort (set->list duplicates) string<?))
|
||||
(let ((seen (mutable-set))
|
||||
(duplicates (mutable-set)))
|
||||
(for ([value (in-list values)])
|
||||
(if (set-member? seen value)
|
||||
(set-add! duplicates value)
|
||||
(set-add! seen value)))
|
||||
(sort (set->list duplicates) string<?)))
|
||||
|
||||
(define (validate-page-links! page page-references concept-map-slugs)
|
||||
(define markdown (architecture-page-markdown page))
|
||||
(define linked-pages
|
||||
(regexp-match*
|
||||
#px"\\]\\((racket-wiki:[^)#]+)(?:#[^)]*)?\\)"
|
||||
markdown
|
||||
#:match-select (λ (match) (list-ref match 1))))
|
||||
(define embedded-concept-maps
|
||||
(for/list ([line (in-list (string-split markdown "\n" #:trim? #f))]
|
||||
#:do [(define match
|
||||
(regexp-match
|
||||
concept-map-embed-pattern
|
||||
line))]
|
||||
#:when match)
|
||||
(string-trim (list-ref match 1))))
|
||||
(for ([reference (in-list linked-pages)])
|
||||
(unless (set-member? page-references reference)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"page ~a links to unknown architecture page ~a"
|
||||
(architecture-page-reference page)
|
||||
reference)))
|
||||
(for ([slug (in-list embedded-concept-maps)])
|
||||
(unless (set-member? concept-map-slugs slug)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"page ~a embeds unknown architecture CMap ~a"
|
||||
(architecture-page-reference page)
|
||||
slug))))
|
||||
(let* ((markdown (architecture-page-markdown page))
|
||||
(linked-pages
|
||||
(regexp-match*
|
||||
#px"\\]\\((racket-wiki:[^)#]+)(?:#[^)]*)?\\)"
|
||||
markdown
|
||||
#:match-select (λ (match) (list-ref match 1))))
|
||||
(embedded-concept-maps
|
||||
(filter-map
|
||||
(λ (line)
|
||||
(let ((match (regexp-match concept-map-embed-pattern line)))
|
||||
(and match (string-trim (list-ref match 1)))))
|
||||
(string-split markdown "\n" #:trim? #f))))
|
||||
(for ([reference (in-list linked-pages)])
|
||||
(unless (set-member? page-references reference)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"page ~a links to unknown architecture page ~a"
|
||||
(architecture-page-reference page)
|
||||
reference)))
|
||||
(for ([slug (in-list embedded-concept-maps)])
|
||||
(unless (set-member? concept-map-slugs slug)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"page ~a embeds unknown architecture CMap ~a"
|
||||
(architecture-page-reference page)
|
||||
slug)))))
|
||||
|
||||
(define (validate-concept-map! concept-map page-references)
|
||||
(define document (architecture-concept-map-document concept-map))
|
||||
(unless (hash? document)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a is not a JSON object"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(unless (equal? (hash-ref document 'schemaVersion #f) 1)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a does not use schema version 1"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(define items (hash-ref document 'items '()))
|
||||
(define connectors (hash-ref document 'connectors '()))
|
||||
(unless (and (list? items) (list? connectors))
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a must contain item and connector arrays"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(define item-ids
|
||||
(for/list ([item (in-list items)])
|
||||
(unless (hash? item)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a non-object item"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(define item-id (hash-ref item 'id #f))
|
||||
(unless (exact-positive-integer? item-id)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains an invalid item id"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(define linked-page (hash-ref item 'pageSlug #f))
|
||||
(when (and linked-page (not (set-member? page-references linked-page)))
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a links to unknown architecture page ~a"
|
||||
(architecture-concept-map-slug concept-map)
|
||||
linked-page))
|
||||
item-id))
|
||||
(define duplicate-item-ids
|
||||
(duplicate-values (map number->string item-ids)))
|
||||
(unless (null? duplicate-item-ids)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a has duplicate item ids: ~a"
|
||||
(architecture-concept-map-slug concept-map)
|
||||
(string-join duplicate-item-ids ", ")))
|
||||
(define item-id-set (list->set item-ids))
|
||||
(for ([connector (in-list connectors)])
|
||||
(unless (hash? connector)
|
||||
(let ((document (architecture-concept-map-document concept-map)))
|
||||
(unless (hash? document)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a non-object connector"
|
||||
"CMap ~a is not a JSON object"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(define source-id (hash-ref connector 'sourceId #f))
|
||||
(define target-id (hash-ref connector 'targetId #f))
|
||||
(unless (and (set-member? item-id-set source-id)
|
||||
(set-member? item-id-set target-id))
|
||||
(unless (equal? (hash-ref document 'schemaVersion #f) 1)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a connector with an unknown endpoint"
|
||||
(architecture-concept-map-slug concept-map)))))
|
||||
"CMap ~a does not use schema version 1"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(let ((items (hash-ref document 'items '()))
|
||||
(connectors (hash-ref document 'connectors '())))
|
||||
(unless (and (list? items) (list? connectors))
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a must contain item and connector arrays"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(let* ((item-ids
|
||||
(for/list ([item (in-list items)])
|
||||
(unless (hash? item)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a non-object item"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(let ((item-id (hash-ref item 'id #f))
|
||||
(linked-page (hash-ref item 'pageSlug #f)))
|
||||
(unless (exact-positive-integer? item-id)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains an invalid item id"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(when (and linked-page (not (set-member? page-references linked-page)))
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a links to unknown architecture page ~a"
|
||||
(architecture-concept-map-slug concept-map)
|
||||
linked-page))
|
||||
item-id)))
|
||||
(duplicate-item-ids
|
||||
(duplicate-values (map number->string item-ids)))
|
||||
(item-id-set (list->set item-ids)))
|
||||
(unless (null? duplicate-item-ids)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a has duplicate item ids: ~a"
|
||||
(architecture-concept-map-slug concept-map)
|
||||
(string-join duplicate-item-ids ", ")))
|
||||
(for ([connector (in-list connectors)])
|
||||
(unless (hash? connector)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a non-object connector"
|
||||
(architecture-concept-map-slug concept-map)))
|
||||
(let ((source-id (hash-ref connector 'sourceId #f))
|
||||
(target-id (hash-ref connector 'targetId #f)))
|
||||
(unless (and (set-member? item-id-set source-id)
|
||||
(set-member? item-id-set target-id))
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"CMap ~a contains a connector with an unknown endpoint"
|
||||
(architecture-concept-map-slug concept-map)))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Validate every bundled page, link and CMap before importing.
|
||||
@@ -207,42 +205,40 @@
|
||||
; result : Two values containing the validated pages and CMaps.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (validate-racket-wiki-architecture!)
|
||||
(define-values (namespace pages concept-maps)
|
||||
(load-architecture-content))
|
||||
(unless (string=? namespace "racket-wiki")
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"the architecture namespace must be racket-wiki"))
|
||||
(define page-reference-list
|
||||
(map architecture-page-reference pages))
|
||||
(define concept-map-slug-list
|
||||
(map architecture-concept-map-slug concept-maps))
|
||||
(define duplicate-pages (duplicate-values page-reference-list))
|
||||
(define duplicate-concept-maps (duplicate-values concept-map-slug-list))
|
||||
(unless (null? duplicate-pages)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"duplicate page references: ~a"
|
||||
(string-join duplicate-pages ", ")))
|
||||
(unless (null? duplicate-concept-maps)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"duplicate CMap slugs: ~a"
|
||||
(string-join duplicate-concept-maps ", ")))
|
||||
(for ([reference (in-list page-reference-list)])
|
||||
(unless (valid-page-reference? reference)
|
||||
(let-values (((namespace pages concept-maps)
|
||||
(load-architecture-content)))
|
||||
(unless (string=? namespace "racket-wiki")
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"invalid page reference: ~a"
|
||||
reference)))
|
||||
(for ([slug (in-list concept-map-slug-list)])
|
||||
(unless (valid-slug? slug)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"invalid CMap slug: ~a"
|
||||
slug)))
|
||||
(define page-references (list->set page-reference-list))
|
||||
(define concept-map-slugs (list->set concept-map-slug-list))
|
||||
(for ([page (in-list pages)])
|
||||
(validate-page-links! page page-references concept-map-slugs))
|
||||
(for ([concept-map (in-list concept-maps)])
|
||||
(validate-concept-map! concept-map page-references))
|
||||
(values pages concept-maps))
|
||||
"the architecture namespace must be racket-wiki"))
|
||||
(let* ((page-reference-list (map architecture-page-reference pages))
|
||||
(concept-map-slug-list (map architecture-concept-map-slug concept-maps))
|
||||
(duplicate-pages (duplicate-values page-reference-list))
|
||||
(duplicate-concept-maps (duplicate-values concept-map-slug-list)))
|
||||
(unless (null? duplicate-pages)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"duplicate page references: ~a"
|
||||
(string-join duplicate-pages ", ")))
|
||||
(unless (null? duplicate-concept-maps)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"duplicate CMap slugs: ~a"
|
||||
(string-join duplicate-concept-maps ", ")))
|
||||
(for ([reference (in-list page-reference-list)])
|
||||
(unless (valid-page-reference? reference)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"invalid page reference: ~a"
|
||||
reference)))
|
||||
(for ([slug (in-list concept-map-slug-list)])
|
||||
(unless (valid-slug? slug)
|
||||
(error 'validate-racket-wiki-architecture!
|
||||
"invalid CMap slug: ~a"
|
||||
slug)))
|
||||
(let ((page-references (list->set page-reference-list))
|
||||
(concept-map-slugs (list->set concept-map-slug-list)))
|
||||
(for ([page (in-list pages)])
|
||||
(validate-page-links! page page-references concept-map-slugs))
|
||||
(for ([concept-map (in-list concept-maps)])
|
||||
(validate-concept-map! concept-map page-references))))
|
||||
(values pages concept-maps)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Source ownership markers
|
||||
@@ -256,11 +252,11 @@
|
||||
markdown))
|
||||
|
||||
(define (page-source-unmodified? title markdown tags)
|
||||
(define match (regexp-match page-source-marker-pattern markdown))
|
||||
(and match
|
||||
(let ([body (regexp-replace page-source-marker-pattern markdown "")]
|
||||
[stored-hash (list-ref match 1)])
|
||||
(string=? stored-hash (source-hash (list title body tags))))))
|
||||
(let ((match (regexp-match page-source-marker-pattern markdown)))
|
||||
(and match
|
||||
(let ((body (regexp-replace page-source-marker-pattern markdown ""))
|
||||
(stored-hash (list-ref match 1)))
|
||||
(string=? stored-hash (source-hash (list title body tags)))))))
|
||||
|
||||
(define (concept-map-source-marker? reference)
|
||||
(and (hash? reference)
|
||||
@@ -268,33 +264,33 @@
|
||||
concept-map-source-marker-id)))
|
||||
|
||||
(define (concept-map-without-source-marker document)
|
||||
(define references (hash-ref document 'conceptMaps '()))
|
||||
(hash-set document
|
||||
'conceptMaps
|
||||
(filter (λ (reference)
|
||||
(not (concept-map-source-marker? reference)))
|
||||
references)))
|
||||
(let ((references (hash-ref document 'conceptMaps '())))
|
||||
(hash-set document
|
||||
'conceptMaps
|
||||
(filter (λ (reference)
|
||||
(not (concept-map-source-marker? reference)))
|
||||
references))))
|
||||
|
||||
(define (concept-map-with-source-marker title document)
|
||||
(define clean-document (concept-map-without-source-marker document))
|
||||
(define marker
|
||||
(hash 'id concept-map-source-marker-id
|
||||
'kind "architecture-source"
|
||||
'sourceHash (source-hash (list title clean-document))))
|
||||
(hash-set clean-document
|
||||
'conceptMaps
|
||||
(append (hash-ref clean-document 'conceptMaps '())
|
||||
(list marker))))
|
||||
(let* ((clean-document (concept-map-without-source-marker document))
|
||||
(marker
|
||||
(hash 'id concept-map-source-marker-id
|
||||
'kind "architecture-source"
|
||||
'sourceHash (source-hash (list title clean-document)))))
|
||||
(hash-set clean-document
|
||||
'conceptMaps
|
||||
(append (hash-ref clean-document 'conceptMaps '())
|
||||
(list marker)))))
|
||||
|
||||
(define (concept-map-source-unmodified? title document)
|
||||
(define marker
|
||||
(findf concept-map-source-marker?
|
||||
(hash-ref document 'conceptMaps '())))
|
||||
(and marker
|
||||
(string=? (hash-ref marker 'sourceHash "")
|
||||
(source-hash
|
||||
(list title
|
||||
(concept-map-without-source-marker document))))))
|
||||
(let ((marker
|
||||
(findf concept-map-source-marker?
|
||||
(hash-ref document 'conceptMaps '()))))
|
||||
(and marker
|
||||
(string=? (hash-ref marker 'sourceHash "")
|
||||
(source-hash
|
||||
(list title
|
||||
(concept-map-without-source-marker document)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Import operations
|
||||
@@ -312,13 +308,13 @@
|
||||
(architecture-page-tags page))))
|
||||
|
||||
(define (import-page! config page author dry-run? overwrite-modified?)
|
||||
(define reference (architecture-page-reference page))
|
||||
(define marked-markdown
|
||||
(page-with-source-marker (architecture-page-title page)
|
||||
(architecture-page-markdown page)
|
||||
(architecture-page-tags page)))
|
||||
(define current (read-page config reference))
|
||||
(cond
|
||||
(let* ((reference (architecture-page-reference page))
|
||||
(marked-markdown
|
||||
(page-with-source-marker (architecture-page-title page)
|
||||
(architecture-page-markdown page)
|
||||
(architecture-page-tags page)))
|
||||
(current (read-page config reference)))
|
||||
(cond
|
||||
[(not current)
|
||||
(if dry-run?
|
||||
(result 'page reference 'would-create "Page would be created")
|
||||
@@ -355,7 +351,7 @@
|
||||
(hash-ref current 'currentVersion)
|
||||
"Updated racket-wiki architecture documentation"
|
||||
(architecture-page-tags page))
|
||||
(result 'page reference 'updated "Page updated")]))
|
||||
(result 'page reference 'updated "Page updated")])))
|
||||
|
||||
(define (concept-map-content-equal? current concept-map marked-document)
|
||||
(and (string=? (hash-ref current 'title)
|
||||
@@ -364,13 +360,13 @@
|
||||
marked-document)))
|
||||
|
||||
(define (import-concept-map! config concept-map author dry-run? overwrite-modified?)
|
||||
(define slug (architecture-concept-map-slug concept-map))
|
||||
(define marked-document
|
||||
(concept-map-with-source-marker
|
||||
(architecture-concept-map-title concept-map)
|
||||
(architecture-concept-map-document concept-map)))
|
||||
(define current (read-concept-map config slug))
|
||||
(cond
|
||||
(let* ((slug (architecture-concept-map-slug concept-map))
|
||||
(marked-document
|
||||
(concept-map-with-source-marker
|
||||
(architecture-concept-map-title concept-map)
|
||||
(architecture-concept-map-document concept-map)))
|
||||
(current (read-concept-map config slug)))
|
||||
(cond
|
||||
[(not current)
|
||||
(if dry-run?
|
||||
(result 'concept-map slug 'would-create "CMap would be created")
|
||||
@@ -405,7 +401,7 @@
|
||||
(hash-ref current 'currentVersion)
|
||||
"Updated racket-wiki architecture CMap"
|
||||
"import")
|
||||
(result 'concept-map slug 'updated "CMap updated")]))
|
||||
(result 'concept-map slug 'updated "CMap updated")])))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Import the bundled architecture set below namespace racket-wiki.
|
||||
@@ -420,23 +416,23 @@
|
||||
#:author [author "racket-wiki architecture import"]
|
||||
#:dry-run? [dry-run? #f]
|
||||
#:overwrite-modified? [overwrite-modified? #f])
|
||||
(define-values (pages concept-maps)
|
||||
(validate-racket-wiki-architecture!))
|
||||
(ensure-wiki-data! config)
|
||||
(unless (database-settings-exist? config)
|
||||
(error 'import-racket-wiki-architecture!
|
||||
"PostgreSQL is not configured for data directory ~a"
|
||||
(wiki-config-data-dir config)))
|
||||
(initialize-database! config)
|
||||
(append
|
||||
(for/list ([page (in-list pages)])
|
||||
(import-page! config page author dry-run? overwrite-modified?))
|
||||
(for/list ([concept-map (in-list concept-maps)])
|
||||
(import-concept-map! config
|
||||
concept-map
|
||||
author
|
||||
dry-run?
|
||||
overwrite-modified?))))
|
||||
(let-values (((pages concept-maps)
|
||||
(validate-racket-wiki-architecture!)))
|
||||
(ensure-wiki-data! config)
|
||||
(unless (database-settings-exist? config)
|
||||
(error 'import-racket-wiki-architecture!
|
||||
"PostgreSQL is not configured for data directory ~a"
|
||||
(wiki-config-data-dir config)))
|
||||
(initialize-database! config)
|
||||
(append
|
||||
(for/list ([page (in-list pages)])
|
||||
(import-page! config page author dry-run? overwrite-modified?))
|
||||
(for/list ([concept-map (in-list concept-maps)])
|
||||
(import-concept-map! config
|
||||
concept-map
|
||||
author
|
||||
dry-run?
|
||||
overwrite-modified?)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Import the architecture set using only a wiki data directory.
|
||||
@@ -449,13 +445,13 @@
|
||||
#:author [author "racket-wiki architecture import"]
|
||||
#:dry-run? [dry-run? #f]
|
||||
#:overwrite-modified? [overwrite-modified? #f])
|
||||
(define config
|
||||
(make-wiki-config #:data-dir data-directory))
|
||||
(import-racket-wiki-architecture!
|
||||
config
|
||||
#:author author
|
||||
#:dry-run? dry-run?
|
||||
#:overwrite-modified? overwrite-modified?))
|
||||
(let ((config
|
||||
(make-wiki-config #:data-dir data-directory)))
|
||||
(import-racket-wiki-architecture!
|
||||
config
|
||||
#:author author
|
||||
#:dry-run? dry-run?
|
||||
#:overwrite-modified? overwrite-modified?)))
|
||||
|
||||
(define (display-import-results results)
|
||||
(for ([import-result (in-list results)])
|
||||
@@ -464,17 +460,17 @@
|
||||
(architecture-import-result-status import-result)
|
||||
(architecture-import-result-kind import-result)
|
||||
(architecture-import-result-reference import-result))))
|
||||
(define skipped
|
||||
(count (λ (import-result)
|
||||
(eq? (architecture-import-result-status import-result)
|
||||
'skipped-modified))
|
||||
results))
|
||||
(displayln (format "Processed ~a architecture items." (length results)))
|
||||
(when (> skipped 0)
|
||||
(displayln
|
||||
(format
|
||||
"~a locally modified item(s) were preserved. Review them before using --overwrite-modified."
|
||||
skipped))))
|
||||
(let ((skipped
|
||||
(count (λ (import-result)
|
||||
(eq? (architecture-import-result-status import-result)
|
||||
'skipped-modified))
|
||||
results)))
|
||||
(displayln (format "Processed ~a architecture items." (length results)))
|
||||
(when (> skipped 0)
|
||||
(displayln
|
||||
(format
|
||||
"~a locally modified item(s) were preserved. Review them before using --overwrite-modified."
|
||||
skipped)))))
|
||||
|
||||
(module+ main
|
||||
(define config (default-wiki-config))
|
||||
|
||||
Reference in New Issue
Block a user