markdown: Support ordered lists that start past 1

This is needed by “ADTs in Typed Racket with macros”.

Author: lexi-lambda

blog/build.rkt

@@ -51,7 +51,7 @@
                        "2015-08-30-managing-application-configuration-with-envy.md"
                        "2015-09-23-canonical-factories-for-testing-with-factory-girl-api.md"
                        "2015-11-06-functionally-updating-record-types-in-elm.md"
-                       #;"2015-12-21-adts-in-typed-racket-with-macros.md" ; <ol start="5">
+                       "2015-12-21-adts-in-typed-racket-with-macros.md"
                        "2016-02-18-simple-safe-multimethods-in-racket.md"
                        "2016-06-03-four-months-with-haskell.md"
                        "2016-08-11-climbing-the-infinite-ladder-of-abstraction.md"

blog/build/render/page.rkt

@@ -17,8 +17,8 @@
           [page (->* [#:title string? #:body xexpr/c] [#:tag (or/c string? #f)] xexpr/c)]
           [post-page (-> rendered-post? xexpr/c)]
           [index-page-title (->* [] [#:tag (or/c string? #f)] string?)]
-          [index-page (->i ([total-pages (and/c exact-integer? (>=/c 1))]
-                            [page-number (total-pages) (and/c exact-integer? (>=/c 1) (<=/c total-pages))]
+          [index-page (->i ([total-pages exact-positive-integer?]
+                            [page-number (total-pages) (and/c exact-positive-integer? (<=/c total-pages))]
                             [posts (listof rendered-post?)])
                            (#:tag [tag (or/c string? #f)])
                            [result xexpr/c])]))

blog/markdown/parse.rkt

@@ -26,7 +26,8 @@
           (struct paragraph ([content content?]))
           (struct code-block ([content content?] [language (or/c #f string?)]))
           (struct unordered-list ([blockss (listof (listof block?))]))
-          (struct ordered-list ([blockss (listof (listof block?))]))
+          (struct ordered-list ([start exact-positive-integer?]
+                                [blockss (listof (listof block?))]))
           (struct blockquote ([blocks (listof block?)]))
           (struct html-block ([xexpr xexpr/c]))
 
@@ -39,7 +40,7 @@
 (struct paragraph (content) #:transparent)
 (struct code-block (content language) #:transparent)
 (struct unordered-list (blockss) #:transparent)
-(struct ordered-list (blockss) #:transparent)
+(struct ordered-list (start blockss) #:transparent)
 (struct blockquote (blocks) #:transparent)
 (struct html-block (xexpr) #:transparent)
 (define-values [horizontal-rule horizontal-rule?]
@@ -62,8 +63,8 @@
 (define (spaces/p n) (repeat/p n (char/p #\space)))
 (define maybe-indent/p (map/p length (many/p (char/p #\space))))
 
-(define unordered-list-bullet/p (or/p (string/p "* ") (string/p "- ")))
-(define ordered-list-bullet/p (do integer/p (string/p ". ")))
+(define unordered-list-bullet/p (do (or/p (string/p "* ") (string/p "- ")) (pure #f)))
+(define ordered-list-bullet/p (do [n <- integer/p] (string/p ". ") (pure n)))
 
 ;; -----------------------------------------------------------------------------
 
@@ -125,7 +126,7 @@ As it parses the indentation for each block, it transfers it from the
 `out-blocks` stack to the `in-blocks` stack, morally “entering” the block. |#
 
 ; see Note [Open blocks]
-(struct open-list (type indent blockss) #:transparent)
+(struct open-list (start indent blockss) #:transparent)
 (struct list-element (indent blocks) #:transparent)
 (struct footnote (name blocks) #:transparent)
 
@@ -137,10 +138,10 @@ As it parses the indentation for each block, it transfers it from the
 
 (define (close-block block)
   (match block
-    [(open-list 'unordered _ blockss) (unordered-list blockss)]
-    [(open-list 'ordered _ blockss)   (ordered-list blockss)]
-    [(paragraph content)              (paragraph (simplify-content content))]
-    [_                                block]))
+    [(open-list #f _ blockss)    (unordered-list blockss)]
+    [(open-list start _ blockss) (ordered-list start blockss)]
+    [(paragraph content)         (paragraph (simplify-content content))]
+    [_                           block]))
 
 ; Closes a sequence of open blocks. Returns two values:
 ;   1. a list of (closed) blocks
@@ -158,11 +159,11 @@ As it parses the indentation for each block, it transfers it from the
 
 (define (add-blocks open-block new-blocks)
   (match open-block
-    [(document blocks targets notes) (document (append blocks new-blocks) targets notes)]
-    [(open-list type indent blockss) (open-list type indent (append blockss (map list-element-blocks new-blocks)))]
-    [(list-element indent blocks)    (list-element indent (append blocks new-blocks))]
-    [(blockquote blocks)             (blockquote (append blocks new-blocks))]
-    [(footnote name blocks)          (footnote name (append blocks new-blocks))]))
+    [(document blocks targets notes)  (document (append blocks new-blocks) targets notes)]
+    [(open-list start indent blockss) (open-list start indent (append blockss (map list-element-blocks new-blocks)))]
+    [(list-element indent blocks)     (list-element indent (append blocks new-blocks))]
+    [(blockquote blocks)              (blockquote (append blocks new-blocks))]
+    [(footnote name blocks)           (footnote name (append blocks new-blocks))]))
 
 (define (add-footnotes doc new-notes)
   (define notes (append (document-footnotes doc) new-notes))
@@ -261,10 +262,10 @@ As it parses the indentation for each block, it transfers it from the
 
     ; If we’re in a list (but not a list element), parse a new list element.
     ; See Note [Unconditionally parse list elements] for why we don’t have to handle anything else.
-    [(open-list 'unordered _ _)
+    [(open-list #f _ _)
      (do unordered-list-bullet/p
          (scan-block-content (list-element 2 '()) (cons inner-block in-blocks)))]
-    [(open-list 'ordered _ _)
+    [(open-list _ _ _)
      (do [bullet <- (syntax-box/p ordered-list-bullet/p)]
          (scan-block-content (list-element (srcloc-span (syntax-box-srcloc bullet)) '())
                              (cons inner-block in-blocks)))]
@@ -306,8 +307,8 @@ As it parses the indentation for each block, it transfers it from the
             (scan-line-start (reverse (list* (code-block "" language) inner-block in-blocks))))
 
         ; lists
-        (scan-list-start (cons inner-block in-blocks) 'unordered unordered-list-bullet/p)
-        (scan-list-start (cons inner-block in-blocks) 'ordered ordered-list-bullet/p)
+        (scan-list-start (cons inner-block in-blocks) unordered-list-bullet/p)
+        (scan-list-start (cons inner-block in-blocks) ordered-list-bullet/p)
 
         ; html blocks
         (do (lookahead/p (or/p (try/p (string/p "<div"))
@@ -334,11 +335,12 @@ As it parses the indentation for each block, it transfers it from the
       (many/p (char/p #\space))
       (scan-block-content (footnote name '()) in-blocks)))
 
-(define (scan-list-start in-blocks type start-p)
-  (do [indent <- (try/p (do [indent <- maybe-indent/p]
-                            (lookahead/p start-p)
-                            (pure indent)))]
-      (scan-block-content (open-list type indent '()) in-blocks)))
+(define (scan-list-start in-blocks start-p)
+  (do [(list indent start)
+       <- (try/p (do [indent <- maybe-indent/p]
+                     [start <- (lookahead/p start-p)]
+                     (pure (list indent start))))]
+      (scan-block-content (open-list start indent '()) in-blocks)))
 
 #| Note [Unconditionally parse list elements]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

blog/markdown/to-scribble.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require racket/contract
+         racket/format
          racket/list
          racket/match
          scribble/base
@@ -89,8 +90,10 @@
          (code-block content))]
     [(md:unordered-list md-blockss)
      (itemization plain (map blocks->blocks md-blockss))]
-    [(md:ordered-list md-blockss)
-     (itemization (style 'ordered '()) (map blocks->blocks md-blockss))]
+    [(md:ordered-list start md-blockss)
+     (define props (if (= start 1) '()
+                       (list (attributes (list (cons 'start (~a start)))))))
+     (itemization (style 'ordered props) (map blocks->blocks md-blockss))]
     [(md:blockquote md-blocks)
      (nested-flow (style 'nested '()) (blocks->blocks md-blocks))]
     [(? md:horizontal-rule?)

blog/paths.rkt

@@ -14,7 +14,7 @@
           [posts-dir path?]
 
           [site-path? predicate/c]
-          [index-path (->* [] [(and/c exact-integer? (>=/c 1))
+          [index-path (->* [] [exact-positive-integer?
                                #:tag (or/c string? #f)
                                #:file? any/c]
                            site-path?)]

blog/posts/2015-12-21-adts-in-typed-racket-with-macros.md

@@ -41,7 +41,7 @@ data Tree a = Empty
 
 With this in mind, we can add a fifth and final point to our list:
 
-  <ol start="5"><li>ADTs must be able to be parametrically polymorphic.</li></ol>
+  5. ADTs must be able to be parametrically polymorphic.
 
 That covers all of our requirements for basic ADTs. Now we're ready to port this idea to Racket.