<commit_before>#lang scheme/base

(require "getinfo.rkt"
         "dirs.rkt"
         "path-to-relative.rkt"
         "private/path-utils.rkt"
         "main-collects.rkt"
         "main-doc.rkt"
         "parallel-do.rkt"
         "doc-db.rkt"
         scheme/class
         scheme/list
         scheme/file
         scheme/fasl
         scheme/match
         scheme/serialize
         compiler/cm
         scribble/base-render
         scribble/core
         scribble/html-properties
         scribble/manual ; really shouldn't be here... see dynamic-require-doc
         scribble/private/run-pdflatex
         setup/xref
         scribble/xref
         unstable/file
         racket/place
         (prefix-in html: scribble/html-render)
         (prefix-in latex: scribble/latex-render)
         (prefix-in contract: scribble/contract-render))

(provide setup-scribblings
         verbose
         run-pdflatex)

(define verbose (make-parameter #t))

(define-logger setup)

(define-serializable-struct doc (src-dir src-spec src-file dest-dir flags under-main? category out-count)
  #:transparent)
(define-serializable-struct info (doc       ; doc structure above
                                  undef     ; unresolved requires
                                  searches 
                                  deps 
                                  known-deps
                                  build? time out-time need-run?
                                  need-in-write? need-out-write?
                                  vers rendered? failed?)
  #:transparent
  #:mutable)

(define (main-doc? doc)
  (pair? (path->main-doc-relative (doc-dest-dir doc))))

(define (filter-user-docs docs make-user?)
  (cond ;; Specifically disabled user stuff, filter
   [(not make-user?) (filter main-doc? docs)]
   ;; If we've built user-specific before, keep building
   [(file-exists? (build-path (find-user-doc-dir) "index.html")) docs]
   ;; Otherwise, see if we need it:
   [(ormap (lambda (doc)
             (not (or (doc-under-main? doc)
                      (memq 'no-depend-on (doc-flags doc)))))
           docs)
    docs]
   [else (filter main-doc? docs)])) ; Don't need them, so drop them

(define (parallel-do-error-handler setup-printf doc errmsg outstr errstr)
  (setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
  (eprintf errstr))

;; We use a lock to control writing to the database, because
;; the database or binding doesn't seem to deal well with concurrent
;; writers within a process.
(define no-lock void)
(define (lock-via-channel lock-ch)
  (let ([saved-ch #f])
    (lambda (mode)
      (case mode
        [(lock)
         (define ch (sync lock-ch))
         (place-channel-put ch 'lock)
         (set! saved-ch ch)]
        [(unlock)
         (place-channel-put saved-ch 'done)
         (set! saved-ch #f)]))))
(define lock-ch #f)
(define lock-ch-in #f)
(define (init-lock-ch!)
  (unless lock-ch
    (set!-values (lock-ch lock-ch-in) (place-channel))
    (thread (lambda ()
              (define-values (ch ch-in) (place-channel))
              (let loop ()
                (place-channel-put lock-ch-in ch)
                (place-channel-get ch-in)
                (place-channel-get ch-in)
                (loop))))))
(define (call-with-lock lock thunk)
  (lock 'lock)
  (dynamic-wind
   void
   thunk
   (lambda () (lock 'unlock))))

(define (setup-scribblings
         worker-count       ; number of cores to use to create documentation
         program-name       ; name of program that calls setup-scribblings
         only-dirs          ; limits doc builds
         latex-dest         ; if not #f, generate Latex output
         auto-start-doc?    ; if #t, expands `only-dir' with [user-]start to
                                        ;  catch new docs
         make-user?         ; are we making user stuff?
         with-record-error  ; catch & record exceptions
         setup-printf)
  (unless (doc-db-available?)
    (error 'setup "install SQLite to build documentation"))<commit_msg>fix `raco setup -j' for a non-places build<commit_after>#lang scheme/base

(require "getinfo.rkt"
         "dirs.rkt"
         "path-to-relative.rkt"
         "private/path-utils.rkt"
         "main-collects.rkt"
         "main-doc.rkt"
         "parallel-do.rkt"
         "doc-db.rkt"
         scheme/class
         scheme/list
         scheme/file
         scheme/fasl
         scheme/match
         scheme/serialize
         compiler/cm
         scribble/base-render
         scribble/core
         scribble/html-properties
         scribble/manual ; really shouldn't be here... see dynamic-require-doc
         scribble/private/run-pdflatex
         setup/xref
         scribble/xref
         unstable/file
         racket/place
         (prefix-in html: scribble/html-render)
         (prefix-in latex: scribble/latex-render)
         (prefix-in contract: scribble/contract-render))

(provide setup-scribblings
         verbose
         run-pdflatex)

(define verbose (make-parameter #t))

(define-logger setup)

(define-serializable-struct doc (src-dir src-spec src-file dest-dir flags under-main? category out-count)
  #:transparent)
(define-serializable-struct info (doc       ; doc structure above
                                  undef     ; unresolved requires
                                  searches 
                                  deps 
                                  known-deps
                                  build? time out-time need-run?
                                  need-in-write? need-out-write?
                                  vers rendered? failed?)
  #:transparent
  #:mutable)

(define (main-doc? doc)
  (pair? (path->main-doc-relative (doc-dest-dir doc))))

(define (filter-user-docs docs make-user?)
  (cond ;; Specifically disabled user stuff, filter
   [(not make-user?) (filter main-doc? docs)]
   ;; If we've built user-specific before, keep building
   [(file-exists? (build-path (find-user-doc-dir) "index.html")) docs]
   ;; Otherwise, see if we need it:
   [(ormap (lambda (doc)
             (not (or (doc-under-main? doc)
                      (memq 'no-depend-on (doc-flags doc)))))
           docs)
    docs]
   [else (filter main-doc? docs)])) ; Don't need them, so drop them

(define (parallel-do-error-handler setup-printf doc errmsg outstr errstr)
  (setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
  (eprintf errstr))

;; We use a lock to control writing to the database. It's not
;; strictly necessary, but place channels can deal with blocking
;; more efficiently than the database connection.
(define no-lock void)
(define (lock-via-channel lock-ch)
  (if lock-ch
      (let ([saved-ch #f])
        (lambda (mode)
          (case mode
            [(lock)
             (define ch (sync lock-ch))
             (place-channel-put ch 'lock)
             (set! saved-ch ch)]
            [(unlock)
             (place-channel-put saved-ch 'done)
             (set! saved-ch #f)])))
      void))
(define lock-ch #f)
(define lock-ch-in #f)
(define (init-lock-ch!)
  (unless lock-ch
    ;; If places are not available, then tasks will be run
    ;; in separate OS processes, and we can do without an
    ;; extra lock.
    (when (place-enabled?)
      (set!-values (lock-ch lock-ch-in) (place-channel))
      (thread (lambda ()
                (define-values (ch ch-in) (place-channel))
                (let loop ()
                  (place-channel-put lock-ch-in ch)
                  (place-channel-get ch-in)
                  (place-channel-get ch-in)
                  (loop)))))))
(define (call-with-lock lock thunk)
  (lock 'lock)
  (dynamic-wind
   void
   thunk
   (lambda () (lock 'unlock))))

(define (setup-scribblings
         worker-count       ; number of cores to use to create documentation
         program-name       ; name of program that calls setup-scribblings
         only-dirs          ; limits doc builds
         latex-dest         ; if not #f, generate Latex output
         auto-start-doc?    ; if #t, expands `only-dir' with [user-]start to
                                        ;  catch new docs
         make-user?         ; are we making user stuff?
         with-record-error  ; catch & record exceptions
         setup-printf)
  (unless (doc-db-available?)
    (error 'setup "install SQLite to build documentation"))
{'fraction_non_alphanumeric': 0.11394821620331702, 'fraction_numerical': 0.0, 'mean_word_length': 1.7727423089646046, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5366228', 'n_tokens_mistral': 2535, 'n_tokens_neox': 2413, 'n_words': 680}