<commit_before>
#lang scheme/base

(require "decode.ss"
         "struct.ss"
         "config.ss"
         mzlib/list
         mzlib/class
         setup/main-collects
         syntax/modresolve
         (for-syntax scheme/base))

(provide title
         section
         subsection
         subsubsection
         subsubsub*section
         include-section)

(define (gen-tag content)
  (regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_"))

(define (prefix->string p)
  (and p (if (string? p) p (module-path-prefix->string p))))

(define (convert-tag tag content)
  (if (list? tag)
    (apply append (map (lambda (t) (convert-tag t content)) tag))
    `((part ,(or tag (gen-tag content))))))

(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
               #:version [version #f] . str)
  (let ([content (decode-content str)])
    (make-title-decl (prefix->string prefix)
                     (convert-tag tag content)
                     version
                     style
                     content)))

(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
                 . str)
  (let ([content (decode-content str)])
    (make-part-start 0 (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
                    . str)
  (let ([content (decode-content str)])
    (make-part-start 1
                     (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f]
                       #:style [style #f] . str)
  (let ([content (decode-content str)])
    (make-part-start 2
                     (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsubsub*section #:tag [tag #f] . str)
  (let ([content (decode-content str)])
    (make-paragraph (list (make-element 'bold content)))))

(define-syntax (include-section stx)
  (syntax-case stx ()
    [(_ mod)
     (with-syntax ([mod (syntax-local-introduce #'mod)])
       #'(begin
           (require (only-in mod doc))
           doc))]))

;; ----------------------------------------

(provide module-path-prefix->string)

(define (module-path-prefix->string p)
  (format "~a" (path->main-collects-relative
                (resolve-module-path p #f))))

;; ----------------------------------------

(provide itemize item item?)

(define (itemize #:style [style #f] . items)
  (let ([items (filter (lambda (v) (not (whitespace? v))) items)])
    (for ([v items])
      (unless (an-item? v)
        (error 'itemize "expected an item, found something else: ~e" v)))
    (let ([flows (map an-item-flow items)])
      (if style
          (make-styled-itemization flows style)
          (make-itemization flows)))))

(define-struct an-item (flow))
(define (item? x) (an-item? x))

(define (item . str)
  (make-an-item (decode-flow str)))

;; ----------------------------------------

(provide hspace
         elem aux-elem
         italic bold
         tt span-class
         subscript superscript)

(define hspace-cache (make-vector 100 #f))

(define (hspace n)
  (if (n . < . (vector-length hspace-cache))
      (or (vector-ref hspace-cache n)
          (let ([h (make-element 'hspace (list (make-string n #\space)))])
            (vector-set! hspace-cache n h)
            h))
      (make-element 'hspace (list (make-string n #\space)))))

(define (elem . str)
  (make-element #f (decode-content str)))

(define (aux-elem . s)
  (make-aux-element #f (decode-content s)))

(define (italic . str)
  (make-element 'italic (decode-content str)))

(define (bold . str)
  (make-element 'bold (decode-content str)))

(define (tt . str)
  (let* ([l (decode-content str)]
         [l (let ([m (and (pair? l)
                          (string? (car l))
                          (regexp-match-positions #rx"^ +" (car l)))])
              (if m
                (list* (hspace (- (cdar m) (caar m)))
                       (substring (car l) (cdar m))
                       (cdr l))
                l))])
    (if (andmap string? l)
      (make-element 'tt l)
      (make-element #f (map (lambda (s)
                              (if (or (string? s) (symbol? s))
                                (make-element 'tt (list s))
                                s))
                            l)))))

(define (span-class classname . str)
  (make-element classname (decode-content str)))

(define (subscript . str)
  (make-element 'subscript (decode-content str)))

(define (superscript . str)
  (make-element 'superscript (decode-content str)))

;; ----------------------------------------

(provide section-index index index* as-index index-section index-flow-elements)

(define (section-index . elems)
  (make-part-index-decl (map element->string elems) elems))

(define (record-index word-seq element-seq tag content)
  (make-index-element #f
                      (list (make-target-element #f content `(idx ,tag)))
                      `(idx ,tag)
                      word-seq
                      element-seq
                      #f))

(define (index* word-seq content-seq . s)
  (let ([key (make-generated-tag)])
    (record-index word-seq content-seq key (decode-content s))))

(define (index word-seq . s)
  (let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
    (apply index* word-seq word-seq s)))

(define (as-index . s)
  (let ([key (make-generated-tag)]
        [content (decode-content s)])
    (record-index (list (content->string content))
                  (if (= 1 (length content))
                      content
                      (list (make-element #f content)))
                  key
                  content)))

(define (index-section #:title [title "Index"] #:tag [tag #f])
  (make-unnumbered-part #f
                        `((part ,(or tag "doc-index")))
                        (list title)
                        'index
                        null
                        (make-flow (index-flow-elements))
                        null))

