breezewiki/archiver/fts.rkt

203 lines
7.8 KiB
Racket
Raw Normal View History

#lang racket
2023-11-10 04:09:18 +00:00
(require racket/function
racket/future
racket/match
racket/path
racket/promise
racket/port
racket/string
file/gunzip
db
db/unsafe/sqlite3
net/http-easy
2023-11-10 04:09:18 +00:00
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)])))]))
2023-11-10 04:09:18 +00:00
(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")
2023-11-10 04:09:18 +00:00
(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))
2023-11-10 04:09:18 +00:00
(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)))
2023-11-10 04:09:18 +00:00
(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))
2023-11-10 04:09:18 +00:00
(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)))
2023-11-10 04:09:18 +00:00
(disconnect slc)