forked from cadence/breezewiki
Solr indexer code cleanup
This commit is contained in:
parent
aea627b27f
commit
27c9680f5b
402
archiver/fts.rkt
402
archiver/fts.rkt
|
|
@ -1,202 +1,200 @@
|
|||
#lang racket
|
||||
(require racket/function
|
||||
racket/future
|
||||
racket/match
|
||||
racket/path
|
||||
racket/promise
|
||||
racket/port
|
||||
racket/string
|
||||
file/gunzip
|
||||
db
|
||||
db/unsafe/sqlite3
|
||||
net/http-easy
|
||||
json
|
||||
json-pointer
|
||||
"../lib/html-parsing/main.rkt"
|
||||
"../lib/xexpr-utils.rkt"
|
||||
"../lib/tree-updater.rkt")
|
||||
|
||||
(define-syntax (seq stx)
|
||||
(syntax-case stx ()
|
||||
[(_ body ...)
|
||||
#`(for ([op (list (lambda () body) ...)]
|
||||
[i (in-naturals)])
|
||||
(define res (op))
|
||||
(when (>= (response-status-code res) 400)
|
||||
(error 'seq "op #~a: status code was ~a: ~v" i (response-status-code res) (response-json res)))
|
||||
(define taskuid (json-pointer-value "/taskUid" (response-json res)))
|
||||
(for/or ([ticks (in-naturals)]
|
||||
[res2 (in-producer (lambda () (get (format "http://localhost:7700/tasks/~a" taskuid))))])
|
||||
(define status (json-pointer-value "/status" (response-json res2)))
|
||||
(case status
|
||||
[("enqueued" "processing")
|
||||
(sleep 1)
|
||||
#f]
|
||||
[("succeeded")
|
||||
(printf "op #~a: ~a (~a ticks)~n" i status ticks)
|
||||
#t]
|
||||
[else
|
||||
(error 'seq "op #~a: task status was ~a: ~v" i status res2)])))]))
|
||||
|
||||
(define (class-has? attributes substrs)
|
||||
(define cl (or (get-attribute 'class attributes) ""))
|
||||
(ormap (λ (substr) (string-contains? cl substr)) substrs))
|
||||
|
||||
(define (updater element element-type attributes children)
|
||||
(cond
|
||||
[(class-has? attributes '("collapsed" "selflink" "label" "toc" "editsection" "reviews"))
|
||||
(list 'div '() '())]
|
||||
[#t
|
||||
(list element-type attributes children)]))
|
||||
|
||||
(define slc (sqlite3-connect #:database "../storage/fts-separate.db"))
|
||||
(sqlite3-load-extension slc "fts5")
|
||||
|
||||
(define (writer tables-mode? page)
|
||||
(define (writer-inner page)
|
||||
(for ([bit page])
|
||||
(cond
|
||||
[(and tables-mode? (pair? bit) (memq (car bit) '(h1 h2 h3 p blockquote q))) (void)]
|
||||
[(and (not tables-mode?) (pair? bit) (memq (car bit) '(ul ol dl table))) (void)]
|
||||
[(memq bit '(div p li td dd dt br)) (displayln "")]
|
||||
[(symbol? bit) (void)]
|
||||
[(and (pair? bit) (eq? (car bit) '*COMMENT*)) (void)]
|
||||
[(and (pair? bit) (eq? (car bit) '@)) (void)]
|
||||
[(pair? bit) (writer-inner bit)]
|
||||
[(string? bit) (display bit)])))
|
||||
(writer-inner page))
|
||||
|
||||
(define (write-and-post-process tables-mode? page)
|
||||
(define text (with-output-to-string (λ () (writer tables-mode? page))))
|
||||
;; (define text-no-numbers (regexp-replace* #px"(?:-|[+$£€¥] *)?[0-9,.]{2,}%?\\s*" text ""))
|
||||
(define shrink-text (regexp-replace* #px"([ \t]*\r?\n+)+" text "\n"))
|
||||
shrink-text)
|
||||
|
||||
(define wikiname "bloons")
|
||||
(define tablename (format "page_~a" wikiname))
|
||||
|
||||
(define ((extract f)) ; f - filename
|
||||
(with-handlers
|
||||
([exn:fail? (λ (err) (println f) (raise err))])
|
||||
(define j
|
||||
(case (path-get-extension f)
|
||||
[(#".json")
|
||||
(with-input-from-file f (λ () (read-json)))]
|
||||
[(#".gz")
|
||||
(define-values (in out) (make-pipe))
|
||||
(with-input-from-file f (λ () (gunzip-through-ports (current-input-port) out)))
|
||||
(read-json in)]
|
||||
[else #f]))
|
||||
(define title (json-pointer-value "/parse/title" j))
|
||||
(define pageid (json-pointer-value "/parse/pageid" j))
|
||||
(define page-html (preprocess-html-wiki (json-pointer-value "/parse/text" j)))
|
||||
(define page (update-tree updater (html->xexp page-html)))
|
||||
(define body (write-and-post-process #f page))
|
||||
(define table (write-and-post-process #t page))
|
||||
(values title body table pageid)))
|
||||
|
||||
(define results
|
||||
(for/list ([f (directory-list (format "../storage/archive/~a" wikiname) #:build? #t)]
|
||||
#:when (member (path-get-extension f) '(#".json" #".gz")))
|
||||
(extract f)))
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; TESTING WRITER
|
||||
;; ***************************************************************************************************
|
||||
#;(for/first ([fut results]
|
||||
[i (in-naturals 1)]
|
||||
#:when (i . >= . 4859))
|
||||
(define-values (title body table pageid) (fut))
|
||||
(println title)
|
||||
(println body)
|
||||
(println table))
|
||||
|
||||
(println "inserting...")
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; SQLite FTS5
|
||||
;; ***************************************************************************************************
|
||||
#;(begin
|
||||
(query-exec slc "begin transaction")
|
||||
#;(query-exec slc (format "create virtual table \"~a\" using fts5 (title, body, tokenize='porter unicode61')" wikiname))
|
||||
(time
|
||||
(for ([fut results]
|
||||
[i (in-naturals 1)])
|
||||
(display "-")
|
||||
(when (and (> i 0) (= (modulo i 100) 0))
|
||||
(println i))
|
||||
(define-values (title shrink-text) (fut))
|
||||
(query-exec slc (format "insert into \"~a\" (title, body) values (?, ?)" tablename) title shrink-text)))
|
||||
|
||||
(println "running optimize...")
|
||||
(query-exec slc (format "insert into \"~a\" (\"~a\") values ('optimize')" tablename tablename))
|
||||
|
||||
(println "committing...")
|
||||
(query-exec slc "commit"))
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; Solr
|
||||
;; ***************************************************************************************************
|
||||
(begin
|
||||
(define data
|
||||
(cond
|
||||
#;[(file-exists? "cache.rkt")
|
||||
(println "reading in...")
|
||||
(with-input-from-file "cache.rkt" (λ () (read)))]
|
||||
[else
|
||||
(define data
|
||||
(for/list ([fut results]
|
||||
[i (in-naturals 1)])
|
||||
(display "-")
|
||||
(when (and (> i 0) (= (modulo i 100) 0))
|
||||
(println i))
|
||||
(define-values (title body table pageid) (fut))
|
||||
(define len (string-length body))
|
||||
`#hasheq((id . ,(number->string pageid))
|
||||
(title . ,title)
|
||||
(body . ,body)
|
||||
(table . ,table)
|
||||
(len . ,len))))
|
||||
|
||||
(println "writing out...")
|
||||
(with-output-to-file "cache.rkt" (λ () (write data)) #:exists 'truncate/replace)
|
||||
data]))
|
||||
|
||||
(println "posting...")
|
||||
(define res
|
||||
(post (format "http://localhost:8983/solr/~a/update?commit=true" wikiname)
|
||||
#:json data)))
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; Meilisearch
|
||||
;; ***************************************************************************************************
|
||||
#;(begin
|
||||
(seq
|
||||
(put (format "http://localhost:7700/indexes/~a/settings/searchable-attributes" wikiname)
|
||||
#:json '("title" "body"))
|
||||
(put (format "http://localhost:7700/indexes/~a/settings/ranking-rules" wikiname)
|
||||
#:json '("words" "typo" #;"proximity" "attribute" "sort" "exactness" #;"len:desc"))
|
||||
(call-with-input-file "stop-words.json"
|
||||
(λ (in)
|
||||
(put (format "http://localhost:7700/indexes/~a/settings/stop-words" wikiname)
|
||||
#:headers '#hasheq((Content-Type . "application/json"))
|
||||
#:data in))))
|
||||
(define data
|
||||
(for/list ([fut results]
|
||||
[i (in-naturals 1)])
|
||||
(display "-")
|
||||
(when (and (> i 0) (= (modulo i 100) 0))
|
||||
(println i))
|
||||
(define-values (title body pageid) (fut))
|
||||
(define len (string-length body))
|
||||
`#hasheq((id . ,pageid)
|
||||
(title . ,title)
|
||||
(body . ,body)
|
||||
(len . ,len))))
|
||||
(define res
|
||||
(post (format "http://localhost:7700/indexes/~a/documents" wikiname)
|
||||
#:json data))
|
||||
(seq res)
|
||||
(println (response-json res)))
|
||||
|
||||
(disconnect slc)
|
||||
#lang cli
|
||||
(require (for-syntax racket/base))
|
||||
(require racket/format
|
||||
racket/function
|
||||
racket/future
|
||||
racket/match
|
||||
racket/path
|
||||
racket/promise
|
||||
racket/port
|
||||
racket/runtime-path
|
||||
racket/string
|
||||
file/gunzip
|
||||
db
|
||||
db/unsafe/sqlite3
|
||||
net/http-easy
|
||||
json
|
||||
json-pointer
|
||||
"../lib/html-parsing/main.rkt"
|
||||
"../lib/xexpr-utils.rkt"
|
||||
"../lib/tree-updater.rkt")
|
||||
|
||||
(flag (read-from-cache?)
|
||||
("-c" "--read-from-cache" "read from last run cache instead of rebuilding documents")
|
||||
(read-from-cache? #t))
|
||||
|
||||
(define-runtime-path storage-path "../storage/archive")
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; Progress bar display
|
||||
;; ***************************************************************************************************
|
||||
|
||||
(struct progress^ (n max title) #:transparent)
|
||||
|
||||
(define (make-m-s seconds)
|
||||
(define-values (eta-m eta-s) (quotient/remainder seconds 60))
|
||||
(format "~a:~a" eta-m (~a eta-s #:width 2 #:align 'right #:pad-string "0")))
|
||||
|
||||
(define (make-progress get-p [history-size 20])
|
||||
(define update-sleep 1)
|
||||
(define name-width 30)
|
||||
(define max-width 105)
|
||||
(define history (make-vector history-size 0))
|
||||
(define history-pointer 0)
|
||||
(define elapsed 0)
|
||||
(define (report-progress)
|
||||
(define p (get-p))
|
||||
(define history-cycle (vector-ref history history-pointer))
|
||||
(vector-set! history history-pointer (progress^-n p))
|
||||
(set! history-pointer (modulo (add1 history-pointer) history-size))
|
||||
(set! elapsed (add1 elapsed))
|
||||
(define-values (eta-display diff-per-second)
|
||||
(cond
|
||||
[((progress^-n p) . >= . (progress^-max p)) (values (format "~a **" (make-m-s elapsed)) (format "** ~a" (quotient (progress^-max p) (max elapsed 1))))]
|
||||
[(= history-cycle 0) (values "-:--" "--")]
|
||||
[else (define diff-per-second (/ (- (progress^-n p) history-cycle) (* history-size update-sleep)))
|
||||
(define eta-total
|
||||
(if (diff-per-second . > . 0)
|
||||
(floor (round (/ (- (progress^-max p) (progress^-n p)) diff-per-second)))
|
||||
0))
|
||||
(values (make-m-s eta-total)
|
||||
(round diff-per-second))]))
|
||||
(define left (format "~a/~a ~a/s ~a ~a%"
|
||||
(~a (progress^-n p) #:width (string-length (~a (progress^-max p))) #:align 'right #:pad-string " ")
|
||||
(progress^-max p)
|
||||
diff-per-second
|
||||
eta-display
|
||||
(floor (* 100 (/ (progress^-n p) (progress^-max p))))))
|
||||
(define name-display (~a (progress^-title p) #:max-width name-width #:limit-marker "..."))
|
||||
(define remaining-space (- max-width name-width (string-length left) 2))
|
||||
(define bar-width
|
||||
(floor (* (sub1 remaining-space)
|
||||
(/ (progress^-n p) (progress^-max p)))))
|
||||
(define bar (string-append (make-string bar-width #\=)
|
||||
">"
|
||||
(make-string (- remaining-space bar-width) #\ )))
|
||||
(printf "\e[2K\r~a~a~a" left bar name-display)
|
||||
(flush-output))
|
||||
(define (report-progress-loop)
|
||||
(sleep update-sleep)
|
||||
(report-progress)
|
||||
(report-progress-loop))
|
||||
(define t (thread report-progress-loop))
|
||||
(define (quit)
|
||||
(kill-thread t)
|
||||
(report-progress)
|
||||
(displayln ""))
|
||||
quit)
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; Page text extractor
|
||||
;; ***************************************************************************************************
|
||||
|
||||
(define (class-has? attributes substrs)
|
||||
(define cl (or (get-attribute 'class attributes) ""))
|
||||
(ormap (λ (substr) (string-contains? cl substr)) substrs))
|
||||
|
||||
(define (updater element element-type attributes children)
|
||||
(cond
|
||||
[(class-has? attributes '("collapsed" "selflink" "label" "toc" "editsection" "reviews"))
|
||||
(list 'div '() '())]
|
||||
[#t
|
||||
(list element-type attributes children)]))
|
||||
|
||||
(define (writer tables-mode? page)
|
||||
(define (writer-inner page)
|
||||
(for ([bit page])
|
||||
(cond
|
||||
[(and tables-mode? (pair? bit) (memq (car bit) '(h1 h2 h3 p blockquote q))) (void)]
|
||||
[(and (not tables-mode?) (pair? bit) (memq (car bit) '(ul ol dl table))) (void)]
|
||||
[(memq bit '(div p li td dd dt br)) (displayln "")]
|
||||
[(symbol? bit) (void)]
|
||||
[(and (pair? bit) (eq? (car bit) '*COMMENT*)) (void)]
|
||||
[(and (pair? bit) (eq? (car bit) '@)) (void)]
|
||||
[(pair? bit) (writer-inner bit)]
|
||||
[(string? bit) (display bit)])))
|
||||
(writer-inner page))
|
||||
|
||||
(define (write-and-post-process tables-mode? page)
|
||||
(define text (with-output-to-string (λ () (writer tables-mode? page))))
|
||||
;; (define text-no-numbers (regexp-replace* #px"(?:-|[+$£€¥] *)?[0-9,.]{2,}%?\\s*" text ""))
|
||||
(define shrink-text (regexp-replace* #px"([ \t]*\r?\n+)+" text "\n"))
|
||||
shrink-text)
|
||||
|
||||
(define ((extract f)) ; f - filename
|
||||
(with-handlers
|
||||
([exn:fail? (λ (err) (printf "extract: ~a: ~v~n" f err))])
|
||||
(define j
|
||||
(case (path-get-extension f)
|
||||
[(#".json")
|
||||
(with-input-from-file f (λ () (read-json)))]
|
||||
[(#".gz")
|
||||
(define-values (in out) (make-pipe))
|
||||
(with-input-from-file f (λ () (gunzip-through-ports (current-input-port) out)))
|
||||
(read-json in)]
|
||||
[else #f]))
|
||||
(define title (json-pointer-value "/parse/title" j))
|
||||
(define pageid (json-pointer-value "/parse/pageid" j))
|
||||
(define page-html (preprocess-html-wiki (json-pointer-value "/parse/text" j)))
|
||||
(define page (update-tree updater (html->xexp page-html)))
|
||||
(define body (write-and-post-process #f page))
|
||||
(define table (write-and-post-process #t page))
|
||||
(list title body table pageid)))
|
||||
|
||||
;; ***************************************************************************************************
|
||||
;; Program, loop, Solr APIs
|
||||
;; ***************************************************************************************************
|
||||
|
||||
(program
|
||||
(start [wikiname "wikiname to download"])
|
||||
|
||||
(define results
|
||||
(for/list ([f (directory-list (build-path storage-path wikiname) #:build? #t)]
|
||||
#:when (member (path-get-extension f) '(#".gz")))
|
||||
(extract f)))
|
||||
|
||||
(define data
|
||||
(cond
|
||||
[(and (read-from-cache?) (file-exists? "cache.rkt"))
|
||||
(displayln "Reading in...")
|
||||
(with-input-from-file "cache.rkt" (λ () (read)))]
|
||||
[else
|
||||
(define x (box (progress^ 0 1 "...")))
|
||||
(define quit (make-progress (λ () (unbox x))))
|
||||
(define data
|
||||
(for/list ([fut results]
|
||||
[i (in-naturals 1)]
|
||||
#:do [(define page (fut))]
|
||||
#:when (not (void? page)))
|
||||
(match-define (list title body table pageid) page)
|
||||
(define len (string-length body))
|
||||
(set-box! x (progress^ i (length results) title))
|
||||
`#hasheq((id . ,(number->string pageid))
|
||||
(title . ,title)
|
||||
(body . ,body)
|
||||
(table . ,table)
|
||||
(len . ,len))))
|
||||
(quit)
|
||||
|
||||
(display "Writing out... ")
|
||||
(flush-output)
|
||||
(with-output-to-file "cache.rkt" (λ () (write data)) #:exists 'truncate/replace)
|
||||
data]))
|
||||
|
||||
(display "Converting... ")
|
||||
(flush-output)
|
||||
(define ser (jsexpr->bytes data))
|
||||
(define ser-port (open-input-bytes ser))
|
||||
(define quit (make-progress (λ () (progress^ (ceiling (/ (file-position ser-port) 64 1024))
|
||||
(ceiling (/ (bytes-length ser) 64 1024))
|
||||
"Posting..."))
|
||||
2))
|
||||
(define res
|
||||
(post (format "http://localhost:8983/solr/~a/update?commit=true" wikiname)
|
||||
#:data ser-port
|
||||
#:headers '#hasheq((Content-Type . "application/json"))
|
||||
#:timeouts (make-timeout-config #:lease 5 #:connect 5 #:request 300)))
|
||||
(quit)
|
||||
(displayln (response-status-line res)))
|
||||
|
||||
(run start)
|
||||
|
|
|
|||
Loading…
Reference in New Issue