(define (index-flow-elements)
  (define (commas l)
    (if (or (null? l) (null? (cdr l)))
      l
      (cdr (apply append (map (lambda (i) (list ", " i)) l)))))
  (define (cadr-string-lists<? a b)
    (let loop ([a (cadr a)] [b (cadr b)])
      (cond [(null? b) #f]
            [(null? a) #t]
            [(string-ci=? (car a) (car b))
             (or (loop (cdr a) (cdr b))
                 ;; Try string<? so "Foo" still precedes "foo"
                 (string<? (car a) (car b)))]
            [else (string-ci<? (car a) (car b))])))
  (define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  (define (rows . rows)
    (make-table 'index (map (lambda (row)
                              (list (make-flow (list (make-paragraph row)))))
                            rows)))
  (define line-break (make-element 'newline '("/n")))
  (define contents
    (lambda (renderer sec ri)
      (define l null)
      (define alpha-starts (make-hash-table))
      (hash-table-for-each
       (let ([parent (collected-info-parent (part-collected-info sec ri))])
         (if parent
           (collected-info-info (part-collected-info parent ri))
           (collect-info-ext-ht (resolve-info-ci ri))))
       (lambda (k v)
         (when (and (pair? k) (eq? 'index-entry (car k)))
           (set! l (cons (cons (cadr k) v) l)))))
      (set! l (sort l cadr-string-lists<?))
      (rows
       (let loop ([i l] [alpha alpha])
         (define (add-letter let l)
           (list* (make-element "nonavigation" (list (string let))) " " l))
         (cond [(null? alpha) null]
               [(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]<commit_msg>newline<commit_after>
#lang scheme/base

(require "decode.ss"
         "struct.ss"
         "config.ss"
         mzlib/list
         mzlib/class
         setup/main-collects
         syntax/modresolve
         (for-syntax scheme/base))

(provide title
         section
         subsection
         subsubsection
         subsubsub*section
         include-section)

(define (gen-tag content)
  (regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_"))

(define (prefix->string p)
  (and p (if (string? p) p (module-path-prefix->string p))))

(define (convert-tag tag content)
  (if (list? tag)
    (apply append (map (lambda (t) (convert-tag t content)) tag))
    `((part ,(or tag (gen-tag content))))))

(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
               #:version [version #f] . str)
  (let ([content (decode-content str)])
    (make-title-decl (prefix->string prefix)
                     (convert-tag tag content)
                     version
                     style
                     content)))

(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
                 . str)
  (let ([content (decode-content str)])
    (make-part-start 0 (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
                    . str)
  (let ([content (decode-content str)])
    (make-part-start 1
                     (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f]
                       #:style [style #f] . str)
  (let ([content (decode-content str)])
    (make-part-start 2
                     (prefix->string prefix)
                     (convert-tag tag content)
                     style
                     content)))

(define (subsubsub*section #:tag [tag #f] . str)
  (let ([content (decode-content str)])
    (make-paragraph (list (make-element 'bold content)))))

(define-syntax (include-section stx)
  (syntax-case stx ()
    [(_ mod)
     (with-syntax ([mod (syntax-local-introduce #'mod)])
       #'(begin
           (require (only-in mod doc))
           doc))]))

;; ----------------------------------------

(provide module-path-prefix->string)

(define (module-path-prefix->string p)
  (format "~a" (path->main-collects-relative
                (resolve-module-path p #f))))

;; ----------------------------------------

(provide itemize item item?)

(define (itemize #:style [style #f] . items)
  (let ([items (filter (lambda (v) (not (whitespace? v))) items)])
    (for ([v items])
      (unless (an-item? v)
        (error 'itemize "expected an item, found something else: ~e" v)))
    (let ([flows (map an-item-flow items)])
      (if style
          (make-styled-itemization flows style)
          (make-itemization flows)))))

(define-struct an-item (flow))
(define (item? x) (an-item? x))

(define (item . str)
  (make-an-item (decode-flow str)))

;; ----------------------------------------

(provide hspace
         elem aux-elem
         italic bold
         tt span-class
         subscript superscript)

(define hspace-cache (make-vector 100 #f))

(define (hspace n)
  (if (n . < . (vector-length hspace-cache))
      (or (vector-ref hspace-cache n)
          (let ([h (make-element 'hspace (list (make-string n #\space)))])
            (vector-set! hspace-cache n h)
            h))
      (make-element 'hspace (list (make-string n #\space)))))

(define (elem . str)
  (make-element #f (decode-content str)))

(define (aux-elem . s)
  (make-aux-element #f (decode-content s)))

(define (italic . str)
  (make-element 'italic (decode-content str)))

(define (bold . str)
  (make-element 'bold (decode-content str)))

(define (tt . str)
  (let* ([l (decode-content str)]
         [l (let ([m (and (pair? l)
                          (string? (car l))
                          (regexp-match-positions #rx"^ +" (car l)))])
              (if m
                (list* (hspace (- (cdar m) (caar m)))
                       (substring (car l) (cdar m))
                       (cdr l))
                l))])
    (if (andmap string? l)
      (make-element 'tt l)
      (make-element #f (map (lambda (s)
                              (if (or (string? s) (symbol? s))
                                (make-element 'tt (list s))
                                s))
                            l)))))

(define (span-class classname . str)
  (make-element classname (decode-content str)))

(define (subscript . str)
  (make-element 'subscript (decode-content str)))

(define (superscript . str)
  (make-element 'superscript (decode-content str)))

;; ----------------------------------------

(provide section-index index index* as-index index-section index-flow-elements)

(define (section-index . elems)
  (make-part-index-decl (map element->string elems) elems))

(define (record-index word-seq element-seq tag content)
  (make-index-element #f
                      (list (make-target-element #f content `(idx ,tag)))
                      `(idx ,tag)
                      word-seq
                      element-seq
                      #f))

(define (index* word-seq content-seq . s)
  (let ([key (make-generated-tag)])
    (record-index word-seq content-seq key (decode-content s))))

(define (index word-seq . s)
  (let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
    (apply index* word-seq word-seq s)))

(define (as-index . s)
  (let ([key (make-generated-tag)]
        [content (decode-content s)])
    (record-index (list (content->string content))
                  (if (= 1 (length content))
                      content
                      (list (make-element #f content)))
                  key
                  content)))

(define (index-section #:title [title "Index"] #:tag [tag #f])
  (make-unnumbered-part #f
                        `((part ,(or tag "doc-index")))
                        (list title)
                        'index
                        null
                        (make-flow (index-flow-elements))
                        null))

(define (index-flow-elements)
  (define (commas l)
    (if (or (null? l) (null? (cdr l)))
      l
      (cdr (apply append (map (lambda (i) (list ", " i)) l)))))
  (define (cadr-string-lists<? a b)
    (let loop ([a (cadr a)] [b (cadr b)])
      (cond [(null? b) #f]
            [(null? a) #t]
            [(string-ci=? (car a) (car b))
             (or (loop (cdr a) (cdr b))
                 ;; Try string<? so "Foo" still precedes "foo"
                 (string<? (car a) (car b)))]
            [else (string-ci<? (car a) (car b))])))
  (define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  (define (rows . rows)
    (make-table 'index (map (lambda (row)
                              (list (make-flow (list (make-paragraph row)))))
                            rows)))
  (define line-break (make-element 'newline '("\n")))
  (define contents
    (lambda (renderer sec ri)
      (define l null)
      (define alpha-starts (make-hash-table))
      (hash-table-for-each
       (let ([parent (collected-info-parent (part-collected-info sec ri))])
         (if parent
           (collected-info-info (part-collected-info parent ri))
           (collect-info-ext-ht (resolve-info-ci ri))))
       (lambda (k v)
         (when (and (pair? k) (eq? 'index-entry (car k)))
           (set! l (cons (cons (cadr k) v) l)))))
      (set! l (sort l cadr-string-lists<?))
      (rows
       (let loop ([i l] [alpha alpha])
         (define (add-letter let l)
           (list* (make-element "nonavigation" (list (string let))) " " l))
         (cond [(null? alpha) null]
               [(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
{'fraction_non_alphanumeric': 0.1733972741039879, 'fraction_numerical': 0.0011357900050479556, 'mean_word_length': 1.6967840735068913, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5029868', 'n_tokens_mistral': 5010, 'n_tokens_neox': 4837, 'n_words': 1411}