suzanne.soy/racket-pkg-website
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Clean up search completions

Browse Source
This commit is contained in:
Tony Garnock-Jones 2014-11-09 17:31:04 -05:00
parent 17886b24d1
commit c08d89b66f
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/packages.rkt
View File

@ -4,6 +4,7 @@
@ref @ref
all-package-names all-package-names
all-tags all-tags
all-formal-tags
sorted-package-names sorted-package-names
package-detail package-detail
package-search package-search
@ -41,6 +42,7 @@
(struct package-manager-state (local-packages (struct package-manager-state (local-packages
all-tags all-tags
all-formal-tags
next-fetch-deadline next-fetch-deadline
next-bogus-timeout) #:prefab) next-bogus-timeout) #:prefab)
@ -74,6 +76,7 @@
(sleep 5) (sleep 5)
(package-manager)))) (package-manager))))
(package-manager-main (package-manager-state (hash) (package-manager-main (package-manager-state (hash)
(set)
(set) (set)
0 0
base-bogus-timeout)))) base-bogus-timeout))))
@ -110,7 +113,11 @@
((pkg (in-hash-values (package-manager-state-local-packages state)))) ((pkg (in-hash-values (package-manager-state-local-packages state))))
(set-union ts (list->set (set-union ts (list->set
(map symbol->string (map symbol->string
(hash-keys (or (@ pkg search-terms) (hash)))))))])) (hash-keys (or (@ pkg search-terms) (hash)))))))]
[all-formal-tags
(for/fold ((ts (set)))
((pkg (in-hash-values (package-manager-state-local-packages state))))
(set-union ts (list->set (or (@ pkg tags) '()))))]))
(define (replace-package old-pkg new-pkg state) (define (replace-package old-pkg new-pkg state)
(define local-packages (package-manager-state-local-packages state)) (define local-packages (package-manager-state-local-packages state))
@ -133,6 +140,7 @@
(define (package-manager-main state) (define (package-manager-main state)
(match-define (package-manager-state local-packages (match-define (package-manager-state local-packages
all-tags all-tags
all-formal-tags
next-fetch-deadline next-fetch-deadline
next-bogus-timeout) state) next-bogus-timeout) state)
(match (sync (handle-evt (thread-receive-evt) (match (sync (handle-evt (thread-receive-evt)
@ -166,6 +174,8 @@
(values (hash-keys local-packages) state)] (values (hash-keys local-packages) state)]
[(list 'all-tags) [(list 'all-tags)
(values all-tags state)] (values all-tags state)]
[(list 'all-formal-tags)
(values all-formal-tags state)]
[(list 'package-detail name) [(list 'package-detail name)
(define pkg (hash-ref local-packages name (lambda () #f))) (define pkg (hash-ref local-packages name (lambda () #f)))
(values (if (tombstone? pkg) #f pkg) state)] (values (if (tombstone? pkg) #f pkg) state)]
@ -187,6 +197,7 @@
(define (all-package-names) (manager-rpc 'all-package-names)) (define (all-package-names) (manager-rpc 'all-package-names))
(define (all-tags) (manager-rpc 'all-tags)) (define (all-tags) (manager-rpc 'all-tags))
(define (all-formal-tags) (manager-rpc 'all-formal-tags))
(define (package-detail package-name) (manager-rpc 'package-detail package-name)) (define (package-detail package-name) (manager-rpc 'package-detail package-name))
(define (replace-package! old-pkg new-pkg) (manager-rpc 'replace-package! old-pkg new-pkg)) (define (replace-package! old-pkg new-pkg) (manager-rpc 'replace-package! old-pkg new-pkg))
(define (delete-package! package-name) (manager-rpc 'delete-package! package-name)) (define (delete-package! package-name) (manager-rpc 'delete-package! package-name))

2
src/site.rkt
View File

@ -1093,7 +1093,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (json-search-completions request) (define (json-search-completions request)
(define completions (set-union (list->set (map ~a (all-package-names))) (all-tags))) (define completions (set-union (list->set (map ~a (all-package-names))) (all-formal-tags)))
(response/output #:mime-type #"application/json" (response/output #:mime-type #"application/json"
(lambda (response-port) (lambda (response-port)
(write-json (set->list completions) response-port)))) (write-json (set->list completions) response-port))))