Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-12 15:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Implementing search command.

Browse source
This commit is contained in:
Alex Shinn 2014-06-15 22:51:24 +09:00
parent c0775c23ed
commit 4b67a7bdb4
2 changed files with 50 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
lib/chibi/snow/commands.scm
View file

@ -597,24 +597,56 @@
;; Search - search for libraries matching keywords. ;; Search - search for libraries matching keywords.
;; ;;
;; Prints a list of libraries whose meta-info contain any of the given ;; Prints a list of libraries whose meta-info contain any of the given
;; keywords. Returns in sorted order or match score, with highest ;; keywords. Returns in sorted order for how well the package matches.
;; rank given to matches in the library name, followed by title,
;; followed by full description other fields, with seconday sorting on
;; rating and tertiary sorting on lexicographic order.
(define (summarize-libraries cfg lib-names+pkgs) (define (summarize-libraries cfg lib-names+pkgs)
(for-each describe-library (for-each describe-library
(map car lib-names+pkgs) (map car lib-names+pkgs)
(map cdr lib-names+pkgs))) (map cdr lib-names+pkgs)))
(define (extract-sorted-libraries cfg keywords) ;; faster than (length (regexp-extract re str))
'()) (define (regexp-count re str)
(regexp-fold re (lambda (from md str acc) (+ acc 1)) 0 str))
(define (command/search cfg spec keywords) (define (count-in-sexp x keywords)
(maybe-update-repository cfg) (regexp-count `(word (or ,@keywords)) (write-to-string x)))
(let ((libraries (extract-sorted-libraries cfg keywords)))
(if (pair? libraries) (define (extract-matching-libraries cfg repo keywords)
(summarize-libraries cfg libraries) (define (library-score lib)
(+ (* 10 (count-in-sexp (library-name lib) keywords))
(count-in-sexp lib keywords)))
(append-map
(lambda (x)
(cond
((not (package? x)) '())
(else
(let ((pkg-score (count-in-sexp x keywords))
(libs (package-libraries x)))
(if (or (zero? pkg-score) (null? libs))
'()
(let lp ((libs (cdr libs))
(best-score (library-score (car libs)))
(best-lib (car libs)))
(cond
((null? libs)
(list (cons (+ best-score pkg-score)
(cons (library-name best-lib) x))))
(else
(let ((score (library-score (car libs))))
(if (> score best-score)
(lp (cdr libs) score (car libs))
(lp (cdr libs) best-score best-lib)))))))))))
repo))
(define (extract-sorted-packages cfg repo keywords)
(let ((ls (extract-matching-libraries cfg repo keywords)))
(map cdr (sort ls > car))))
(define (command/search cfg spec . keywords)
(let* ((repo (maybe-update-repository cfg))
(lib-names+pkgs (extract-sorted-packages cfg repo keywords)))
(if (pair? lib-names+pkgs)
(summarize-libraries cfg lib-names+pkgs)
(display "No libraries matched your query.")))) (display "No libraries matched your query."))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -706,10 +738,12 @@
#f))) #f)))
(define (maybe-update-repository cfg) (define (maybe-update-repository cfg)
(if (should-update-repository? cfg) (or (guard (exn (else #f))
(update-repository cfg) (and (should-update-repository? cfg)
(call-with-input-file (make-path (repository-dir cfg) "repo.scm") (update-repository cfg)))
read))) (guard (exn (else '(repository)))
(call-with-input-file (make-path (repository-dir cfg) "repo.scm")
read))))
(define (command/update cfg spec) (define (command/update cfg spec)
(update-repository cfg)) (update-repository cfg))

1
lib/chibi/snow/commands.sld
View file

@ -38,6 +38,7 @@
(chibi net http) (chibi net http)
(chibi process) (chibi process)
(chibi pathname) (chibi pathname)
(chibi regexp)
(chibi show) (chibi show)
(chibi show pretty) (chibi show pretty)
(chibi string) (chibi string)