├── .github └── workflows │ ├── build.yml │ └── ci.yml ├── .gitignore ├── LICENSE ├── README.md ├── example~ ├── .gitignore ├── 0000.rkt ├── 0001.rkt ├── 0002.rkt ├── 0003.rkt ├── 0004.rkt ├── 0005.rkt ├── 0006.rkt ├── 0007.rkt ├── 0008.rkt ├── 0009.rkt ├── 000A.rkt ├── 000B.rkt ├── 000C.rkt ├── 000D.rkt ├── 000E.rkt ├── 000F.rkt ├── html-config.rkt ├── index.rkt ├── latex-config.rkt ├── lib │ ├── definition.rkt │ ├── fact.rkt │ ├── notation-index.rkt │ ├── proof.rkt │ ├── proposition.rkt │ ├── remark.rkt │ └── theorem.rkt ├── math.rkt └── someone-2003-0000.rkt ├── info.rkt └── morg ├── article.rkt ├── bibliography.rkt ├── bibliography ├── bib-item.rkt ├── format.rkt └── markup.rkt ├── command.rkt ├── data ├── anchor-table.rkt ├── article.rkt ├── block.rkt ├── date.rkt ├── document.rkt ├── extension.rkt ├── id.rkt ├── index-table.rkt ├── index.rkt ├── inline.rkt ├── node.rkt ├── section.rkt ├── splice.rkt ├── tex.rkt └── tree.rkt ├── eq-reasoning.rkt ├── eq-reasoning ├── html.rkt └── latex.rkt ├── html.rkt ├── html ├── article.rkt ├── block.rkt ├── breadcrumb.rkt ├── class.rkt ├── class │ ├── article.rkt │ ├── block.rkt │ ├── breadcrumb.rkt │ ├── d-pad.rkt │ ├── document-toc.rkt │ ├── document.rkt │ ├── id.rkt │ ├── inline.rkt │ ├── section.rkt │ └── toc.rkt ├── config.rkt ├── convert.rkt ├── d-pad.rkt ├── document-toc.rkt ├── document.rkt ├── id.rkt ├── inline.rkt ├── publish.rkt ├── pure-inline.rkt ├── section.rkt ├── site-state.rkt ├── site.rkt ├── splice.rkt ├── state.rkt ├── toc.rkt └── xexpr-table.rkt ├── info.rkt ├── lang ├── id.rkt └── reader.rkt ├── language.rkt ├── latex.rkt ├── latex ├── article.rkt ├── block.rkt ├── config.rkt ├── convert.rkt ├── document.rkt ├── id.rkt ├── inline.rkt ├── publish.rkt ├── section.rkt ├── splice.rkt └── state.rkt ├── main.rkt ├── markup ├── article.rkt ├── block.rkt ├── date.rkt ├── document.rkt ├── index.rkt ├── inline.rkt ├── section.rkt ├── splice.rkt ├── string.rkt ├── syntax.rkt ├── tex.rkt └── xexpr.rkt ├── math.rkt ├── math ├── config.rkt ├── format.rkt ├── inline.rkt ├── level.rkt ├── markup.rkt ├── tex-plus.rkt └── tex.rkt ├── proof.rkt ├── scribblings └── morg.scrbl ├── text ├── article.rkt ├── block.rkt ├── config.rkt ├── convert.rkt ├── date.rkt ├── document.rkt ├── id.rkt ├── inline.rkt ├── numbering.rkt ├── preview.rkt ├── section.rkt ├── splice.rkt ├── state.rkt └── tex.rkt └── util ├── escape.rkt ├── list.rkt └── option.rkt /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | pull_request: 6 | branches: 7 | - main 8 | 9 | name: Build example document 10 | jobs: 11 | build: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - uses: actions/checkout@v3 15 | - uses: Bogdanp/setup-racket@v1.10 16 | with: 17 | architecture: x64 18 | distribution: full 19 | variant: CS 20 | version: stable 21 | - name: Installing morg and its dependencies 22 | run: raco pkg install --no-docs --auto --name morg 23 | 24 | - name: Set up TeXLive for example document 25 | uses: teatimeguest/setup-texlive-action@v2 26 | with: 27 | # Standard packages 28 | packages: >- 29 | scheme-basic 30 | etoolbox 31 | latexmk 32 | luatex 33 | hyperref 34 | xcolor 35 | tools 36 | marginnote 37 | amsfonts 38 | 39 | - name: Compile example document 40 | run: raco make -v example~/index.rkt example~/html-config.rkt example~/latex-config.rkt 41 | 42 | - name: Build example document 43 | run: raco morg --html-config example~/html-config.rkt --pdf-config example~/latex-config.rkt example~/index.rkt site~ 44 | 45 | - name: Archive artifacts 46 | run: tar -cvf site.tar site~ 47 | 48 | - name: Upload artifacts 49 | uses: actions/upload-artifact@v3 50 | with: 51 | name: example 52 | path: site.tar 53 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | pull_request: 6 | branches: 7 | - main 8 | 9 | name: CI 10 | jobs: 11 | build: 12 | name: "Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})" 13 | runs-on: ubuntu-latest 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | racket-version: ["stable"] 18 | racket-variant: ["BC", "CS"] 19 | steps: 20 | - uses: actions/checkout@v3 21 | - uses: Bogdanp/setup-racket@v1.10 22 | with: 23 | architecture: x64 24 | distribution: full 25 | variant: ${{ matrix.racket-variant }} 26 | version: ${{ matrix.racket-version }} 27 | - name: Installing morg and its dependencies 28 | run: raco pkg install --no-docs --auto --name morg 29 | - name: Compiling morg and building its docs 30 | run: raco setup --check-pkg-deps --unused-pkg-deps morg 31 | - name: Testing morg 32 | run: raco test -x -p morg 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | \#* 2 | .\#* 3 | .DS_Store 4 | compiled/ 5 | doc/ 6 | /site~ 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Taichi Uemura 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MOrg 2 | 3 | *MOrg* is to be a tool for organizing mathematical thoughts. Primary 4 | usage will be: 5 | 6 | 1. Write a bunch of *articles* such as definitions, theorems, 7 | propositions, lemmas, and corollaries some of which may include 8 | proofs of them. 9 | 2. Organize these articles into *sections* and then a *document*. 10 | 3. Convert the document to LaTeX and then PDF. 11 | 4. Generate from the document a website where each article has its 12 | own page. 13 | 14 | All articles have unique and permanent *identifier*. Section and 15 | article numberings may change when the document structure has changed, 16 | but an identifier consistently refers to a particular article. This 17 | system is the same as those of [The Stacks 18 | project](https://stacks.math.columbia.edu/), 19 | [Kerodon](https://kerodon.net/) and [Jon Sterling’s 20 | Forest](https://forest.jonmsterling.com/). 21 | 22 | ## License 23 | 24 | MIT 25 | -------------------------------------------------------------------------------- /example~/.gitignore: -------------------------------------------------------------------------------- 1 | _site 2 | -------------------------------------------------------------------------------- /example~/0000.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{Introduction} 6 | @paragraph{ 7 | This is a @emph{test} document. 8 | See @ref["someone-2003-0000"] for more details. 9 | } 10 | #:subsections @list[ 11 | (include-part "0002.rkt") 12 | (include-part "0001.rkt") 13 | ] 14 | ] 15 | -------------------------------------------------------------------------------- /example~/0001.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{How to read this document} 6 | @paragraph{ 7 | Don't read this document. Probably it is not good to refer to @ref["0005"]. 8 | } 9 | ] 10 | -------------------------------------------------------------------------------- /example~/0002.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{What is this document about} 6 | @paragraph{ 7 | This document is about nothing. 8 | } 9 | ] 10 | -------------------------------------------------------------------------------- /example~/0003.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{Test section} 6 | @paragraph{ 7 | This is a test section. See also @ref["0002"]. 8 | } 9 | (include-part "0004.rkt") 10 | (include-part "0006.rkt") 11 | (include-part "0008.rkt") 12 | (include-part "000F.rkt") 13 | (include-part "0007.rkt") 14 | @paragraph{ 15 | Please visit @href["https://example.com"]{this page}. 16 | Also check out @href["https://example.com"]. 17 | } 18 | (include-part "000B.rkt") 19 | (include-part "000C.rkt") 20 | (include-part "000D.rkt") 21 | ] 22 | -------------------------------------------------------------------------------- /example~/0004.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/theorem.rkt" 4 | "lib/proof.rkt") 5 | 6 | @theorem[ 7 | #:id (current-id) 8 | @paragraph{ 9 | True is true. 10 | } 11 | #:proof @proof[ 12 | @paragraph{ 13 | Left as an exercise. 14 | } 15 | ] 16 | ] 17 | -------------------------------------------------------------------------------- /example~/0005.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{Preface} 6 | @paragraph{ 7 | Some nice text. 8 | } 9 | ] 10 | -------------------------------------------------------------------------------- /example~/0006.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/proposition.rkt" 4 | "lib/proof.rkt") 5 | 6 | @proposition[ 7 | #:id (current-id) 8 | @paragraph{ 9 | It is not true that it is true that it is not true that it is true that it is not true that it is true that false is false. 10 | } 11 | #:proof @proof[ 12 | @paragraph{ 13 | This essntially follows from @ref["0004"]. But we first have to observe that true is in fact false. Then, it follows that false is also false. Our claim is immediate from this. 14 | } 15 | ] 16 | ] 17 | -------------------------------------------------------------------------------- /example~/0007.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "math.rkt" 4 | "lib/fact.rkt") 5 | 6 | @fact[ 7 | #:id (current-id) 8 | @paragraph{ 9 | @math[ 10 | (((@%{1} . + . @%{2}) 11 | . * . 12 | (@%{3} . + . @%{4})) 13 | . = . 14 | @%{3}) 15 | ]. 16 | } 17 | @paragraph{ 18 | @disp{ 19 | @math[ 20 | (((@%{1} . * . @%{2}) 21 | . + . 22 | (@%{3} . * . @%{4})) 23 | . = . 24 | @%{5}) 25 | ]. 26 | } 27 | } 28 | ] 29 | -------------------------------------------------------------------------------- /example~/0008.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/definition.rkt") 4 | 5 | @definition[ 6 | #:id (current-id) 7 | #:indexes @list[ 8 | @index[#:key "thing"]{Thing} 9 | ] 10 | @paragraph{ 11 | A @dfn{thing} consists of the following data. 12 | @unordered-list[ 13 | @list-item{Something} 14 | @list-item{Some other thing} 15 | ] 16 | Moreover, it satisfies the following properties. 17 | @ordered-list[ 18 | @list-item{Some axiom} 19 | @list-item{Another axiom} 20 | ] 21 | } 22 | ] 23 | -------------------------------------------------------------------------------- /example~/0009.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{Bibliography} 6 | (include-part "someone-2003-0000.rkt") 7 | ] 8 | -------------------------------------------------------------------------------- /example~/000A.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @section[ 4 | #:id (current-id) 5 | #:title @%{Index} 6 | @print-index[] 7 | ] 8 | -------------------------------------------------------------------------------- /example~/000B.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/remark.rkt") 4 | 5 | @remark[ 6 | #:id (current-id) 7 | @paragraph{ 8 | Here is a @code{code}. 9 | } 10 | ] 11 | -------------------------------------------------------------------------------- /example~/000C.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/theorem.rkt" 4 | "lib/proof.rkt") 5 | 6 | @theorem[ 7 | #:id (current-id) 8 | #:description @%{ 9 | The greatest theorem in the world. 10 | } 11 | @paragraph{ 12 | The following is equivalent. 13 | @ordered-list[ 14 | @list-item[#:id "0000"]{True.} 15 | @list-item[#:id "0001"]{Not false.} 16 | ] 17 | } 18 | #:proof @proof[ 19 | @paragraph{ 20 | The implication from @anchor-ref[#:anchor "0000" #:node "000C"] to @anchor-ref[#:anchor "0001" #:node "000C"] is easy. 21 | } 22 | ] 23 | ] 24 | -------------------------------------------------------------------------------- /example~/000D.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require morg/eq-reasoning 4 | "lib/proposition.rkt" 5 | "lib/proof.rkt" 6 | "math.rkt") 7 | 8 | @proposition[ 9 | #:id (current-id) 10 | @paragraph{ 11 | @(math ("1" . = . "1")) 12 | } 13 | #:proof @proof[ 14 | @paragraph{ 15 | This is proved as follows. 16 | @disp{ 17 | @eq-reasoning[ 18 | @math{1} 19 | @math{=} "Definition" 20 | @math{1 + 0} 21 | @math{=} "Definition" 22 | @math{1} 23 | ] 24 | } 25 | } 26 | ] 27 | ] 28 | -------------------------------------------------------------------------------- /example~/000E.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/notation-index.rkt") 4 | 5 | @section[ 6 | #:id (current-id) 7 | #:title @%{Notation index} 8 | @print-notation-index[] 9 | ] 10 | -------------------------------------------------------------------------------- /example~/000F.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require "lib/definition.rkt" 4 | "lib/notation-index.rkt" 5 | "math.rkt") 6 | 7 | @definition[ 8 | #:id (current-id) 9 | #:indexes @list[ 10 | @notation-index[#:key "0"]{@(math "0")} 11 | ] 12 | @paragraph{ 13 | We define @(math "0") to be the least natural number. 14 | } 15 | ] 16 | -------------------------------------------------------------------------------- /example~/html-config.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require morg/html 4 | (prefix-in eq: morg/eq-reasoning/html)) 5 | 6 | (provide-config 7 | (compose-config 8 | eq:config-update 9 | (config-set-base-url "http://localhost"))) 10 | -------------------------------------------------------------------------------- /example~/index.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | @document[ 4 | #:id (current-id) 5 | #:title @%{Test document} 6 | #:author @list[@%{Test Author}] 7 | #:description @%{ 8 | A test document. 9 | } 10 | #:contents @%[ 11 | @paragraph{ 12 | Abstract: This is a document. 13 | } 14 | ] 15 | #:front @list[ 16 | (include-part "0005.rkt") 17 | ] 18 | (include-part "0000.rkt") 19 | (include-part "0003.rkt") 20 | #:back @list[ 21 | (include-part "000A.rkt") 22 | (include-part "000E.rkt") 23 | (include-part "0009.rkt") 24 | ] 25 | ] 26 | -------------------------------------------------------------------------------- /example~/latex-config.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require morg/latex 4 | (prefix-in eq: morg/eq-reasoning/latex)) 5 | 6 | (provide-config 7 | (define cfg default-config) 8 | (eq:config-update cfg)) 9 | -------------------------------------------------------------------------------- /example~/lib/definition.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/article) 4 | 5 | (provide definition) 6 | 7 | (define definition @make-article{Definition}) 8 | -------------------------------------------------------------------------------- /example~/lib/fact.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/article) 4 | 5 | (provide fact) 6 | 7 | (define fact @make-article{Fact}) -------------------------------------------------------------------------------- /example~/lib/notation-index.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require morg/markup/index) 4 | 5 | (provide notation-index 6 | print-notation-index) 7 | 8 | (define-values (notation-index print-notation-index) 9 | (make-index)) 10 | -------------------------------------------------------------------------------- /example~/lib/proof.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/proof) 4 | 5 | (provide proof) 6 | 7 | (define proof @make-proof{Proof}) 8 | -------------------------------------------------------------------------------- /example~/lib/proposition.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/article) 4 | 5 | (provide proposition) 6 | 7 | (define proposition @make-article{Proposition}) 8 | -------------------------------------------------------------------------------- /example~/lib/remark.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/article) 4 | 5 | (provide remark) 6 | 7 | (define remark @make-article{Remark}) 8 | -------------------------------------------------------------------------------- /example~/lib/theorem.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/article) 4 | 5 | (provide theorem) 6 | 7 | (define theorem @make-article{Theorem}) 8 | -------------------------------------------------------------------------------- /example~/math.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require morg/math 4 | (prefix-in tex: morg/math/tex)) 5 | 6 | (provide + * = 7 | math) 8 | 9 | (module levels typed/racket 10 | (require morg/math) 11 | (provide (all-defined-out)) 12 | (define-levels 13 | * 14 | + 15 | =)) 16 | 17 | (require (prefix-in l: 'levels)) 18 | 19 | (define + 20 | (monoid #:level l:+ "0" "+")) 21 | 22 | (define * 23 | (monoid #:level l:* "1" tex:times)) 24 | 25 | (define = 26 | (binary #:level l:= "=")) 27 | -------------------------------------------------------------------------------- /example~/someone-2003-0000.rkt: -------------------------------------------------------------------------------- 1 | #lang morg 2 | 3 | (require morg/bibliography) 4 | 5 | @bibliography[ 6 | #:id (current-id) 7 | @book[ 8 | #:author @list[@%{Some One}] 9 | #:title @%{An introduction to something} 10 | #:date (date 2003) 11 | #:publisher @%{Some Publisher} 12 | #:url "https://example.com" 13 | ] 14 | ] 15 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | (define deps '("base" "typed-racket-lib" "typed-racket-more" "at-exp-lib")) 5 | (define build-deps '("scribble-lib" "at-exp-lib" "rackunit-typed")) 6 | (define pkg-desc "Organize your mathematical thoughts.") 7 | (define version "0.0") 8 | (define pkg-authors '("Taichi Uemura")) 9 | (define license '(MIT)) 10 | -------------------------------------------------------------------------------- /morg/article.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "markup/article.rkt") 4 | 5 | (provide make-article) 6 | -------------------------------------------------------------------------------- /morg/bibliography.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "bibliography/markup.rkt" 4 | "bibliography/format.rkt" 5 | "bibliography/bib-item.rkt" 6 | (prefix-in x: "markup/article.rkt") 7 | "markup/inline.rkt" 8 | "markup/block.rkt" 9 | "markup/splice.rkt") 10 | 11 | (provide 12 | bibliography 13 | (rename-out [bibliography/curried make-bibliography]) 14 | (rename-out [eprint% eprint] 15 | [article% article] 16 | [thesis% thesis] 17 | [misc% misc] 18 | [arXiv% arXiv] 19 | [inproceedings% inproceedings] 20 | [inbook% inbook] 21 | [book% book])) 22 | 23 | (define default-header 24 | "Bibliography item") 25 | 26 | (define ((bibliography/curried 27 | . [header : PureInlineLike *]) 28 | #:id [maybe-id : String] 29 | [b : BibItem]) 30 | @x:article%[ 31 | #:id maybe-id 32 | #:header (apply pure-inline% header) 33 | @paragraph%{ 34 | @(format-bib-item b) 35 | } 36 | ]) 37 | 38 | (define (bibliography 39 | #:header [header : PureInlineLike default-header] 40 | #:id [maybe-id : String] 41 | [b : BibItem]) 42 | ((bibliography/curried header) #:id maybe-id b)) 43 | -------------------------------------------------------------------------------- /morg/bibliography/bib-item.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/inline.rkt" 4 | "../data/date.rkt") 5 | 6 | (provide BibItem 7 | EPrintType 8 | (struct-out eprint) EPrint 9 | (struct-out article) Article 10 | (struct-out thesis) Thesis 11 | (struct-out misc) Misc 12 | (struct-out inproceedings) InProceedings 13 | (struct-out inbook) InBook 14 | (struct-out book) Book) 15 | 16 | (define-type BibItem 17 | (U Book 18 | InBook 19 | InProceedings 20 | Thesis 21 | Misc 22 | Article)) 23 | 24 | (define-type EPrintType 25 | (U 'arXiv)) 26 | 27 | (struct eprint 28 | ([type : EPrintType] 29 | [id : String]) 30 | #:transparent 31 | #:type-name EPrint) 32 | 33 | (struct book 34 | ([author : (Listof PureInline)] 35 | [title : PureInline] 36 | [date : Date] 37 | [publisher : (Option PureInline)] 38 | [location : (Option PureInline)] 39 | [doi : (Option String)] 40 | [url : (Option String)] 41 | [eprint : (Option EPrint)]) 42 | #:transparent 43 | #:type-name Book) 44 | 45 | (struct inbook 46 | ([author : (Listof PureInline)] 47 | [title : PureInline] 48 | [booktitle : PureInline] 49 | [date : Date] 50 | [editor : (Option (Listof PureInline))] 51 | [publisher : (Option PureInline)] 52 | [location : (Option PureInline)] 53 | [volume : (Option PureInline)] 54 | [pages : (Option PureInline)] 55 | [doi : (Option String)] 56 | [url : (Option String)] 57 | [eprint : (Option EPrint)]) 58 | #:transparent 59 | #:type-name InBook) 60 | 61 | (struct article 62 | ([author : (Listof PureInline)] 63 | [title : PureInline] 64 | [journal-title : PureInline] 65 | [date : Date] 66 | [volume : PureInline] 67 | [number : (Option PureInline)] 68 | [pages : (Option PureInline)] 69 | [doi : (Option String)] 70 | [url : (Option String)] 71 | [eprint : (Option EPrint)]) 72 | #:transparent 73 | #:type-name Article) 74 | 75 | (struct inproceedings 76 | ([author : (Listof PureInline)] 77 | [title : PureInline] 78 | [book-title : PureInline] 79 | [date : Date] 80 | [editor : (Option (Listof PureInline))] 81 | [publisher : (Option PureInline)] 82 | [location : (Option PureInline)] 83 | [pages : (Option PureInline)] 84 | [doi : (Option String)] 85 | [url : (Option String)] 86 | [eprint : (Option EPrint)]) 87 | #:transparent 88 | #:type-name InProceedings) 89 | 90 | (struct thesis 91 | ([author : (Listof PureInline)] 92 | [title : PureInline] 93 | [type : PureInline] 94 | [institution : PureInline] 95 | [date : Date] 96 | [doi : (Option String)] 97 | [url : (Option String)] 98 | [eprint : (Option EPrint)]) 99 | #:transparent 100 | #:type-name Thesis) 101 | 102 | (struct misc 103 | ([author : (Listof PureInline)] 104 | [title : PureInline] 105 | [date : Date] 106 | [doi : (Option String)] 107 | [url : (Option String)] 108 | [eprint : (Option EPrint)]) 109 | #:transparent 110 | #:type-name Misc) 111 | -------------------------------------------------------------------------------- /morg/bibliography/format.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "bib-item.rkt" 4 | "../data/inline.rkt" 5 | "../data/date.rkt" 6 | "../markup/inline.rkt" 7 | "../markup/splice.rkt" 8 | "../text/date.rkt" 9 | "../util/list.rkt") 10 | 11 | (provide format-bib-item) 12 | 13 | (define (format-bib-item [b : BibItem]) : Inline 14 | (cond 15 | [(book? b) (format-book b)] 16 | [(inbook? b) (format-inbook b)] 17 | [(article? b) (format-article b)] 18 | [(inproceedings? b) (format-inproceedings b)] 19 | [(thesis? b) (format-thesis b)] 20 | [(misc? b) (format-misc b)] 21 | [else (error "Unimplemented.")])) 22 | 23 | (define (format-author [a : (Listof PureInline)]) : Inline 24 | (apply inline% (list-join-1 a " & "))) 25 | 26 | (define (format-url [s : String]) : Inline 27 | @inline%{@href%[s]}) 28 | 29 | (define (format-doi [s : String]) : Inline 30 | (format-url (format "https://doi.org/~a" s))) 31 | 32 | (define (format-eprint [e : EPrint]) : Inline 33 | (define type (eprint-type e)) 34 | (define i (eprint-id e)) 35 | (case type 36 | [(arXiv) (format-url (format "https://arxiv.org/abs/~a" i))] 37 | [else (error "Unimplemented.")])) 38 | 39 | (define (format-online #:doi [doi : (Option String) #f] 40 | #:url [url : (Option String) #f] 41 | #:eprint [ep : (Option EPrint) #f]) : Inline 42 | (define doi-1 : InlineLike 43 | @when%[doi]{ @(format-doi doi)}) 44 | (define url-1 : InlineLike 45 | @when%[url]{ @(format-url url)}) 46 | (define ep-1 : InlineLike 47 | @when%[ep]{ @(format-eprint ep)}) 48 | @inline%{@|doi-1|@|url-1|@|ep-1|}) 49 | 50 | (define (format-book [b : Book]) : Inline 51 | (define author (format-author (book-author b))) 52 | (define title (book-title b)) 53 | (define publisher-1 (book-publisher b)) 54 | (define publisher : InlineLike 55 | @when%[publisher-1]{@|publisher-1|, }) 56 | (define address-1 (book-location b)) 57 | (define address : InlineLike 58 | @when%[address-1]{@|address-1|, }) 59 | (define date (date->text (book-date b))) 60 | (define online 61 | (format-online #:doi (book-doi b) 62 | #:url (book-url b) 63 | #:eprint (book-eprint b))) 64 | @inline%{@|author|. @emph%{@|title|}. @|publisher|@|address|@|date|.@|online|}) 65 | 66 | (define (format-inbook [b : InBook]) : Inline 67 | (define author (format-author (inbook-author b))) 68 | (define title (inbook-title b)) 69 | (define booktitle (inbook-booktitle b)) 70 | (define date (date->text (inbook-date b))) 71 | (define editor-1 (inbook-editor b)) 72 | (define editor : InlineLike 73 | @when%[editor-1]{@(format-author editor-1) Ed. }) 74 | (define volume-1 (inbook-volume b)) 75 | (define volume : InlineLike 76 | @when%[volume-1]{, @|volume-1|}) 77 | (define pages-1 (inbook-pages b)) 78 | (define pages : InlineLike 79 | @when%[pages-1]{, @|pages-1|}) 80 | (define publisher-1 (inbook-publisher b)) 81 | (define publisher : InlineLike 82 | @when%[publisher-1]{@|publisher-1|, }) 83 | (define location-1 (inbook-location b)) 84 | (define location : InlineLike 85 | @when%[location-1]{@|location-1|, }) 86 | (define online 87 | (format-online #:doi (inbook-doi b) 88 | #:url (inbook-url b) 89 | #:eprint (inbook-eprint b))) 90 | @inline%{@|author|. @|title|. In @|editor|@emph{@|booktitle|}@|volume|@|pages|. @|publisher|@|location|@|date|.@|online|}) 91 | 92 | (define (format-inproceedings [b : InProceedings]) : Inline 93 | (define author (format-author (inproceedings-author b))) 94 | (define title (inproceedings-title b)) 95 | (define booktitle (inproceedings-book-title b)) 96 | (define date (date->text (inproceedings-date b))) 97 | (define editor-1 (inproceedings-editor b)) 98 | (define editor : InlineLike 99 | @when%[editor-1]{@(format-author editor-1) Ed. }) 100 | (define pages-1 (inproceedings-pages b)) 101 | (define pages : InlineLike 102 | @when%[pages-1]{, @|pages-1|}) 103 | (define publisher-1 (inproceedings-publisher b)) 104 | (define publisher : InlineLike 105 | @when%[publisher-1]{@|publisher-1|, }) 106 | (define location-1 (inproceedings-location b)) 107 | (define location : InlineLike 108 | @when%[location-1]{@|location-1|, }) 109 | (define online 110 | (format-online #:doi (inproceedings-doi b) 111 | #:url (inproceedings-url b) 112 | #:eprint (inproceedings-eprint b))) 113 | @inline%{@|author|. @|title|. In @|editor|@emph{@|booktitle|}@|pages|. @|publisher|@|location|@|date|.@|online|}) 114 | 115 | (define (format-article [a : Article]) : Inline 116 | (define author (format-author (article-author a))) 117 | (define title (article-title a)) 118 | (define journal-title (article-journal-title a)) 119 | (define volume (article-volume a)) 120 | (define number-1 (article-number a)) 121 | (define number : InlineLike 122 | @when%[number-1]{(@|number-1|)}) 123 | (define pages-1 (article-pages a)) 124 | (define pages : InlineLike 125 | @when%[pages-1]{:@|pages-1|}) 126 | (define date (date->text (article-date a))) 127 | (define online 128 | (format-online #:doi (article-doi a) 129 | #:url (article-url a) 130 | #:eprint (article-eprint a))) 131 | @inline%{@|author|. @|title|. @emph%{@|journal-title|}, @|volume|@|number|@|pages|, @|date|.@|online|}) 132 | 133 | (define (format-thesis [t : Thesis]) : Inline 134 | (define author (format-author (thesis-author t))) 135 | (define title (thesis-title t)) 136 | (define type (thesis-type t)) 137 | (define inst (thesis-institution t)) 138 | (define date (date->text (thesis-date t))) 139 | (define online 140 | (format-online #:doi (thesis-doi t) 141 | #:url (thesis-url t) 142 | #:eprint (thesis-eprint t))) 143 | @inline%{@|author|. @emph{@|title|}. @|type|, @|inst|, @|date|.@|online|}) 144 | 145 | (define (format-misc [m : Misc]) : Inline 146 | (define author (format-author (misc-author m))) 147 | (define title (misc-title m)) 148 | (define date (date->text (misc-date m))) 149 | (define online 150 | (format-online #:doi (misc-doi m) 151 | #:url (misc-url m) 152 | #:eprint (misc-eprint m))) 153 | @inline%{@|author|. @emph{@|title|}. @|date|.@|online|}) 154 | -------------------------------------------------------------------------------- /morg/bibliography/markup.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "bib-item.rkt" 4 | "../markup/inline.rkt" 5 | "../data/date.rkt" 6 | "../util/option.rkt") 7 | 8 | (provide eprint% 9 | article% 10 | thesis% 11 | misc% 12 | arXiv% 13 | inproceedings% 14 | inbook% 15 | book%) 16 | 17 | (define (eprint% #:type [type : EPrintType 'arXiv] 18 | [id : String]) : EPrint 19 | (eprint type id)) 20 | 21 | (define (book% #:author [author : (Listof PureInlineLike)] 22 | #:title [title : PureInlineLike] 23 | #:date [d : Date] 24 | #:publisher [publisher : (Option PureInlineLike) #f] 25 | #:location [location : (Option PureInlineLike) #f] 26 | #:doi [doi : (Option String) #f] 27 | #:url [url : (Option String) #f] 28 | #:eprint [ep : (Option EPrint) #f]) : Book 29 | (book (map pure-inline% author) 30 | (pure-inline% title) 31 | d 32 | (option-map pure-inline% publisher) 33 | (option-map pure-inline% location) 34 | doi url ep)) 35 | 36 | (define (inbook% #:author [author : (Listof PureInlineLike)] 37 | #:title [title : PureInlineLike] 38 | #:booktitle [booktitle : PureInlineLike] 39 | #:date [d : Date] 40 | #:editor [editor : (Option (Listof PureInlineLike)) #f] 41 | #:publisher [publisher : (Option PureInlineLike) #f] 42 | #:location [location : (Option PureInlineLike) #f] 43 | #:volume [volume : (Option PureInlineLike) #f] 44 | #:pages [pages : (Option PureInlineLike) #f] 45 | #:doi [doi : (Option String) #f] 46 | #:url [url : (Option String) #f] 47 | #:eprint [ep : (Option EPrint) #f]) : InBook 48 | (inbook (map pure-inline% author) 49 | (pure-inline% title) 50 | (pure-inline% booktitle) 51 | d 52 | (option-map (lambda ([a : (Listof PureInlineLike)]) 53 | (map pure-inline% a)) 54 | editor) 55 | (option-map pure-inline% publisher) 56 | (option-map pure-inline% location) 57 | (option-map pure-inline% volume) 58 | (option-map pure-inline% pages) 59 | doi url ep)) 60 | 61 | (define (article% #:author [author : (Listof PureInlineLike)] 62 | #:title [title : PureInlineLike] 63 | #:journal-title [journal-title : PureInlineLike] 64 | #:date [d : Date] 65 | #:volume [volume : PureInlineLike] 66 | #:number [number : (Option PureInlineLike) #f] 67 | #:pages [pages : (Option PureInlineLike) #f] 68 | #:doi [doi : (Option String) #f] 69 | #:url [url : (Option String) #f] 70 | #:eprint [ep : (Option EPrint) #f]) : Article 71 | (article (map pure-inline% author) 72 | (pure-inline% title) 73 | (pure-inline% journal-title) 74 | d 75 | (pure-inline% volume) 76 | (option-map pure-inline% number) 77 | (option-map pure-inline% pages) 78 | doi url ep)) 79 | 80 | (define (inproceedings% #:author [author : (Listof PureInlineLike)] 81 | #:title [title : PureInlineLike] 82 | #:book-title [book-title : PureInlineLike] 83 | #:date [d : Date] 84 | #:editor [editor : (Option (Listof PureInlineLike)) #f] 85 | #:publisher [publisher : (Option PureInlineLike) #f] 86 | #:location [location : (Option PureInlineLike) #f] 87 | #:pages [pages : (Option PureInlineLike) #f] 88 | #:doi [doi : (Option String) #f] 89 | #:url [url : (Option String) #f] 90 | #:eprint [ep : (Option EPrint) #f]) : InProceedings 91 | (inproceedings (map pure-inline% author) 92 | (pure-inline% title) 93 | (pure-inline% book-title) 94 | d 95 | (option-map (lambda ([a : (Listof PureInlineLike)]) 96 | (map pure-inline% a)) 97 | editor) 98 | (option-map pure-inline% publisher) 99 | (option-map pure-inline% location) 100 | (option-map pure-inline% pages) 101 | doi url ep)) 102 | 103 | (define (thesis% #:author [author : (Listof PureInlineLike)] 104 | #:title [title : PureInlineLike] 105 | #:type [type : PureInlineLike "PhD Thesis"] 106 | #:institution [institution : PureInlineLike] 107 | #:date [d : Date] 108 | #:doi [doi : (Option String) #f] 109 | #:url [url : (Option String) #f] 110 | #:eprint [ep : (Option EPrint) #f]) : Thesis 111 | (thesis (map pure-inline% author) 112 | (pure-inline% title) 113 | (pure-inline% type) 114 | (pure-inline% institution) 115 | d 116 | doi url ep)) 117 | 118 | (define (misc% #:author [author : (Listof PureInlineLike)] 119 | #:title [title : PureInlineLike] 120 | #:date [d : Date] 121 | #:doi [doi : (Option String) #f] 122 | #:url [url : (Option String) #f] 123 | #:eprint [ep : (Option EPrint) #f]) : Misc 124 | (misc (map pure-inline% author) 125 | (pure-inline% title) 126 | d 127 | doi url ep)) 128 | 129 | (define (arXiv% #:author [author : (Listof PureInlineLike)] 130 | #:title [title : PureInlineLike] 131 | #:date [d : Date] 132 | #:id [id : String]) 133 | (misc% #:author author 134 | #:title title 135 | #:date d 136 | #:eprint (eprint% #:type 'arXiv id))) 137 | -------------------------------------------------------------------------------- /morg/command.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (prefix-in latex: "latex/config.rkt") 4 | (prefix-in html: "html/config.rkt") 5 | "data/document.rkt" 6 | "markup/syntax.rkt" 7 | "latex/publish.rkt" 8 | "html/publish.rkt") 9 | 10 | (define (get-html-config [mod : (Option Module-Path)]) : html:Config 11 | (if mod 12 | (html:dynamic-require-config mod) 13 | html:default-config)) 14 | 15 | (define (get-latex-config [mod : (Option Module-Path)]) : latex:Config 16 | (if mod 17 | (latex:dynamic-require-config mod) 18 | latex:default-config)) 19 | 20 | (struct cmd-args 21 | ([html? : Boolean] 22 | [pdf? : Boolean] 23 | [html-config-file : (Option Module-Path)] 24 | [pdf-config-file : (Option Module-Path)] 25 | [index-file : Module-Path] 26 | [dst-dir : String])) 27 | 28 | (module+ main 29 | (define args 30 | (let ([html? : (Parameterof Boolean) (make-parameter #f)] 31 | [pdf? : (Parameterof Boolean) (make-parameter #f)] 32 | [html-config-file : (Parameterof (Option Module-Path)) 33 | (make-parameter #f)] 34 | [pdf-config-file : (Parameterof (Option Module-Path)) 35 | (make-parameter #f)]) 36 | (command-line 37 | #:once-each 38 | ["--html" "Build HTML version." 39 | (html? #t)] 40 | ["--html-config" file 41 | "Config file for HTML output. Implies --html." 42 | (html? #t) 43 | (html-config-file (string->path (assert file string?)))] 44 | ["--pdf" "Build PDF version." 45 | (pdf? #t)] 46 | ["--pdf-config" file 47 | "Config file for PDF output. Implies --pdf." 48 | (pdf? #t) 49 | (pdf-config-file (string->path (assert file string?)))] 50 | #:usage-help 51 | "Build a MOrg document." 52 | " is a module that exports a document." 53 | " is a destination directory." 54 | #:args (index-file dst-dir) 55 | (cmd-args 56 | (html?) 57 | (pdf?) 58 | (html-config-file) 59 | (pdf-config-file) 60 | (string->path (assert index-file string?)) 61 | (assert dst-dir string?))))) 62 | (define index-file (cmd-args-index-file args)) 63 | (define dst-dir (cmd-args-dst-dir args)) 64 | (define html? (cmd-args-html? args)) 65 | (define pdf? (cmd-args-pdf? args)) 66 | (define html-config-file (cmd-args-html-config-file args)) 67 | (define pdf-config-file (cmd-args-pdf-config-file args)) 68 | (displayln (format "Build HTML?: ~a" html?)) 69 | (when html? 70 | (displayln (format "HTML config file: ~a" html-config-file))) 71 | (displayln (format "Build PDF?: ~a" pdf?)) 72 | (when pdf? 73 | (displayln (format "PDF config file: ~a" pdf-config-file))) 74 | (displayln (format "Index file: ~a" index-file)) 75 | (displayln (format "Destination directory: ~a" dst-dir)) 76 | (define doc (assert (dynamic-include-part index-file) document?)) 77 | (when html? 78 | (->html/publish #:config (get-html-config html-config-file) 79 | doc dst-dir)) 80 | (when pdf? 81 | (->latex/publish #:config (get-latex-config pdf-config-file) 82 | doc dst-dir))) 83 | -------------------------------------------------------------------------------- /morg/data/anchor-table.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "inline.rkt" 4 | "splice.rkt" 5 | "block.rkt" 6 | "article.rkt" 7 | "section.rkt" 8 | "document.rkt" 9 | "extension.rkt" 10 | "id.rkt") 11 | 12 | (provide (struct-out anchor-key) AnchorKey 13 | AnchorTable 14 | anchor-table-has-key? 15 | anchor-table-ref 16 | empty-anchor-table 17 | make-anchor-table) 18 | 19 | (struct anchor-key 20 | ([node : Id] 21 | [anchor : Id]) 22 | #:transparent 23 | #:type-name AnchorKey) 24 | 25 | (define-type (AnchorTable-1 PureInline) 26 | (HashTable AnchorKey (Anchor PureInline))) 27 | 28 | (define-type (Cons PureInline X) 29 | (X (AnchorTable-1 PureInline) . -> . (AnchorTable-1 PureInline))) 30 | 31 | (: make-anchor-table:inline : (Id . -> . (Cons PureInline Inline))) 32 | 33 | (define #:forall (PureInline Inline) 34 | (make-anchor-table:list-item 35 | [n : Id] [f : (Cons PureInline Inline)]) 36 | : (Cons PureInline (ListItem Inline)) 37 | (lambda (li tbl) 38 | (define tbl-1 (f (list-item-head li) tbl)) 39 | (f (list-item-contents li) tbl-1))) 40 | 41 | (define #:forall (PureInline Inline) 42 | (make-anchor-table:pure-inline-element 43 | [n : Id] [f : (Cons PureInline Inline)]) 44 | : (Cons PureInline (PureInlineElement Inline)) 45 | (lambda (pi tbl) 46 | (cond 47 | [(unordered-list? pi) 48 | (foldl (make-anchor-table:list-item n f) tbl 49 | (unordered-list-contents pi))] 50 | [(ordered-list? pi) 51 | (foldl (make-anchor-table:list-item n f) tbl 52 | (ordered-list-contents pi))] 53 | [(href? pi) 54 | (define c (href-contents pi)) 55 | (if c (f c tbl) tbl)] 56 | [(emph? pi) (f (emph-contents pi) tbl)] 57 | [(display? pi) (f (display-contents pi) tbl)] 58 | [(code? pi) (f (code-contents pi) tbl)] 59 | [(dfn? pi) (f (dfn-contents pi) tbl)] 60 | [else tbl]))) 61 | 62 | (define #:forall (PureInline Inline) 63 | (make-anchor-table:inline-element [n : Id] [f : (Cons PureInline Inline)]) 64 | : (Cons PureInline (InlineElement PureInline Inline)) 65 | (lambda (x tbl) 66 | (cond 67 | [(ref? x) tbl] 68 | [(anchor? x) 69 | (define key (anchor-key n (anchor-id x))) 70 | (if (hash-has-key? tbl key) 71 | (error (format "Duplicated anchor: ~a" key)) 72 | (hash-set tbl key x))] 73 | [(anchor-ref? x) tbl] 74 | [(extension? x) 75 | (foldl f tbl (extension-contents x))] 76 | [else ((make-anchor-table:pure-inline-element n f) x tbl)]))) 77 | 78 | (define ((make-anchor-table:inline n) il tbl) 79 | (define x (inline-contents il)) 80 | (define f (make-anchor-table:inline n)) 81 | (cond 82 | [(splice? x) (foldl f tbl (splice-contents x))] 83 | [else ((make-anchor-table:inline-element n f) x tbl)])) 84 | 85 | (define (make-anchor-table:block [n : Id]) : (Cons PureInline Block) 86 | (lambda (b tbl) 87 | (define x (block-contents b)) 88 | (define f (make-anchor-table:block n)) 89 | (cond 90 | [(splice? x) (foldl f tbl (splice-contents x))] 91 | [(paragraph? x) 92 | ((make-anchor-table:inline n) (paragraph-contents x) tbl)] 93 | [else tbl]))) 94 | 95 | (define (make-anchor-table:proof [n : Id]) : (Cons PureInline Proof) 96 | (lambda (pf tbl) 97 | ((make-anchor-table:block n) (proof-contents pf) tbl))) 98 | 99 | (define make-anchor-table:article : (Cons PureInline Article) 100 | (lambda (a tbl) 101 | (define n (article-id a)) 102 | (define f (make-anchor-table:block n)) 103 | (define tbl-1 (f (article-contents a) tbl)) 104 | (define pf (article-proof a)) 105 | (if pf ((make-anchor-table:proof n) pf tbl-1) tbl-1))) 106 | 107 | (define (make-anchor-table:section-element [n : Id]) 108 | : (Cons PureInline SectionElement) 109 | (lambda (s tbl) 110 | (cond 111 | [(article? s) (make-anchor-table:article s tbl)] 112 | [(block? s) ((make-anchor-table:block n) s tbl)]))) 113 | 114 | (define make-anchor-table:section : (Cons PureInline Section) 115 | (lambda (s tbl) 116 | (define n (section-id s)) 117 | (define tbl-1 118 | (foldl (make-anchor-table:section-element n) 119 | tbl 120 | (section-contents s))) 121 | (foldl make-anchor-table:section 122 | tbl-1 123 | (section-subsections s)))) 124 | 125 | (define make-anchor-table:document : (Cons PureInline Document) 126 | (lambda (d tbl) 127 | (define n (document-id d)) 128 | (define tbl-1 129 | ((make-anchor-table:block n) (document-contents d) tbl)) 130 | (foldl make-anchor-table:section 131 | tbl-1 132 | (append (document-front d) 133 | (document-main d) 134 | (document-back d))))) 135 | 136 | (struct anchor-table 137 | ([contents : (AnchorTable-1 PureInline)]) 138 | #:type-name AnchorTable) 139 | 140 | (define (anchor-table-has-key? [tbl : AnchorTable] [key : AnchorKey]) 141 | (hash-has-key? (anchor-table-contents tbl) key)) 142 | 143 | (define (anchor-table-ref [tbl : AnchorTable] [key : AnchorKey]) 144 | (hash-ref (anchor-table-contents tbl) key)) 145 | 146 | (define empty-anchor-table 147 | (anchor-table (hash))) 148 | 149 | (define (make-anchor-table [d : Document]) : AnchorTable 150 | (define tbl 151 | (make-anchor-table:document d (hash))) 152 | (anchor-table tbl)) 153 | -------------------------------------------------------------------------------- /morg/data/article.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "inline.rkt" 4 | "block.rkt" 5 | "index.rkt" 6 | "id.rkt") 7 | 8 | (provide (struct-out article) Article 9 | (struct-out proof) Proof) 10 | 11 | (struct article 12 | ([id : Id] 13 | [header : PureInline] 14 | [title : (Option PureInline)] 15 | [description : (Option PureInline)] 16 | [indexes : (Listof Index)] 17 | [contents : Block] 18 | [proof : (Option Proof)]) 19 | #:transparent 20 | #:type-name Article) 21 | 22 | (struct proof 23 | ([header : PureInline] 24 | [contents : Block]) 25 | #:transparent 26 | #:type-name Proof) 27 | -------------------------------------------------------------------------------- /morg/data/block.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "inline.rkt" 4 | "index.rkt" 5 | "splice.rkt") 6 | 7 | (provide (struct-out block) Block 8 | (struct-out print-index) PrintIndex 9 | (struct-out paragraph) Paragraph) 10 | 11 | (struct block 12 | ([contents : (BlockElement Block)]) 13 | #:transparent 14 | #:type-name Block) 15 | 16 | (define-type (BlockElement X) 17 | (U (Splice X) 18 | PrintIndex 19 | Paragraph)) 20 | 21 | (struct paragraph 22 | ([contents : Inline]) 23 | #:transparent 24 | #:type-name Paragraph) 25 | 26 | (struct print-index 27 | ([type : IndexType]) 28 | #:transparent 29 | #:type-name PrintIndex) 30 | -------------------------------------------------------------------------------- /morg/data/date.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (prefix-in racket: typed/racket/base) 4 | (prefix-in racket: typed/racket/date)) 5 | 6 | (provide (except-out (struct-out date) date) Date 7 | (rename-out [make-date date]) 8 | racket-date->date 9 | current-date) 10 | 11 | (struct date 12 | ([year : Integer] 13 | [month : (Option Exact-Positive-Integer)] 14 | [day : (Option Exact-Positive-Integer)]) 15 | #:transparent 16 | #:type-name Date) 17 | 18 | (define (make-date [year : Integer] 19 | [month : (Option Exact-Positive-Integer)] 20 | [day : (Option Exact-Positive-Integer)]) 21 | (cond 22 | [(and (not month) day) 23 | (error "Month is mandatory when day is given.")] 24 | [else (date year month day)])) 25 | 26 | (define (racket-date->date [d : racket:date]) : Date 27 | (make-date (racket:date-year d) 28 | (cast (racket:date-month d) Exact-Positive-Integer) 29 | (cast (racket:date-day d) Exact-Positive-Integer))) 30 | 31 | (define (current-date) : Date 32 | (racket-date->date (racket:current-date))) 33 | -------------------------------------------------------------------------------- /morg/data/document.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "id.rkt" 4 | "inline.rkt" 5 | "block.rkt" 6 | "date.rkt" 7 | "section.rkt") 8 | 9 | (provide (struct-out document) Document) 10 | 11 | (struct document 12 | ([id : Id] 13 | [author : (Listof PureInline)] 14 | [title : PureInline] 15 | [description : (Option PureInline)] 16 | [date : Date] 17 | [contents : Block] 18 | [front : (Listof Section)] 19 | [main : (Listof Section)] 20 | [back : (Listof Section)]) 21 | #:transparent 22 | #:type-name Document) 23 | -------------------------------------------------------------------------------- /morg/data/extension.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide (struct-out ext-class) ExtClass 4 | extension extension-contents extension? Extension 5 | ExtHash ext-hash-ref 6 | empty-ext-hash ext-hash-set 7 | extension-map) 8 | 9 | (struct ext-class 10 | () 11 | #:type-name ExtClass) 12 | 13 | (struct (X) extension 14 | ([class : ExtClass] 15 | [contents : X]) 16 | #:type-name Extension) 17 | 18 | (struct (X) ext-hash 19 | ([contents : (HashTable ExtClass X)]) 20 | #:type-name ExtHash) 21 | 22 | (define #:forall (X Y) 23 | (ext-hash-ref [h : (ExtHash X)] 24 | [y : (Extension Y)] 25 | [def : (-> X)]) : X 26 | (hash-ref (ext-hash-contents h) 27 | (extension-class y) 28 | def)) 29 | 30 | (define #:forall (X) (empty-ext-hash) : (ExtHash X) 31 | ((inst ext-hash X) (hash))) 32 | 33 | (define #:forall (X) 34 | (ext-hash-set [h : (ExtHash X)] 35 | [c : ExtClass] 36 | [x : X]) : (ExtHash X) 37 | (ext-hash (hash-set (ext-hash-contents h) c x))) 38 | 39 | (define #:forall (X Y) 40 | ((extension-map [f : (X . -> . Y)]) 41 | [x : (Extension X)]) : (Extension Y) 42 | (extension (extension-class x) 43 | (f (extension-contents x)))) 44 | -------------------------------------------------------------------------------- /morg/data/id.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide (except-out (struct-out id) id) Id 4 | (rename-out [make-id id])) 5 | 6 | (module+ test 7 | (require typed/rackunit)) 8 | 9 | (struct id 10 | ([contents : String]) 11 | #:transparent 12 | #:type-name Id) 13 | 14 | (define (valid-id? [x : String]) : Boolean 15 | (regexp-match-exact? #px"[[:alnum:]-]+" x)) 16 | 17 | (module+ test 18 | (check-true (valid-id? "0123")) 19 | (check-true (valid-id? "abcd")) 20 | (check-true (valid-id? "ABCD")) 21 | (check-true (valid-id? "0Ab4")) 22 | (check-false (valid-id? "")) 23 | (check-false (valid-id? "xx_yy_Zz-02A5")) 24 | (check-true (valid-id? "0A-b4-3C"))) 25 | 26 | (define (make-id [x : String]) : Id 27 | (if (valid-id? x) 28 | (id x) 29 | (error (format "Invalid id: ~a" x)))) 30 | -------------------------------------------------------------------------------- /morg/data/index-table.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "index.rkt" 4 | "article.rkt" 5 | "section.rkt" 6 | "document.rkt") 7 | 8 | (provide (struct-out index-item) IndexItem 9 | IndexList 10 | IndexTable 11 | index-table-has-key? 12 | index-table-ref 13 | empty-index-table 14 | make-index-table 15 | index-item . Boolean) 71 | index-iteminline 15 | (struct-out inline) Inline 16 | (struct-out pure-inline) PureInline 17 | (struct-out ref) Ref 18 | (struct-out text) Text 19 | (struct-out list-item) ListItem 20 | (struct-out unordered-list) UnorderedList 21 | (struct-out ordered-list) OrderedList 22 | (struct-out href) HRef 23 | (struct-out emph) Emph 24 | (struct-out display) Display 25 | (struct-out code) Code 26 | (struct-out dfn) Dfn 27 | (struct-out anchor) Anchor 28 | (struct-out anchor-ref) AnchorRef 29 | (struct-out math) Math) 30 | 31 | (struct pure-inline 32 | ([contents : (U (Splice PureInline) (PureInlineElement PureInline))]) 33 | #:transparent 34 | #:type-name PureInline) 35 | 36 | (struct inline 37 | ([contents : (U (Splice Inline) (InlineElement PureInline Inline))]) 38 | #:transparent 39 | #:type-name Inline) 40 | 41 | (define-type (PureInlineElement X) 42 | (U Text 43 | Math 44 | (UnorderedList X) 45 | (OrderedList X) 46 | (HRef X) 47 | (Emph X) 48 | (Display X) 49 | (Code X) 50 | (Dfn X))) 51 | 52 | (define-type (InlineElement PureInline Inline) 53 | (U (PureInlineElement Inline) 54 | Ref 55 | (Extension (Listof Inline)) 56 | (Anchor PureInline) 57 | AnchorRef)) 58 | 59 | (struct text 60 | ([contents : String]) 61 | #:transparent 62 | #:type-name Text) 63 | 64 | (struct ref 65 | ([id : Id]) 66 | #:transparent 67 | #:type-name Ref) 68 | 69 | (struct math 70 | ([contents : MathTeX]) 71 | #:transparent 72 | #:type-name Math) 73 | 74 | (struct (Inline) list-item 75 | ([head : Inline] 76 | [contents : Inline]) 77 | #:transparent 78 | #:type-name ListItem) 79 | 80 | (struct (Inline) unordered-list 81 | ([contents : (Listof (ListItem Inline))]) 82 | #:transparent 83 | #:type-name UnorderedList) 84 | 85 | (struct (Inline) ordered-list 86 | ([contents : (Listof (ListItem Inline))]) 87 | #:transparent 88 | #:type-name OrderedList) 89 | 90 | (struct (Inline) href 91 | ([url : String] 92 | [contents : (Option Inline)]) 93 | #:transparent 94 | #:type-name HRef) 95 | 96 | (struct (Inline) emph 97 | ([contents : Inline]) 98 | #:transparent 99 | #:type-name Emph) 100 | 101 | (struct (Inline) display 102 | ([contents : Inline]) 103 | #:transparent 104 | #:type-name Display) 105 | 106 | (struct (Inline) code 107 | ([contents : Inline]) 108 | #:transparent 109 | #:type-name Code) 110 | 111 | (struct (Inline) dfn 112 | ([contents : Inline]) 113 | #:transparent 114 | #:type-name Dfn) 115 | 116 | (struct (PureInline) anchor 117 | ([id : Id] 118 | [contents : PureInline]) 119 | #:transparent 120 | #:type-name Anchor) 121 | 122 | (struct anchor-ref 123 | ([anchor : Id] 124 | [node : Id]) 125 | #:transparent 126 | #:type-name AnchorRef) 127 | 128 | (define #:forall (X Y) 129 | ((list-item-map [f : (X . -> . Y)]) 130 | [x : (ListItem X)]) : (ListItem Y) 131 | (list-item (f (list-item-head x)) 132 | (f (list-item-contents x)))) 133 | 134 | (define #:forall (X Y) 135 | ((unordered-list-map [f : (X . -> . Y)]) 136 | [x : (UnorderedList X)]) : (UnorderedList Y) 137 | (unordered-list (map (list-item-map f) (unordered-list-contents x)))) 138 | 139 | (define #:forall (X Y) 140 | ((ordered-list-map [f : (X . -> . Y)]) 141 | [x : (OrderedList X)]) : (OrderedList Y) 142 | (ordered-list (map (list-item-map f) (ordered-list-contents x)))) 143 | 144 | (define #:forall (X Y) 145 | ((href-map [f : (X . -> . Y)]) 146 | [x : (HRef X)]) : (HRef Y) 147 | (href (href-url x) 148 | (option-map f (href-contents x)))) 149 | 150 | (define #:forall (X Y) 151 | ((emph-map [f : (X . -> . Y)]) 152 | [x : (Emph X)]) : (Emph Y) 153 | (emph (f (emph-contents x)))) 154 | 155 | (define #:forall (X Y) 156 | ((display-map [f : (X . -> . Y)]) 157 | [x : (Display X)]) : (Display Y) 158 | (display (f (display-contents x)))) 159 | 160 | (define #:forall (X Y) 161 | ((code-map [f : (X . -> . Y)]) 162 | [x : (Code X)]) : (Code Y) 163 | (code (f (code-contents x)))) 164 | 165 | (define #:forall (X Y) 166 | ((dfn-map [f : (X . -> . Y)]) 167 | [x : (Dfn X)]) : (Dfn Y) 168 | (dfn (f (dfn-contents x)))) 169 | 170 | (define #:forall (X Y) 171 | ((anchor-map [f : (X . -> . Y)]) 172 | [x : (Anchor X)]) : (Anchor Y) 173 | (anchor (anchor-id x) 174 | (f (anchor-contents x)))) 175 | 176 | (define #:forall (X Y) 177 | ((pure-inline-element-map [f : (X . -> . Y)]) 178 | [x : (PureInlineElement X)]) : (PureInlineElement Y) 179 | (cond 180 | [(text? x) x] 181 | [(math? x) x] 182 | [(unordered-list? x) ((unordered-list-map f) x)] 183 | [(ordered-list? x) ((ordered-list-map f) x)] 184 | [(href? x) ((href-map f) x)] 185 | [(emph? x) ((emph-map f) x)] 186 | [(display? x) ((display-map f) x)] 187 | [(code? x) ((code-map f) x)] 188 | [(dfn? x) ((dfn-map f) x)])) 189 | 190 | (define #:forall (X1 X2 Y1 Y2) 191 | ((inline-element-map [f : (X1 . -> . X2)] 192 | [g : (Y1 . -> . Y2)]) 193 | [x : (InlineElement X1 Y1)]) : (InlineElement X2 Y2) 194 | (cond 195 | [(ref? x) x] 196 | [(anchor? x) ((anchor-map f) x)] 197 | [(anchor-ref? x) x] 198 | [(extension? x) ((extension-map (list-map g)) x)] 199 | [else ((pure-inline-element-map g) x)])) 200 | 201 | (define (pure-inline->inline [x : PureInline]) : Inline 202 | (define y (pure-inline-contents x)) 203 | (cond 204 | [(splice? y) (inline (splice-map pure-inline->inline y))] 205 | [else (inline ((pure-inline-element-map pure-inline->inline) y))])) 206 | -------------------------------------------------------------------------------- /morg/data/node.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "article.rkt" 4 | "section.rkt" 5 | "id.rkt") 6 | 7 | (provide (except-out (struct-out root) root) Root 8 | (except-out (struct-out section-node) section-node) SectionNode 9 | (except-out (struct-out article-node) article-node) ArticleNode 10 | Node 11 | node-id node-index node-parent 12 | node-trace 13 | NodeTable 14 | node-table-has-key? node-table-ref 15 | make-node-table) 16 | 17 | (module+ test 18 | (require typed/rackunit)) 19 | 20 | (struct root 21 | ([contents : (Listof Section)]) 22 | #:transparent 23 | #:type-name Root) 24 | 25 | (struct section-node 26 | ([contents : Section] 27 | [parent : (U SectionNode Root)] 28 | [index : Natural] 29 | [siblings-left : (Listof Section)] 30 | [siblings-right : (Listof Section)]) 31 | #:transparent 32 | #:type-name SectionNode) 33 | 34 | (struct article-node 35 | ([contents : Article] 36 | [parent : SectionNode] 37 | [index : Natural]) 38 | #:transparent 39 | #:type-name ArticleNode) 40 | 41 | (define-type Node 42 | (U SectionNode ArticleNode)) 43 | 44 | (define (node-id [n : Node]) : Id 45 | (cond 46 | [(section-node? n) (section-id (section-node-contents n))] 47 | [(article-node? n) (article-id (article-node-contents n))])) 48 | 49 | (define (node-parent [n : Node]) : (U SectionNode Root) 50 | (cond 51 | [(section-node? n) (section-node-parent n)] 52 | [(article-node? n) (article-node-parent n)])) 53 | 54 | (define (node-index [n : Node]) : Natural 55 | (cond 56 | [(section-node? n) (section-node-index n)] 57 | [(article-node? n) (article-node-index n)])) 58 | 59 | (define (node-trace [n : Node]) : (Listof Node) 60 | (node-trace:aux n (list))) 61 | 62 | (define (node-trace:aux [n : (U Node Root)] [acc : (Listof Node)]) : (Listof Node) 63 | (cond 64 | [(root? n) acc] 65 | [else (node-trace:aux (node-parent n) (list* n acc))])) 66 | 67 | (struct node-table 68 | ([contents : (HashTable Id Node)]) 69 | #:type-name NodeTable) 70 | 71 | (define (node-table-has-key? [tbl : NodeTable] [i : Id]) : Boolean 72 | (hash-has-key? (node-table-contents tbl) i)) 73 | 74 | (define (node-table-ref [tbl : NodeTable] [i : Id]) : Node 75 | (hash-ref (node-table-contents tbl) i)) 76 | 77 | (define (node-table-set [tbl : NodeTable] [i : Id] [n : Node]) : NodeTable 78 | (node-table (hash-set (node-table-contents tbl) i n))) 79 | 80 | (define (check-unique [tbl : NodeTable] [id : Id] [n : Node]) : Void 81 | (when (node-table-has-key? tbl id) 82 | (error (format "Duplicated id:\none: ~a\nanother: ~a" 83 | (map node-id (node-trace (node-table-ref tbl id))) 84 | (map node-id (node-trace n))))) 85 | (void)) 86 | 87 | (define (node-table-traverse-article [tbl : NodeTable] [a : Article] [s : SectionNode] [i : Natural]) : NodeTable 88 | (define n (article-node a s i)) 89 | (define id (article-id a)) 90 | (check-unique tbl id n) 91 | (node-table-set tbl id n)) 92 | 93 | (define (node-table-traverse-articles [tbl : NodeTable] [as : (Listof Article)] [s : SectionNode]) : NodeTable 94 | (node-table-traverse-articles:aux tbl as s 0)) 95 | 96 | (define (node-table-traverse-articles:aux 97 | [tbl : NodeTable] [as : (Listof Article)] 98 | [s : SectionNode] [i : Natural]) : NodeTable 99 | (match as 100 | [(list* a as) 101 | (node-table-traverse-articles:aux 102 | (node-table-traverse-article tbl a s i) 103 | as s (+ i 1))] 104 | [_ tbl])) 105 | 106 | (define (node-table-traverse-section 107 | [tbl : NodeTable] [s : Section] [p : (U SectionNode Root)] 108 | [i : Natural] [left : (Listof Section)] [right : (Listof Section)]) : NodeTable 109 | (define n (section-node s p i left right)) 110 | (define id (section-id s)) 111 | (check-unique tbl id n) 112 | (define tbl-1 (node-table-set tbl id n)) 113 | (define tbl-2 114 | (node-table-traverse-articles tbl-1 (section-articles s) n)) 115 | (node-table-traverse-sections tbl-2 (section-subsections s) n)) 116 | 117 | (define (node-table-traverse-sections [tbl : NodeTable] [ss : (Listof Section)] [p : (U SectionNode Root)]) : NodeTable 118 | (node-table-traverse-sections:aux tbl (list) ss p 0)) 119 | 120 | (define (node-table-traverse-sections:aux 121 | [tbl : NodeTable] [left : (Listof Section)] [right : (Listof Section)] 122 | [p : (U SectionNode Root)] [i : Natural]) : NodeTable 123 | (match right 124 | [(list* s right) 125 | (node-table-traverse-sections:aux 126 | (node-table-traverse-section tbl s p i left right) 127 | (list* s left) right p (+ i 1))] 128 | [_ tbl])) 129 | 130 | (define (node-table-traverse-root [tbl : NodeTable] [r : Root]) : NodeTable 131 | (node-table-traverse-sections tbl (root-contents r) r)) 132 | 133 | (define (make-node-table [ss : (Listof Section)] 134 | #:init [init : NodeTable (node-table (hash))]) : NodeTable 135 | (node-table-traverse-root init (root ss))) 136 | 137 | (module+ test 138 | (require "../markup/article.rkt" 139 | "../markup/section.rkt" 140 | "../markup/block.rkt" 141 | "../markup/splice.rkt") 142 | 143 | (define a1 144 | @article%[#:id "a1" #:header @%{Definition}]) 145 | (define a2 146 | @article%[#:id "a2" #:header @%{Proposition}]) 147 | (define s1 148 | @section%[ 149 | #:id "s1" #:title @%{Title 1} 150 | a1 151 | @paragraph%{ 152 | Hello, world! 153 | } 154 | a2 155 | ]) 156 | (define s2 157 | @section%[ 158 | #:id "s2" #:title @%{Title 2} 159 | @paragraph%{ 160 | By, world! 161 | } 162 | ]) 163 | (define a3 164 | @article%[#:id "a3" #:header @%{Theorem}]) 165 | (define s5 166 | @section%[ 167 | #:id "s5" #:title @%{Title 5} 168 | ]) 169 | (define s3 170 | @section%[ 171 | #:id "s3" #:title @%{Title 3} 172 | a3 173 | #:subsections @list[ 174 | s5 175 | ] 176 | ]) 177 | (define s4 178 | @section%[ 179 | #:id "s4" #:title @%{Title 4} 180 | #:subsections @list[ 181 | s1 s2 s3 182 | ] 183 | ]) 184 | (define tbl 185 | (make-node-table (list s4))) 186 | (define ns4 187 | (section-node s4 (root (list s4)) 0 (list) (list))) 188 | (define ns1 189 | (section-node s1 ns4 0 (list) (list s2 s3))) 190 | (define ns2 191 | (section-node s2 ns4 1 (list s1) (list s3))) 192 | (define ns3 193 | (section-node s3 ns4 2 (list s2 s1) (list))) 194 | (define na1 195 | (article-node a1 ns1 0)) 196 | (define na2 197 | (article-node a2 ns1 1)) 198 | (define na3 199 | (article-node a3 ns3 0)) 200 | (define ns5 201 | (section-node s5 ns3 0 (list) (list))) 202 | 203 | (check-equal? 204 | (node-table-contents tbl) 205 | (hash (id "a1") na1 206 | (id "a2") na2 207 | (id "a3") na3 208 | (id "s1") ns1 209 | (id "s2") ns2 210 | (id "s5") ns5 211 | (id "s3") ns3 212 | (id "s4") ns4)) 213 | 214 | (check-equal? 215 | (node-trace ns5) 216 | (list ns4 ns3 ns5)) 217 | (check-equal? 218 | (node-trace na2) 219 | (list ns4 ns1 na2))) 220 | -------------------------------------------------------------------------------- /morg/data/section.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "id.rkt" 4 | "inline.rkt" 5 | "block.rkt" 6 | "article.rkt") 7 | 8 | (provide (struct-out section) Section 9 | SectionElement 10 | section-articles) 11 | 12 | (struct section 13 | ([id : Id] 14 | [title : PureInline] 15 | [description : (Option PureInline)] 16 | [contents : (Listof SectionElement)] 17 | [subsections : (Listof Section)]) 18 | #:transparent 19 | #:type-name Section) 20 | 21 | (define-type SectionElement 22 | (U Article Block)) 23 | 24 | (define (section-articles [s : Section]) : (Listof Article) 25 | (filter article? (section-contents s))) 26 | -------------------------------------------------------------------------------- /morg/data/splice.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide (struct-out splice) Splice 4 | splice-map) 5 | 6 | (struct (X) splice 7 | ([contents : (Listof X)]) 8 | #:transparent 9 | #:type-name Splice) 10 | 11 | (define #:forall (X Y) 12 | (splice-map [f : (X . -> . Y)] [a : (Splice X)]) : (Splice Y) 13 | (splice (map f (splice-contents a)))) 14 | -------------------------------------------------------------------------------- /morg/data/tex.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "splice.rkt" 4 | "../util/option.rkt") 5 | 6 | (provide (struct-out text) Text 7 | (struct-out argument) Argument 8 | (struct-out macro) Macro 9 | (struct-out group) Group 10 | (struct-out special) Special 11 | (struct-out atom) Atom 12 | (struct-out math) Math 13 | (except-out (struct-out sub-sup) sub-sup) SubSup 14 | (rename-out [make-sub-sup sub-sup]) 15 | (struct-out text-tex) TextTeX 16 | (struct-out math-tex) MathTeX 17 | group-map 18 | argument-map 19 | atom-map 20 | sub-sup-map 21 | macro-map) 22 | 23 | (struct text 24 | ([contents : String]) 25 | #:transparent 26 | #:type-name Text) 27 | 28 | (struct (X) argument 29 | ([contents : X] 30 | [parentheses : (Pairof String String)]) 31 | #:transparent 32 | #:type-name Argument) 33 | 34 | (struct (X) macro 35 | ([head : String] 36 | [arguments : (Listof (Argument X))]) 37 | #:transparent 38 | #:type-name Macro) 39 | 40 | (struct (X) group 41 | ([contents : X]) 42 | #:transparent 43 | #:type-name Group) 44 | 45 | (define-type SpecialCharacter 46 | (U "&")) 47 | 48 | (struct special 49 | ([contents : SpecialCharacter]) 50 | #:transparent 51 | #:type-name Special) 52 | 53 | (struct (X) atom 54 | ([contents : (U Text (Macro X) (Group X) Special)]) 55 | #:transparent 56 | #:type-name Atom) 57 | 58 | (struct math 59 | ([contents : MathTeX]) 60 | #:transparent 61 | #:type-name Math) 62 | 63 | (struct (A X) sub-sup 64 | ([base : A] 65 | [sub : (Option X)] 66 | [sup : (Option X)]) 67 | #:transparent 68 | #:type-name SubSup) 69 | 70 | (struct text-tex 71 | ([contents : (U (Atom TextTeX) 72 | (Splice TextTeX) 73 | Math)]) 74 | #:transparent 75 | #:type-name TextTeX) 76 | 77 | (struct math-tex 78 | ([contents : (U (Atom MathTeX) 79 | (Splice MathTeX) 80 | (SubSup (Atom MathTeX) MathTeX))]) 81 | #:transparent 82 | #:type-name MathTeX) 83 | 84 | (define #:forall (A X) 85 | (make-sub-sup [base : A] [sub : (Option X)] [sup : (Option X)]) : (SubSup A X) 86 | (if (or sub sup) 87 | (sub-sup base sub sup) 88 | (error "Either sub or sup must be given."))) 89 | 90 | (define #:forall (X Y) 91 | ((group-map [f : (X . -> . Y)]) [x : (Group X)]) : (Group Y) 92 | (group (f (group-contents x)))) 93 | 94 | (define #:forall (X Y) 95 | ((argument-map [f : (X . -> . Y)]) [x : (Argument X)]) : (Argument Y) 96 | (argument (f (argument-contents x)) 97 | (argument-parentheses x))) 98 | 99 | (define #:forall (X Y) 100 | ((macro-map [f : (X . -> . Y)]) [x : (Macro X)]) : (Macro Y) 101 | (macro (macro-head x) 102 | (map (argument-map f) (macro-arguments x)))) 103 | 104 | (define #:forall (X Y) 105 | ((atom-map [f : (X . -> . Y)]) [x : (Atom X)]) : (Atom Y) 106 | (define a (atom-contents x)) 107 | (define b 108 | (cond 109 | [(text? a) a] 110 | [(special? a) a] 111 | [(macro? a) ((macro-map f) a)] 112 | [(group? a) ((group-map f) a)])) 113 | (atom b)) 114 | 115 | (define #:forall (A B X Y) 116 | ((sub-sup-map [g : (A . -> . B)] [f : (X . -> . Y)]) 117 | [x : (SubSup A X)]) : (SubSup B Y) 118 | (sub-sup 119 | (g (sub-sup-base x)) 120 | (option-map f (sub-sup-sub x)) 121 | (option-map f (sub-sup-sup x)))) 122 | -------------------------------------------------------------------------------- /morg/data/tree.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide (struct-out leaf) Leaf 4 | (struct-out node) Node 5 | Tree 6 | tree-flatten) 7 | 8 | (struct (A) leaf 9 | ([contents : A]) 10 | #:transparent 11 | #:type-name Leaf) 12 | 13 | (struct (A) node 14 | ([contents : (Listof (Tree A))]) 15 | #:transparent 16 | #:type-name Node) 17 | 18 | (define-type (Tree A) 19 | (U (Leaf A) (Node A))) 20 | 21 | (: tree-flatten : (All (A) ((Tree A) . -> . (Listof A)))) 22 | 23 | (define (tree-flatten t) 24 | (match t 25 | [(leaf t) (list t)] 26 | [(node t) 27 | (apply append (map (inst tree-flatten A) t))])) 28 | -------------------------------------------------------------------------------- /morg/eq-reasoning.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "data/extension.rkt" 4 | "util/list.rkt" 5 | "markup/xexpr.rkt" 6 | "markup/tex.rkt" 7 | "markup/inline.rkt") 8 | 9 | (module+ test 10 | (require typed/rackunit)) 11 | 12 | (provide eq-reasoning) 13 | 14 | (define cls (ext-class)) 15 | 16 | (define-type EqReasoningUnit 17 | (List InlineLike)) 18 | 19 | (define-type EqReasoningCons 20 | (List* InlineLike InlineLike InlineLike EqReasoning)) 21 | 22 | (define-type EqReasoning 23 | (U EqReasoningUnit EqReasoningCons)) 24 | 25 | (: eq-reasoning:list : (EqReasoning . -> . (Listof InlineLike))) 26 | 27 | (define (eq-reasoning:list x) 28 | (match x 29 | [(list x) (list "" x)] 30 | [(list* term rel reason rst) 31 | (list* "" term 32 | rel @inline%{ {@|reason|}} 33 | (eq-reasoning:list rst))])) 34 | 35 | (define (eq-reasoning:fun [e : EqReasoning]) : InlineLike 36 | (extension cls (eq-reasoning:list e))) 37 | 38 | (define-syntax-rule (eq-reasoning body ...) 39 | (eq-reasoning:fun (list body ...))) 40 | 41 | (module+ test 42 | (check-true (assert-typecheck-fail 43 | (eq-reasoning) 44 | #:result #t)) 45 | (check-true (assert-typecheck-fail 46 | (eq-reasoning 47 | "a" "=" "b") 48 | #:result #t)) 49 | (check-false (not (eq-reasoning 50 | "1 + 1" 51 | "=" "definition" 52 | "2")))) 53 | 54 | (module* latex-config #f 55 | (require "latex/config.rkt") 56 | 57 | (provide config-update) 58 | 59 | (define (set-length [v : TextTeXLike] [l : TextTeXLike]) 60 | (macro% "setlength" (argument% v) (argument% l))) 61 | 62 | (define (eq-reasoning->latex [xs : (Listof TextTeXLike)]) : TextTeXLike 63 | (define xss (list-group xs 2)) 64 | (define yss 65 | (map (lambda ([ws : (Listof TextTeXLike)]) 66 | (list-join-1 ws @special%["&"])) 67 | xss)) 68 | (define zs 69 | (list-join yss (list @macro%["\\"]))) 70 | @text-tex%{ 71 | @macro%["begingroup"] 72 | @(set-length @macro%["LTpre"] "0pt") 73 | @(set-length @macro%["LTpost"] "-2em") 74 | @((inst environment% TextTeXLike) 75 | "longtable" 76 | #:arguments (list @argument%{ll}) 77 | (apply text-tex% zs)) 78 | @macro%["endgroup"] 79 | }) 80 | 81 | (define (config-update [cfg : Config]) : Config 82 | (struct-copy config cfg 83 | [render-extension 84 | (ext-hash-set (config-render-extension cfg) 85 | cls eq-reasoning->latex)] 86 | [packages 87 | (list* (package "longtable" '()) 88 | (config-packages cfg))]))) 89 | 90 | (module* html-config #f 91 | (require "html/config.rkt") 92 | 93 | (provide config-update) 94 | 95 | (define (eq-reasoning->xexprs [xs : (Listof XExprs)]) : XExprs 96 | (apply tagged% 'span 97 | '((style "display: grid; grid-template-columns: max-content auto; grid-column-gap: 1em; text-align: start;")) 98 | (map (lambda ([x : XExprs]) 99 | (tagged% 'span '() x)) 100 | xs))) 101 | 102 | (define (config-update [cfg : Config]) : Config 103 | (struct-copy config cfg 104 | [render-extension 105 | (ext-hash-set (config-render-extension cfg) 106 | cls eq-reasoning->xexprs)]))) 107 | -------------------------------------------------------------------------------- /morg/eq-reasoning/html.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (submod "../eq-reasoning.rkt" html-config)) 4 | 5 | (provide 6 | (all-from-out 7 | (submod "../eq-reasoning.rkt" html-config))) 8 | -------------------------------------------------------------------------------- /morg/eq-reasoning/latex.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (submod "../eq-reasoning.rkt" latex-config)) 4 | 5 | (provide 6 | (all-from-out 7 | (submod "../eq-reasoning.rkt" latex-config))) 8 | -------------------------------------------------------------------------------- /morg/html.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "html/config.rkt" 4 | "html/class/article.rkt" 5 | "html/class/block.rkt" 6 | "html/class/breadcrumb.rkt" 7 | "html/class/document.rkt" 8 | "html/class/document-toc.rkt" 9 | "html/class/d-pad.rkt" 10 | "html/class/id.rkt" 11 | "html/class/inline.rkt" 12 | "html/class/section.rkt" 13 | "html/class/toc.rkt") 14 | 15 | (provide 16 | (struct-out config) Config 17 | provide-config 18 | compose-config 19 | default-config 20 | config-add-css 21 | config-set-base-url 22 | (all-from-out 23 | "html/class/article.rkt" 24 | "html/class/block.rkt" 25 | "html/class/breadcrumb.rkt" 26 | "html/class/document.rkt" 27 | "html/class/document-toc.rkt" 28 | "html/class/d-pad.rkt" 29 | "html/class/id.rkt" 30 | "html/class/inline.rkt" 31 | "html/class/section.rkt" 32 | "html/class/toc.rkt")) 33 | -------------------------------------------------------------------------------- /morg/html/article.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/article.rkt" 4 | "../markup/xexpr.rkt" 5 | "../markup/splice.rkt" 6 | "../data/id.rkt" 7 | "class/article.rkt" 8 | "state.rkt" 9 | "pure-inline.rkt" 10 | "block.rkt" 11 | "id.rkt") 12 | 13 | (provide article->xexprs) 14 | 15 | (define ((article->xexprs:statement [st : State]) [a : Article]) : XExprs 16 | (define f pure-inline->xexprs) 17 | (define title (article-title a)) 18 | (tagged% 'div 19 | `((class ,statement-class-name)) 20 | (tagged% 'header 21 | `((class ,statement-header-class-name)) 22 | (id->xexprs/a (article-id a)) 23 | " " 24 | (tagged% 'span 25 | `((class ,statement-header-header-class-name)) 26 | (f (article-header a))) 27 | (when% title 28 | (tagged% 'span 29 | `((class ,statement-header-title-class-name)) 30 | "(" 31 | (f title) 32 | ")"))) 33 | (tagged% 'div 34 | `((class ,statement-body-class-name)) 35 | ((block->xexprs st) (article-contents a))))) 36 | 37 | (define ((proof->xexprs [st : State]) [pf : Proof]) : XExprs 38 | (tagged% 'details 39 | `((class ,proof-class-name)) 40 | (tagged% 'summary 41 | `((class ,proof-header-class-name)) 42 | (pure-inline->xexprs (proof-header pf))) 43 | (tagged% 'div 44 | `((class ,proof-body-class-name)) 45 | ((block->xexprs st) (proof-contents pf))))) 46 | 47 | (define ((article->xexprs [st-1 : State]) [a : Article]) : XExprs 48 | (define id (article-id a)) 49 | (define st 50 | (struct-copy state st-1 51 | [id id])) 52 | (define pf (article-proof a)) 53 | (tagged% 'article 54 | `((class ,article-class-name)) 55 | ((article->xexprs:statement st) a) 56 | (when% pf 57 | ((proof->xexprs st) pf)))) 58 | -------------------------------------------------------------------------------- /morg/html/block.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/block.rkt" 4 | "../markup/xexpr.rkt" 5 | "../markup/index.rkt" 6 | "../data/splice.rkt" 7 | "../data/index-table.rkt" 8 | "class/block.rkt" 9 | "state.rkt" 10 | "inline.rkt" 11 | "splice.rkt") 12 | 13 | (provide block->xexprs) 14 | 15 | (: block->xexprs : (State . -> . (Block . -> . XExprs))) 16 | 17 | (define ((paragraph->xexprs [st : State]) [x : Paragraph]) : XExprs 18 | (tagged% 'p 19 | `((class ,paragraph-class-name)) 20 | ((inline->xexprs st) (paragraph-contents x)))) 21 | 22 | (define ((print-index->xexprs [st : State]) [p : PrintIndex]) : XExprs 23 | (define tbl (state-index-table st)) 24 | (define type (print-index-type p)) 25 | (define in? (index-table-has-key? tbl type)) 26 | (cond 27 | [in? 28 | (tagged% 'div 29 | `((class ,print-index-class-name)) 30 | ((inline->xexprs st) (index-list->inline (index-table-ref tbl type))))] 31 | [else (xexprs%)])) 32 | 33 | (define ((block->xexprs st) b) 34 | (define x (block-contents b)) 35 | (define f (block->xexprs st)) 36 | (cond 37 | [(paragraph? x) ((paragraph->xexprs st) x)] 38 | [(print-index? x) ((print-index->xexprs st) x)] 39 | [(splice? x) ((splice->xexprs f) x)] 40 | [else (error "Unimplemented.")])) 41 | -------------------------------------------------------------------------------- /morg/html/breadcrumb.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/node.rkt" 4 | "../data/document.rkt" 5 | "../data/id.rkt" 6 | "site-state.rkt" 7 | "id.rkt" 8 | "../markup/xexpr.rkt" 9 | "class/breadcrumb.rkt") 10 | 11 | (provide make-breadcrumb) 12 | 13 | (define (make-breadcrumb [st : SiteState] [n : Node]) : XExprs 14 | (define top-id (document-id (site-state-root st))) 15 | (define ids (map node-id (node-trace n))) 16 | (define (f [i : Id]) 17 | (tagged% 'li 18 | `((class ,breadcrumb-node-class-name)) 19 | (id->xexprs/a i))) 20 | (tagged% 'ol 21 | `((class ,breadcrumb-class-name)) 22 | (tagged% 'li 23 | `((class ,breadcrumb-top-class-name)) 24 | (id->xexprs/a top-id)) 25 | (apply xexprs% 26 | (map f ids)))) 27 | -------------------------------------------------------------------------------- /morg/html/class.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide class-name) 4 | 5 | (define class-prefix "morg-generated-") 6 | 7 | (define (class-name [s : String]) : String 8 | (string-append class-prefix s)) 9 | -------------------------------------------------------------------------------- /morg/html/class/article.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide statement-class-name 6 | statement-header-class-name 7 | statement-header-header-class-name 8 | statement-header-title-class-name 9 | statement-body-class-name 10 | proof-class-name 11 | proof-header-class-name 12 | proof-body-class-name 13 | article-class-name) 14 | 15 | (define statement-class-name (class-name "statement")) 16 | (define statement-header-class-name (class-name "statement-header")) 17 | (define statement-header-header-class-name (class-name "statement-header-header")) 18 | (define statement-header-title-class-name (class-name "statement-header-title")) 19 | (define statement-body-class-name (class-name "statement-body")) 20 | (define proof-class-name (class-name "proof")) 21 | (define proof-header-class-name (class-name "proof-header")) 22 | (define proof-body-class-name (class-name "proof-body")) 23 | (define article-class-name (class-name "article")) 24 | -------------------------------------------------------------------------------- /morg/html/class/block.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide paragraph-class-name 6 | print-index-class-name) 7 | 8 | (define paragraph-class-name (class-name "paragraph")) 9 | (define print-index-class-name (class-name "print-index")) 10 | -------------------------------------------------------------------------------- /morg/html/class/breadcrumb.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide breadcrumb-class-name 6 | breadcrumb-top-class-name 7 | breadcrumb-node-class-name) 8 | 9 | (define breadcrumb-class-name (class-name "breadcrumb")) 10 | (define breadcrumb-top-class-name (class-name "breadcumrb-top")) 11 | (define breadcrumb-node-class-name (class-name "breadcrumb-node")) 12 | -------------------------------------------------------------------------------- /morg/html/class/d-pad.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide d-pad-class-name 6 | d-pad-previous-class-name 7 | d-pad-up-class-name 8 | d-pad-next-class-name) 9 | 10 | (define d-pad-class-name (class-name "d-pad")) 11 | (define d-pad-previous-class-name (class-name "d-pad-previous")) 12 | (define d-pad-up-class-name (class-name "d-pad-up")) 13 | (define d-pad-next-class-name (class-name "d-pad-next")) 14 | -------------------------------------------------------------------------------- /morg/html/class/document-toc.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide document-front-toc-class-name 6 | document-main-toc-class-name 7 | document-back-toc-class-name 8 | document-toc-class-name) 9 | 10 | (define document-front-toc-class-name (class-name "document-front-toc")) 11 | (define document-main-toc-class-name (class-name "document-main-toc")) 12 | (define document-back-toc-class-name (class-name "document-back-toc")) 13 | (define document-toc-class-name (class-name "document-toc")) 14 | -------------------------------------------------------------------------------- /morg/html/class/document.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide document-class-name 6 | document-title-class-name 7 | document-address-class-name 8 | document-author-list-class-name 9 | document-author-class-name 10 | document-date-class-name) 11 | 12 | (define document-class-name (class-name "document")) 13 | (define document-title-class-name (class-name "document-title")) 14 | (define document-address-class-name (class-name "document-address")) 15 | (define document-author-list-class-name (class-name "document-author-list")) 16 | (define document-author-class-name (class-name "document-author")) 17 | (define document-date-class-name (class-name "document-date")) 18 | -------------------------------------------------------------------------------- /morg/html/class/id.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide id-class-name) 6 | 7 | (define id-class-name (class-name "id")) 8 | -------------------------------------------------------------------------------- /morg/html/class/inline.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide katex-class-name 6 | ref-class-name 7 | list-item-class-name 8 | list-item-head-class-name 9 | unordered-list-class-name 10 | ordered-list-class-name 11 | href-class-name 12 | emph-class-name 13 | display-class-name 14 | code-class-name 15 | dfn-class-name 16 | anchor-class-name 17 | anchor-ref-class-name 18 | inline-ext-class-name) 19 | 20 | (define katex-class-name (class-name "katex")) 21 | (define ref-class-name (class-name "ref")) 22 | (define list-item-class-name (class-name "list-item")) 23 | (define list-item-head-class-name (class-name "list-item-head")) 24 | (define unordered-list-class-name (class-name "unordered-list")) 25 | (define ordered-list-class-name (class-name "ordered-list")) 26 | (define href-class-name (class-name "href")) 27 | (define emph-class-name (class-name "emph")) 28 | (define display-class-name (class-name "display")) 29 | (define code-class-name (class-name "code")) 30 | (define dfn-class-name (class-name "dfn")) 31 | (define anchor-class-name (class-name "anchor")) 32 | (define anchor-ref-class-name (class-name "anchor-ref")) 33 | (define inline-ext-class-name (class-name "inline-ext")) 34 | -------------------------------------------------------------------------------- /morg/html/class/section.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide section-class-name 6 | section-title-class-name 7 | section-body-class-name 8 | section-toc-class-name) 9 | 10 | (define section-class-name (class-name "section")) 11 | (define section-title-class-name (class-name "section-title")) 12 | (define section-body-class-name (class-name "section-body")) 13 | (define section-toc-class-name (class-name "section-toc")) 14 | -------------------------------------------------------------------------------- /morg/html/class/toc.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../class.rkt") 4 | 5 | (provide toc-class-name 6 | toc-node-class-name 7 | toc-edge-class-name 8 | toc-edge-details-class-name 9 | toc-edge-summary-class-name 10 | toc-edge-summary-selected-class-name 11 | toc-edge-title-class-name) 12 | 13 | (define toc-class-name (class-name "toc")) 14 | (define toc-node-class-name (class-name "toc-node")) 15 | (define toc-edge-class-name (class-name "toc-edge")) 16 | (define toc-edge-details-class-name (class-name "toc-edge-details")) 17 | (define toc-edge-summary-class-name (class-name "toc-edge-summary")) 18 | (define toc-edge-title-class-name (class-name "toc-edge-title")) 19 | (define toc-edge-summary-selected-class-name (class-name "toc-edge-summary-selected")) 20 | -------------------------------------------------------------------------------- /morg/html/convert.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "site.rkt" 4 | "config.rkt" 5 | "../data/document.rkt") 6 | 7 | (provide ->html) 8 | 9 | (define (->html #:config [cfg : Config default-config] 10 | [doc : Document]) : Site 11 | (make-site cfg doc)) 12 | -------------------------------------------------------------------------------- /morg/html/d-pad.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/node.rkt" 4 | "../data/section.rkt" 5 | "../data/document.rkt" 6 | "../markup/inline.rkt" 7 | "../markup/xexpr.rkt" 8 | "../markup/splice.rkt" 9 | "pure-inline.rkt" 10 | "site-state.rkt" 11 | "id.rkt" 12 | "class/d-pad.rkt") 13 | 14 | (provide (struct-out d-pad-config) D-padConfig 15 | default-d-pad-config 16 | make-d-pad) 17 | 18 | (struct d-pad-config 19 | ([previous : PureInlineLike] 20 | [up : PureInlineLike] 21 | [next : PureInlineLike]) 22 | #:transparent 23 | #:type-name D-padConfig) 24 | 25 | (define default-d-pad-config 26 | (d-pad-config 27 | "←" "↑" "→")) 28 | 29 | (define (make-d-pad #:config [cfg : D-padConfig default-d-pad-config] 30 | [st : SiteState] 31 | [n : Node]) : XExprs 32 | (define f (compose pure-inline->xexprs pure-inline%)) 33 | (define previous-id 34 | (and (section-node? n) 35 | (let ([l (section-node-siblings-left n)]) 36 | (and (not (null? l)) 37 | (section-id (car l)))))) 38 | (define next-id 39 | (and (section-node? n) 40 | (let ([r (section-node-siblings-right n)]) 41 | (and (not (null? r)) 42 | (section-id (car r)))))) 43 | (define parent (node-parent n)) 44 | (define up-id 45 | (cond 46 | [(section-node? parent) (node-id parent)] 47 | [else (document-id (site-state-root st))])) 48 | (tagged% 'ol 49 | `((class ,d-pad-class-name)) 50 | (when% previous-id 51 | (tagged% 'li 52 | `((class ,d-pad-previous-class-name)) 53 | (tagged% 'a 54 | `((href ,(id->url previous-id))) 55 | (f (d-pad-config-previous cfg))))) 56 | (tagged% 'li 57 | `((class ,d-pad-up-class-name)) 58 | (tagged% 'a 59 | `((href ,(id->url up-id))) 60 | (f (d-pad-config-up cfg)))) 61 | (when% next-id 62 | (tagged% 'li 63 | `((class ,d-pad-next-class-name)) 64 | (tagged% 'a 65 | `((href ,(id->url next-id))) 66 | (f (d-pad-config-next cfg))))))) 67 | -------------------------------------------------------------------------------- /morg/html/document-toc.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "../data/id.rkt" 5 | "../markup/xexpr.rkt" 6 | "class/document-toc.rkt" 7 | "toc.rkt") 8 | 9 | (provide make-document-toc) 10 | 11 | (define (make-document-toc [doc : Document] 12 | [tr : (Option (Listof Id)) #f]) : XExprs 13 | (tagged% 'ol 14 | `((class ,document-toc-class-name)) 15 | (tagged% 'li 16 | `((class ,document-front-toc-class-name)) 17 | (make-toc (document-front doc) tr)) 18 | (tagged% 'li 19 | `((class ,document-main-toc-class-name)) 20 | (make-toc (document-main doc) tr)) 21 | (tagged% 'li 22 | `((class ,document-back-toc-class-name)) 23 | (make-toc (document-back doc) tr)))) 24 | -------------------------------------------------------------------------------- /morg/html/document.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "../data/section.rkt" 5 | "../markup/xexpr.rkt" 6 | "../text/date.rkt" 7 | "../data/index-table.rkt" 8 | "../data/anchor-table.rkt" 9 | "state.rkt" 10 | "pure-inline.rkt" 11 | "toc.rkt" 12 | "section.rkt" 13 | "block.rkt" 14 | "xexpr-table.rkt" 15 | "config.rkt" 16 | "document-toc.rkt" 17 | "class/document.rkt") 18 | 19 | (provide document->xexprs) 20 | 21 | (define ((document->xexprs [cfg : Config]) [doc : Document]) : XExprTable 22 | (define title (document-title doc)) 23 | (define author (document-author doc)) 24 | (define front (document-front doc)) 25 | (define main (document-main doc)) 26 | (define back (document-back doc)) 27 | (define st 28 | (state (document-id doc) 29 | cfg 30 | (make-index-table doc) 31 | (make-anchor-table doc))) 32 | (define tbl : XExprTable (hash)) 33 | (define (f [x : XExprTable] [ss : (Listof Section)]) 34 | (foldl (section->xexprs st) x ss)) 35 | (define tbl-1 (f tbl front)) 36 | (define tbl-2 (f tbl-1 main)) 37 | (define tbl-3 (f tbl-2 back)) 38 | (define this-xexpr 39 | (tagged% 'div 40 | `((class ,document-class-name)) 41 | (tagged% 'h1 42 | `((class ,document-title-class-name)) 43 | (pure-inline->xexprs title)) 44 | (tagged% 'address 45 | `((class ,document-address-class-name)) 46 | (tagged% 'ul 47 | `((class ,document-author-list-class-name)) 48 | (apply tagged% 'li 49 | `((class ,document-author-class-name)) 50 | (map pure-inline->xexprs 51 | author)))) 52 | (tagged% 'div 53 | `((class ,document-date-class-name)) 54 | (date->text (document-date doc))) 55 | ((block->xexprs st) (document-contents doc)) 56 | (tagged% 'nav '() 57 | (make-document-toc doc)))) 58 | (hash-set tbl-3 (document-id doc) this-xexpr)) 59 | -------------------------------------------------------------------------------- /morg/html/id.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/id.rkt" 4 | "../markup/xexpr.rkt" 5 | "../markup/string.rkt" 6 | "../text/id.rkt" 7 | "class/id.rkt") 8 | 9 | (provide id->url 10 | anchor-id->css-id 11 | id->xexprs/a) 12 | 13 | (define (id->url [i : Id]) : String 14 | (format "~a.html" (id-contents i))) 15 | 16 | (define (id->xexprs/a [i : Id]) : XExprs 17 | (tagged% 'a 18 | `((class ,id-class-name) 19 | (href ,(id->url i))) 20 | (string-tree->string (id->text i)))) 21 | 22 | (define (anchor-id->css-id [node : Id] [anchor : Id]) 23 | (string-tree->string 24 | @string%{a井@(id-contents node)井@(id-contents anchor)})) 25 | -------------------------------------------------------------------------------- /morg/html/inline.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/inline.rkt" 4 | "../markup/xexpr.rkt" 5 | "../text/id.rkt" 6 | "../data/splice.rkt" 7 | "../data/anchor-table.rkt" 8 | "../data/extension.rkt" 9 | "../markup/string.rkt" 10 | "../markup/splice.rkt" 11 | "class/inline.rkt" 12 | "state.rkt" 13 | "pure-inline.rkt" 14 | "config.rkt" 15 | "id.rkt" 16 | "splice.rkt") 17 | 18 | (provide inline->xexprs) 19 | 20 | (: inline->xexprs : (State . -> . (Inline . -> . XExprs))) 21 | 22 | (define (ref->xexprs [x : Ref]) : XExprs 23 | (define i (ref-id x)) 24 | (id->xexprs/a i)) 25 | 26 | (define #:forall (PureInline) 27 | ((anchor->xexprs [st : State] 28 | [g : (PureInline . -> . XExprs)]) 29 | [a : (Anchor PureInline)]) : XExprs 30 | (tagged% 'a 31 | `((class ,anchor-class-name) 32 | (id ,(anchor-id->css-id (state-id st) (anchor-id a)))) 33 | (g (anchor-contents a)))) 34 | 35 | (define ((anchor-ref->xexprs [st : State]) 36 | [ar : AnchorRef]) : XExprs 37 | (define id-n (anchor-ref-node ar)) 38 | (define id-a (anchor-ref-anchor ar)) 39 | (define id-this (state-id st)) 40 | (define not-this? (not (equal? id-n id-this))) 41 | (define url 42 | (string-tree->string 43 | @string%{@when%[not-this?]{@(id->url id-n)}#@(anchor-id->css-id id-n id-a)})) 44 | (define tbl (state-anchor-table st)) 45 | (define key (anchor-key id-n id-a)) 46 | (define l 47 | (cond 48 | [(anchor-table-has-key? tbl key) 49 | (pure-inline->xexprs (anchor-contents (anchor-table-ref tbl key)))] 50 | [else (anchor-id->text id-n id-a)])) 51 | (tagged% 'a 52 | `((class ,anchor-ref-class-name) 53 | (href ,url)) 54 | l)) 55 | 56 | (define #:forall (Inline) 57 | ((extension->xexprs [st : State] 58 | [f : (Inline . -> . XExprs)]) 59 | [s : (Extension (Listof Inline))]) : XExprs 60 | (define cfg (state-config st)) 61 | (define rnd (config-render-extension cfg)) 62 | (define g 63 | (ext-hash-ref rnd s (lambda () 64 | (lambda ([xs : (Listof XExprs)]) 65 | (apply xexprs% xs))))) 66 | (tagged% 'span 67 | `((class ,inline-ext-class-name)) 68 | (g (map f (extension-contents s))))) 69 | 70 | (define #:forall (PureInline Inline) 71 | ((inline-element->xexprs [st : State] 72 | [g : (PureInline . -> . XExprs)] 73 | [f : (Inline . -> . XExprs)]) 74 | [i : (InlineElement PureInline Inline)]) : XExprs 75 | (cond 76 | [(ref? i) (ref->xexprs i)] 77 | [(anchor? i) ((anchor->xexprs st g) i)] 78 | [(anchor-ref? i) ((anchor-ref->xexprs st) i)] 79 | [(extension? i) ((extension->xexprs st f) i)] 80 | [else ((pure-inline-element->xexprs f) i)])) 81 | 82 | (define ((inline->xexprs st) i) 83 | (define x (inline-contents i)) 84 | (define f (inline->xexprs st)) 85 | (define g pure-inline->xexprs) 86 | (cond 87 | [(splice? x) ((splice->xexprs f) x)] 88 | [else ((inline-element->xexprs st g f) x)])) 89 | -------------------------------------------------------------------------------- /morg/html/publish.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "config.rkt" 4 | "site.rkt" 5 | "../data/document.rkt" 6 | "convert.rkt") 7 | 8 | (require/typed racket/file 9 | [make-temporary-directory (-> Path)]) 10 | 11 | (require/typed racket/base 12 | [copy-file (Path Path Boolean . -> . Void)]) 13 | 14 | (provide ->html/publish) 15 | 16 | (define ((write-page [dir : Path]) 17 | [url : String] [contents : String]) : Void 18 | (define file (build-path dir url)) 19 | (call-with-output-file* file 20 | (lambda ([port : Output-Port]) 21 | (write-string contents port))) 22 | (void)) 23 | 24 | (define (site-publish [dst-dir : Path] [s : Site]) : Void 25 | (define tmp-dir (make-temporary-directory)) 26 | (hash-for-each s (write-page tmp-dir)) 27 | (make-directory* dst-dir) 28 | (for-each 29 | (lambda ([f : Path]) 30 | (copy-file (build-path tmp-dir f) 31 | (build-path dst-dir f) 32 | #t) 33 | (void)) 34 | (directory-list tmp-dir)) 35 | (void)) 36 | 37 | (define (->html/publish #:config [cfg : Config default-config] 38 | [doc : Document] 39 | [dst-dir : Path]) : Void 40 | (define s (->html #:config cfg doc)) 41 | (site-publish dst-dir s)) 42 | -------------------------------------------------------------------------------- /morg/html/pure-inline.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/inline.rkt" 4 | "../data/splice.rkt" 5 | "../markup/xexpr.rkt" 6 | "../markup/string.rkt" 7 | "../text/tex.rkt" 8 | "../markup/splice.rkt" 9 | "splice.rkt" 10 | "class/inline.rkt") 11 | 12 | (provide pure-inline-element->xexprs 13 | pure-inline->xexprs 14 | katex-delimiter-left 15 | katex-delimiter-right) 16 | 17 | (define (text->xexprs [x : Text]) : XExprs 18 | (xexprs% (text-contents x))) 19 | 20 | (define katex-delimiter-left "\\(") 21 | (define katex-delimiter-right "\\)") 22 | 23 | (define (math->xexprs [x : Math]) : XExprs 24 | (tagged% 'span 25 | `((class ,katex-class-name)) 26 | (string-tree-like->string* 27 | katex-delimiter-left 28 | (math-tex->text (math-contents x)) 29 | katex-delimiter-right))) 30 | 31 | (define #:forall (Inline) 32 | ((list-item->xexprs [f : (Inline . -> . XExprs)]) 33 | [i : (ListItem Inline)]) : XExprs 34 | (tagged% 'li 35 | `((class ,list-item-class-name)) 36 | (tagged% 'span 37 | `((class ,list-item-head-class-name)) 38 | (f (list-item-head i))) 39 | (f (list-item-contents i)))) 40 | 41 | (define #:forall (Inline) 42 | ((unordered-list->xexprs [f : (Inline . -> . XExprs)]) 43 | [ul : (UnorderedList Inline)]) : XExprs 44 | (tagged% 'ul 45 | `((class ,unordered-list-class-name) 46 | (style "list-style-type: none;")) 47 | (apply % (map (list-item->xexprs f) (unordered-list-contents ul))))) 48 | 49 | (define #:forall (Inline) 50 | ((ordered-list->xexprs [f : (Inline . -> . XExprs)]) 51 | [ol : (OrderedList Inline)]) : XExprs 52 | (tagged% 'ol 53 | `((class ,ordered-list-class-name) 54 | (style "list-style-type: none;")) 55 | (apply % (map (list-item->xexprs f) (ordered-list-contents ol))))) 56 | 57 | (define #:forall (Inline) 58 | ((href->xexprs [f : (Inline . -> . XExprs)]) 59 | [h : (HRef Inline)]) : XExprs 60 | (define url (href-url h)) 61 | (define contents (href-contents h)) 62 | (tagged% 'a 63 | `((class ,href-class-name) 64 | (href ,url)) 65 | (if contents 66 | (f contents) 67 | url))) 68 | 69 | (define #:forall (Inline) 70 | ((emph->xexprs [f : (Inline . -> . XExprs)]) 71 | [e : (Emph Inline)]) : XExprs 72 | (tagged% 'em 73 | `((class ,emph-class-name)) 74 | (f (emph-contents e)))) 75 | 76 | (define #:forall (Inline) 77 | ((display->xexprs [f : (Inline . -> . XExprs)]) 78 | [d : (Display Inline)]) : XExprs 79 | (tagged% 'center 80 | `((class ,display-class-name)) 81 | (f (display-contents d)))) 82 | 83 | (define #:forall (Inline) 84 | ((code->xexprs [f : (Inline . -> . XExprs)]) 85 | [c : (Code Inline)]) : XExprs 86 | (tagged% 'code 87 | `((class ,code-class-name)) 88 | (f (code-contents c)))) 89 | 90 | (define #:forall (Inline) 91 | ((dfn->xexprs [f : (Inline . -> . XExprs)]) 92 | [d : (Dfn Inline)]) : XExprs 93 | (tagged% 'dfn 94 | `((class ,dfn-class-name)) 95 | (f (dfn-contents d)))) 96 | 97 | (define #:forall (Inline) 98 | ((pure-inline-element->xexprs [f : (Inline . -> . XExprs)]) 99 | [pi : (PureInlineElement Inline)]) : XExprs 100 | (cond 101 | [(text? pi) (text->xexprs pi)] 102 | [(math? pi) (math->xexprs pi)] 103 | [(unordered-list? pi) ((unordered-list->xexprs f) pi)] 104 | [(ordered-list? pi) ((ordered-list->xexprs f) pi)] 105 | [(href? pi) ((href->xexprs f) pi)] 106 | [(emph? pi) ((emph->xexprs f) pi)] 107 | [(display? pi) ((display->xexprs f) pi)] 108 | [(code? pi) ((code->xexprs f) pi)] 109 | [(dfn? pi) ((dfn->xexprs f) pi)])) 110 | 111 | (define (pure-inline->xexprs [pi : PureInline]) : XExprs 112 | (define x (pure-inline-contents pi)) 113 | (define f pure-inline->xexprs) 114 | (cond 115 | [(splice? x) ((splice->xexprs f) x)] 116 | [else ((pure-inline-element->xexprs f) x)])) 117 | -------------------------------------------------------------------------------- /morg/html/section.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/section.rkt" 4 | "../data/article.rkt" 5 | "../data/block.rkt" 6 | "../data/id.rkt" 7 | "../markup/xexpr.rkt" 8 | "article.rkt" 9 | "class/section.rkt" 10 | "pure-inline.rkt" 11 | "block.rkt" 12 | "toc.rkt" 13 | "id.rkt" 14 | "state.rkt" 15 | "xexpr-table.rkt") 16 | 17 | (provide section->xexprs) 18 | 19 | (define ((article->xexprs* [st : State]) [a : Article] [xtbl : XExprTable]) : XExprTable 20 | (hash-set xtbl (article-id a) ((article->xexprs st) a))) 21 | 22 | (define ((section-element->xexprs [st : State] [xtbl : XExprTable]) 23 | [e : SectionElement]) : XExprs 24 | (cond 25 | [(article? e) (hash-ref xtbl (article-id e))] 26 | [(block? e) ((block->xexprs st) e)])) 27 | 28 | (: section->xexprs : (State . -> . (Section XExprTable . -> . XExprTable))) 29 | 30 | (define ((section->xexprs st-1) s xtbl) 31 | (define i (section-id s)) 32 | (define st 33 | (struct-copy state st-1 34 | [id i])) 35 | (define xtbl-1 36 | (foldl (article->xexprs* st) xtbl (section-articles s))) 37 | (define xtbl-2 38 | (foldl (section->xexprs st) xtbl-1 (section-subsections s))) 39 | (define this-xexpr 40 | (tagged% 'section 41 | `((class ,section-class-name)) 42 | (tagged% 'h1 43 | `((class ,section-title-class-name)) 44 | (id->xexprs/a i) 45 | " " 46 | (pure-inline->xexprs (section-title s))) 47 | (apply tagged% 48 | 'div 49 | `((class ,section-body-class-name)) 50 | (map (section-element->xexprs st xtbl-2) 51 | (section-contents s))) 52 | (tagged% 'nav 53 | `((class ,section-toc-class-name)) 54 | (make-toc (section-subsections s))))) 55 | (hash-set xtbl-2 i this-xexpr)) 56 | -------------------------------------------------------------------------------- /morg/html/site-state.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/node.rkt" 4 | "../data/document.rkt") 5 | 6 | (provide (struct-out site-state) SiteState) 7 | 8 | (struct site-state 9 | ([front : NodeTable] 10 | [main : NodeTable] 11 | [back : NodeTable] 12 | [root : Document]) 13 | #:transparent 14 | #:type-name SiteState) 15 | -------------------------------------------------------------------------------- /morg/html/site.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require (prefix-in xml: typed/xml) 4 | (prefix-in url: typed/net/url) 5 | "../data/document.rkt" 6 | "../data/node.rkt" 7 | "../data/id.rkt" 8 | "../data/section.rkt" 9 | "../data/article.rkt" 10 | "../markup/xexpr.rkt" 11 | "../markup/string.rkt" 12 | "../markup/inline.rkt" 13 | "../markup/splice.rkt" 14 | "../text/id.rkt" 15 | "../util/escape.rkt" 16 | "../util/option.rkt" 17 | "../text/inline.rkt" 18 | "pure-inline.rkt" 19 | "id.rkt" 20 | "document.rkt" 21 | "config.rkt" 22 | "site-state.rkt" 23 | "class/inline.rkt") 24 | 25 | (require/typed racket/hash 26 | [hash-union ((HashTable String String) (HashTable String String) . -> . (HashTable String String))]) 27 | 28 | (provide Site 29 | make-site) 30 | 31 | (define-type Site 32 | (HashTable String String)) 33 | 34 | (define og-prefix "og:") 35 | 36 | (define (og-meta [property : String] 37 | [content : StringTreeLike]) 38 | (tagged% 'meta 39 | `((property ,(string-append og-prefix property)) 40 | (content ,(string-tree-like->string content))))) 41 | 42 | (define ((apply-template [cfg : Config] [st : SiteState]) 43 | [i : Id] [x : XExprs]) : (Values String String) 44 | (define n (site-state-node-ref st i)) 45 | (define head 46 | (((config-head-template cfg) st n) 47 | (head-init cfg st n))) 48 | (define body 49 | (((config-body-template cfg) st n) 50 | (tagged% 'main '() x))) 51 | (define html 52 | (car 53 | (tagged% 'html '() 54 | (tagged% 'head 55 | `((prefix 56 | ,(format "~a https://ogp.me/ns#" 57 | og-prefix))) 58 | head) 59 | (tagged% 'body '() body)))) 60 | (values (id->url i) 61 | (parameterize ([xml:current-unescaped-tags xml:html-unescaped-tags] 62 | [xml:empty-tag-shorthand xml:html-empty-tags]) 63 | (string-append 64 | "\n" 65 | (xml:xexpr->string html))))) 66 | 67 | (define (make-site [cfg : Config] [doc : Document]) : Site 68 | (define pages 69 | ((document->xexprs cfg) doc)) 70 | (define st 71 | (site-state 72 | (make-node-table (document-front doc)) 73 | (make-node-table (document-main doc)) 74 | (make-node-table (document-back doc)) 75 | doc)) 76 | (define site 77 | (hash-map/copy pages (apply-template cfg st))) 78 | (define assets 79 | (hash-map/copy (config-assets cfg) 80 | (lambda ([k : String] [x : StringTreeLike]) 81 | (values k (string-tree-like->string x))))) 82 | (hash-union site assets)) 83 | 84 | (define (js-escape [x : String]) 85 | (escape (hash "\\" "\\\\") x)) 86 | 87 | (define (head-init [cfg : Config] [st : SiteState] [n : (U Node Document)]) : XExprs 88 | (define doc (site-state-root st)) 89 | (define doc-title (document-title doc)) 90 | (define base-url (config-base-url cfg)) 91 | (define url 92 | (and base-url 93 | (cond 94 | [(document? n) base-url] 95 | [else 96 | (url:combine-url/relative 97 | base-url 98 | (id->url (node-id n)))]))) 99 | (define page-title 100 | (cond 101 | [(document? n) doc-title] 102 | [(section-node? n) 103 | (section-title (section-node-contents n))] 104 | [(article-node? n) 105 | (define a (article-node-contents n)) 106 | (define t (article-title a)) 107 | (if t t (pure-inline% (id->text (article-id a))))])) 108 | (define title 109 | (cond 110 | [(document? n) doc-title] 111 | [else 112 | @pure-inline%{@|page-title| -- @|doc-title|}])) 113 | (define doc-description (document-description doc)) 114 | (define description-1 115 | (cond 116 | [(document? n) doc-description] 117 | [(section-node? n) 118 | (or (section-description (section-node-contents n)) 119 | doc-description)] 120 | [(article-node? n) 121 | (or (article-description (article-node-contents n)) 122 | doc-description)])) 123 | (define description 124 | (option-map (string-tree->string . compose . pure-inline->text) 125 | description-1)) 126 | (xexprs% 127 | (tagged% 'meta '((charset "UTF-8"))) 128 | (tagged% 'meta '((name "viewport") 129 | (content "width=device-width,initial-scale=1"))) 130 | (tagged% 'title '() 131 | (pure-inline->xexprs title)) 132 | (tagged% 'link 133 | '((rel "stylesheet") 134 | (href "https://cdn.jsdelivr.net/npm/katex@0.16.7/dist/katex.min.css") 135 | (integrity "sha384-3UiQGuEI4TTMaFmGIZumfRPtfKQ3trwQE2JgosJxCnGmQpL/lJdjpcHkaaFwHlcI") 136 | (crossorigin "anonymous"))) 137 | (og-meta "title" (pure-inline->text page-title)) 138 | (og-meta "site_name" (pure-inline->text doc-title)) 139 | (og-meta "type" (if (document? n) "website" "article")) 140 | (when% url 141 | (og-meta "url" (url:url->string url))) 142 | (when% description 143 | (tagged% 'meta `((name "description") 144 | (content ,description))) 145 | (og-meta "description" description)) 146 | (tagged% 'script 147 | '((defer "true") 148 | (src "https://cdn.jsdelivr.net/npm/katex@0.16.7/dist/katex.min.js") 149 | (integrity "sha384-G0zcxDFp5LWZtDuRMnBkk3EphCK1lhEf4UEyEM693ka574TZGwo4IWwS6QLzM/2t") 150 | (crossorigin "anonymous"))) 151 | (tagged% 'script 152 | '((defer "true") 153 | (src "https://cdn.jsdelivr.net/npm/katex@0.16.7/dist/contrib/auto-render.min.js") 154 | (integrity "sha384-+VBxd3r6XgURycqtZ117nYw44OOcIax56Z4dCRWbxyPt0Koah1uHoK0o4+/RRE05") 155 | (crossorigin "anonymous"))) 156 | (tagged% 'script '() 157 | @string%{ 158 | document.addEventListener("DOMContentLoaded", function() { 159 | const elems = document.getElementsByClassName('@|katex-class-name|'); 160 | for(let i = 0; i < elems.length; i++) { 161 | renderMathInElement(elems[i], { 162 | delimiters: [ 163 | {left: '@(js-escape katex-delimiter-left)', 164 | right: '@(js-escape katex-delimiter-right)', 165 | display: false} 166 | ] 167 | }); 168 | } 169 | }); 170 | }))) 171 | -------------------------------------------------------------------------------- /morg/html/splice.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/splice.rkt" 4 | "../markup/xexpr.rkt") 5 | 6 | (provide splice->xexprs) 7 | 8 | (define #:forall (X) 9 | ((splice->xexprs [f : (X . -> . XExprs)]) 10 | [x : (Splice X)]) : XExprs 11 | (xexprs% (splice-map f x))) 12 | -------------------------------------------------------------------------------- /morg/html/state.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/index-table.rkt" 4 | "../data/id.rkt" 5 | "config.rkt" 6 | "../data/anchor-table.rkt") 7 | 8 | (provide (struct-out state) State) 9 | 10 | (struct state 11 | ([id : Id] 12 | [config : Config] 13 | [index-table : IndexTable] 14 | [anchor-table : AnchorTable]) 15 | #:transparent 16 | #:type-name State) 17 | -------------------------------------------------------------------------------- /morg/html/toc.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/section.rkt" 4 | "../data/id.rkt" 5 | "../markup/xexpr.rkt" 6 | "class/toc.rkt" 7 | "pure-inline.rkt" 8 | "id.rkt") 9 | 10 | (provide make-toc) 11 | 12 | (define (make-toc [ss : (Listof Section)] 13 | [tr : (Option (Listof Id)) #f]) : XExprs 14 | (tagged% 'div 15 | `((class ,toc-class-name)) 16 | ((make-toc:aux tr) ss))) 17 | 18 | (: make-toc:aux : ((Option (Listof Id)) . -> . ((Listof Section) . -> . XExprs))) 19 | 20 | (define ((make-toc:aux tr) ss) 21 | (apply tagged% 'ul 22 | `((class ,toc-node-class-name)) 23 | (map (make-toc:aux-1 tr) ss))) 24 | 25 | (: make-toc:aux-1 : ((Option (Listof Id)) . -> . (Section . -> . XExprs))) 26 | 27 | (define ((make-toc:aux-1 tr) s) 28 | (define i (section-id s)) 29 | (define title (section-title s)) 30 | (define-values (c tr-1) 31 | (match tr 32 | [(list* j tr) 33 | #:when (eq? i j) 34 | (values 35 | (if (null? tr) 36 | 'select 37 | 'open) 38 | tr)] 39 | [_ (values #f #f)])) 40 | (tagged% 'li 41 | `((class ,toc-edge-class-name)) 42 | (tagged% 'details 43 | `((class ,toc-edge-details-class-name) 44 | ,@(case c 45 | [(open) `((open "true"))] 46 | [else '()])) 47 | (tagged% 'summary 48 | `((class ,(case c 49 | [(select) toc-edge-summary-selected-class-name] 50 | [else toc-edge-summary-class-name]))) 51 | (tagged% 'a 52 | `((class ,toc-edge-title-class-name) 53 | (href ,(id->url i))) 54 | (pure-inline->xexprs title))) 55 | ((make-toc:aux tr-1) (section-subsections s))))) 56 | -------------------------------------------------------------------------------- /morg/html/xexpr-table.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../markup/xexpr.rkt" 4 | "../data/id.rkt") 5 | 6 | (provide XExprTable) 7 | 8 | (define-type XExprTable (HashTable Id XExprs)) 9 | -------------------------------------------------------------------------------- /morg/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("scribblings/morg.scrbl" ()))) 4 | (define raco-commands 5 | '(("morg" (submod morg/command main) "run MOrg" #f))) 6 | -------------------------------------------------------------------------------- /morg/lang/id.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (module+ test 4 | (require typed/rackunit)) 5 | 6 | (provide (rename-out [get-current-id current-id])) 7 | 8 | (module parameter typed/racket 9 | (provide current-id) 10 | 11 | (define current-id : (Parameterof String) 12 | (make-parameter "!!!Invalid id!!!"))) 13 | 14 | (require 'parameter) 15 | 16 | (module+ test 17 | (require "../data/id.rkt") 18 | (check-exn 19 | exn:fail? 20 | (lambda () 21 | (id (current-id))))) 22 | 23 | (define (get-current-id) 24 | (current-id)) 25 | -------------------------------------------------------------------------------- /morg/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require syntax/strip-context 4 | (prefix-in at: scribble/reader) 5 | (submod "../markup/syntax.rkt" tools)) 6 | 7 | (provide 8 | (rename-out 9 | [morg-read read] 10 | [morg-read-syntax read-syntax])) 11 | 12 | (define (morg-read in) 13 | (syntax->datum 14 | (morg-read-syntax #f in))) 15 | 16 | (define (morg-read-syntax* src in acc) 17 | (define stx (at:read-syntax src in)) 18 | (cond 19 | [(eof-object? stx) (reverse acc)] 20 | [else (morg-read-syntax* src in (list* stx acc))])) 21 | 22 | (define (morg-read-syntax src in) 23 | (with-syntax ([(form ... result) (morg-read-syntax* src in (list))] 24 | [id (path->id src)] 25 | [provide-part-1 (gensym "provide-part-1")]) 26 | (strip-context 27 | #'(module ignored typed/racket 28 | (require morg 29 | morg/lang/id) 30 | 31 | (let () 32 | (local-require (submod morg/lang/id parameter)) 33 | (current-id id)) 34 | 35 | form ... 36 | 37 | (require (rename-in (submod morg/markup/syntax internal) 38 | [provide-part-0 provide-part-1])) 39 | 40 | (provide-part-1 result) 41 | 42 | (module+ main 43 | (require morg/text/preview) 44 | (preview)))))) 45 | -------------------------------------------------------------------------------- /morg/language.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (module+ test 4 | (require typed/rackunit)) 5 | 6 | (provide (rename-out [get-current-id current-id])) 7 | 8 | (module parameter typed/racket 9 | (provide current-id) 10 | 11 | (define current-id : (Parameterof String) 12 | (make-parameter "!!!Invalid id!!!"))) 13 | 14 | (require 'parameter) 15 | 16 | (module+ test 17 | (require "data/id.rkt") 18 | (check-exn 19 | exn:fail? 20 | (lambda () 21 | (id (current-id))))) 22 | 23 | (define (get-current-id) 24 | (current-id)) 25 | -------------------------------------------------------------------------------- /morg/latex.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "latex/config.rkt" 4 | "markup/tex.rkt") 5 | 6 | (provide 7 | (struct-out config) Config 8 | (struct-out package) Package 9 | provide-config 10 | default-config 11 | article-config 12 | book-config 13 | TextTeXLike 14 | (rename-out 15 | [text-tex% text-tex] 16 | [argument% argument] 17 | [optional-argument% optional-argument] 18 | [star-argument% star-argument] 19 | [macro% macro] 20 | [macro-1% macro-1] 21 | [group% group] 22 | [special% special] 23 | [options% options] 24 | [environment% environment])) 25 | -------------------------------------------------------------------------------- /morg/latex/article.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/article.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../markup/tex.rkt" 6 | "../markup/splice.rkt" 7 | "../data/node.rkt" 8 | "../text/numbering.rkt" 9 | "block.rkt" 10 | "inline.rkt" 11 | "id.rkt" 12 | "state.rkt") 13 | 14 | (provide article->latex) 15 | 16 | (define (header-style . [xs : TextTeXLike *]) 17 | @macro%["textbf" (argument% (apply % xs))]) 18 | 19 | (define label-skip 20 | @macro%["hspace" @argument%{@macro%["labelsep"]}]) 21 | 22 | (define ((proof->latex [st : State]) 23 | [p : Proof]) : tex:TextTeX 24 | (define arg 25 | @optional-argument%{@|label-skip|@header-style{@(pure-inline->latex (proof-header p))}:}) 26 | @text-tex%{ 27 | @environment%["trivlist"]{ 28 | @macro%["item" arg] 29 | @(strip-first-par 30 | ((block->latex st) (proof-contents p))) 31 | @macro%["hfill"] 32 | @macro%["blacksquare"] 33 | } 34 | }) 35 | 36 | (define ((article->latex [st-1 : State]) 37 | [a : Article]) : tex:TextTeX 38 | (define id (article-id a)) 39 | (define st 40 | (struct-copy state st-1 41 | [id id])) 42 | (define tbl (state-node-table st)) 43 | (define in? (node-table-has-key? tbl id)) 44 | (define num : TextTeXLike 45 | (cond 46 | [in? 47 | (define nd (cast (node-table-ref tbl id) ArticleNode)) 48 | (define n (article-node-format-index nd)) 49 | @%{@header-style{@|n|} }] 50 | [else @%{}])) 51 | (define h : TextTeXLike 52 | @%{@header-style{@(pure-inline->latex (article-header a))}}) 53 | (define title (article-title a)) 54 | (define t : TextTeXLike 55 | @when%[title]{ (@(pure-inline->latex title))}) 56 | (define arg 57 | @optional-argument%{@|label-skip|@|num|@|h|@|t|:}) 58 | (define pf 59 | (article-proof a)) 60 | @text-tex%{ 61 | @environment%["trivlist"]{ 62 | @macro%["item" arg] 63 | @(id->hypertarget id)@(id->latex/margin id) 64 | @(strip-first-par 65 | ((block->latex st) (article-contents a))) 66 | } 67 | @when%[pf]{@((proof->latex st) pf)} 68 | }) 69 | -------------------------------------------------------------------------------- /morg/latex/block.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/block.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../data/splice.rkt" 6 | "../markup/tex.rkt" 7 | "../markup/index.rkt" 8 | "../data/index-table.rkt" 9 | "inline.rkt" 10 | "splice.rkt" 11 | "state.rkt" 12 | "config.rkt") 13 | 14 | (provide block->latex 15 | strip-first-par) 16 | 17 | (: block->latex : (State . -> . (Block . -> . tex:TextTeX))) 18 | 19 | (define par @macro%["par"]) 20 | 21 | (define ((paragraph->latex [st : State]) 22 | [x : Paragraph]) : tex:TextTeX 23 | @text-tex%{ 24 | @|par|@((inline->latex st) (paragraph-contents x)) 25 | }) 26 | 27 | (define ((print-index->latex [st : State]) 28 | [p : PrintIndex]) : tex:TextTeX 29 | (define cfg (state-config st)) 30 | (define n (config-index-num-columns cfg)) 31 | (define tbl (state-index-table st)) 32 | (define type (print-index-type p)) 33 | (define in? (index-table-has-key? tbl type)) 34 | (cond 35 | [in? 36 | @text-tex%{ 37 | @((inst environment% TextTeXLike) "multicols" 38 | #:arguments (list @argument%[(number->string n)]) 39 | @((inline->latex st) (index-list->inline (index-table-ref tbl type)))) 40 | }] 41 | [else @text-tex%{}])) 42 | 43 | (define ((block->latex st) b) 44 | (define x (block-contents b)) 45 | (cond 46 | [(paragraph? x) ((paragraph->latex st) x)] 47 | [(print-index? x) ((print-index->latex st) x)] 48 | [(splice? x) ((splice->latex (block->latex st)) x)] 49 | [else (error "Unimplemented.")])) 50 | 51 | (: strip-first-par : (tex:TextTeX . -> . tex:TextTeX)) 52 | 53 | (define (strip-first-par x) 54 | (define c (tex:text-tex-contents x)) 55 | (match c 56 | [(tex:atom a) 57 | #:when (a . equal? . par) 58 | @text-tex%{}] 59 | [(splice (list* y r)) 60 | (apply text-tex% (strip-first-par y) r)] 61 | [_ x])) 62 | -------------------------------------------------------------------------------- /morg/latex/config.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/tex.rkt" 4 | "../data/extension.rkt" 5 | "../markup/string.rkt" 6 | "../markup/tex.rkt" 7 | (prefix-in text: "../text/config.rkt")) 8 | 9 | (require (for-syntax typed/racket)) 10 | 11 | (provide (struct-out config) Config 12 | config-make-section-ref% 13 | Option OptionList 14 | (struct-out package) Package 15 | provide-config 16 | dynamic-require-config 17 | article-config 18 | book-config 19 | default-config) 20 | 21 | (define-type Option 22 | (U String (Pairof String TextTeXLike))) 23 | 24 | (define-type OptionList 25 | (Listof Option)) 26 | 27 | (struct package 28 | ([name : String] 29 | [options : OptionList]) 30 | #:transparent 31 | #:type-name Package) 32 | 33 | (struct config 34 | ([section-macros : (Listof String)] 35 | [section-macro-fallback : String] 36 | [class : String] 37 | [class-options : OptionList] 38 | [packages : (Listof Package)] 39 | [make-section-ref : (Natural String . -> . TextTeXLike)] 40 | [render-extension : (ExtHash ((Listof TextTeXLike) . -> . TextTeXLike))] 41 | [index-num-columns : Exact-Positive-Integer] 42 | [front-matter : TextTeXLike] 43 | [main-matter : TextTeXLike] 44 | [back-matter : TextTeXLike]) 45 | #:transparent 46 | #:type-name Config) 47 | 48 | (define ((config-make-section-ref% [cfg : Config]) 49 | [depth : Natural] . [num : StringTreeLike *]) 50 | ((config-make-section-ref cfg) depth (apply string-tree-like->string* num))) 51 | 52 | (define (default-config:make-section-ref [depth : Natural] [num : String]) 53 | @text-tex%{@((text:config-make-section-ref text:default-config) depth num)}) 54 | 55 | (define default-config 56 | (config 57 | '("section" "subsection" "subsubsection" "paragraph") 58 | "subparagraph" 59 | "article" 60 | '() 61 | '() 62 | default-config:make-section-ref 63 | (empty-ext-hash) 64 | 2 65 | @text-tex%{} 66 | @text-tex%{} 67 | @text-tex%{})) 68 | 69 | (define article-config default-config) 70 | 71 | (define (book-config:make-section-ref [depth : Natural] [num : String]) 72 | (define x 73 | (if (depth . <= . 1) 74 | "Chapter" 75 | "Section")) 76 | @text-tex%{@|x| @|num|}) 77 | 78 | (define book-config 79 | (struct-copy config default-config 80 | [front-matter @text-tex%{@macro%{frontmatter}}] 81 | [main-matter @text-tex%{@macro%{mainmatter}}] 82 | [back-matter @text-tex%{@macro%{backmatter}}] 83 | [section-macros '("chapter" "section" "subsection" "subsubsection" "paragraph")] 84 | [section-macro-fallback "subparagraph"] 85 | [make-section-ref book-config:make-section-ref] 86 | [class "book"])) 87 | 88 | (define-for-syntax config-export #'config) 89 | 90 | (define-syntax (config-export stx) 91 | (with-syntax ([cfg config-export]) 92 | #''cfg)) 93 | 94 | (define-syntax (provide-config stx) 95 | (syntax-case stx () 96 | [(_ body ...) 97 | (with-syntax ([cfg config-export]) 98 | #'(begin 99 | (provide (rename-out [cfg:local cfg])) 100 | (define cfg:local : Config 101 | (let () 102 | body ...))))])) 103 | 104 | (define (dynamic-require-config [mod : Module-Path]) : Config 105 | (assert (dynamic-require mod (config-export)) config?)) 106 | -------------------------------------------------------------------------------- /morg/latex/convert.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "document.rkt" 5 | "config.rkt" 6 | "../text/tex.rkt" 7 | "../markup/string.rkt") 8 | 9 | (provide ->latex) 10 | 11 | (define (->latex #:config [cfg : Config default-config] 12 | [doc : (U Document)]) : String 13 | (define x 14 | (cond 15 | [(document? doc) ((document->latex cfg) doc)])) 16 | (define y (text-tex->text x)) 17 | (string-tree->string y)) 18 | -------------------------------------------------------------------------------- /morg/latex/document.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/document.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../data/node.rkt" 6 | "../data/index-table.rkt" 7 | "../data/anchor-table.rkt" 8 | "../markup/tex.rkt" 9 | "../markup/splice.rkt" 10 | "../util/list.rkt" 11 | "../text/date.rkt" 12 | "section.rkt" 13 | "inline.rkt" 14 | "block.rkt" 15 | "state.rkt" 16 | "config.rkt") 17 | 18 | (provide document->latex) 19 | 20 | (define (use-package [pkg : String]) 21 | @macro%["usepackage" @argument%{@|pkg|}]) 22 | 23 | (define (pass-options-to-package [pkg : String] 24 | . [xs : Option *]) 25 | @macro%["PassOptionsToPackage" 26 | @argument%{@(apply options% xs)} 27 | @argument%{@|pkg|} 28 | ]) 29 | 30 | (define (set-counter [cnt : String] [n : Integer]) 31 | @macro%["setcounter" @argument%{@|cnt|} @argument%{@(number->string n)}]) 32 | 33 | (define ((document->latex [cfg : Config]) 34 | [doc : Document]) : tex:TextTeX 35 | (define front (document-front doc)) 36 | (define main (document-main doc)) 37 | (define back (document-back doc)) 38 | (define tbl (make-node-table main)) 39 | (define untbl-1 (make-node-table front)) 40 | (define untbl (make-node-table back #:init untbl-1)) 41 | (define st 42 | (state cfg 43 | (document-id doc) 44 | (make-index-table doc) 45 | (make-anchor-table doc) 46 | tbl untbl)) 47 | (define cls @argument%{@(config-class cfg)}) 48 | (define cls-opt @optional-argument%{@(apply options% (config-class-options cfg))}) 49 | (define f (section->latex st)) 50 | (define g pure-inline->latex) 51 | (define h (block->latex st)) 52 | (define pkgs (config-packages cfg)) 53 | @text-tex%{ 54 | @pass-options-to-package["hyperref" 55 | "pdfusetitle" 56 | '("pdfencoding" . "auto") 57 | "psdextra" 58 | ] 59 | @pass-options-to-package["url" 60 | "hyphens" 61 | ] 62 | @(apply % 63 | (map (lambda ([p : Package]) 64 | (apply pass-options-to-package (package-name p) (package-options p))) 65 | pkgs)) 66 | @macro%["documentclass" cls-opt cls] 67 | 68 | @(use-package "hyperref") 69 | @(use-package "xcolor") 70 | @(use-package "multicol") 71 | @(use-package "marginnote") 72 | @(use-package "amssymb") 73 | @(apply % 74 | (map (lambda ([p : Package]) 75 | (use-package (package-name p))) 76 | pkgs)) 77 | 78 | @(set-counter "secnumdepth" -100) 79 | @(set-counter "tocdepth" 100) 80 | 81 | @macro%["title" @argument%{@(g (document-title doc))}] 82 | @macro%["author" (apply argument% (list-join-1 (map g (document-author doc)) @macro%["and"]))] 83 | @macro%["date" @argument%{@(date->text (document-date doc))}] 84 | 85 | @environment%["document"]{ 86 | @(config-front-matter cfg) 87 | @macro%["maketitle"] 88 | @(h (document-contents doc)) 89 | @(apply % (map f front)) 90 | @macro%["tableofcontents"] 91 | @(config-main-matter cfg) 92 | @(apply % (map f main)) 93 | @(config-back-matter cfg) 94 | @(apply % (map f back)) 95 | } 96 | }) 97 | -------------------------------------------------------------------------------- /morg/latex/id.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/id.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../text/id.rkt" 6 | "../markup/tex.rkt" 7 | "../markup/splice.rkt") 8 | 9 | (provide id->latex 10 | anchor-id->latex 11 | id->latex/margin 12 | anchor-id->hypertarget 13 | anchor-id->hyperlink 14 | id->hypertarget 15 | id->hyperlink) 16 | 17 | (define (id-style [a : TextTeXLike]) 18 | @macro%["textcolor" @argument%{gray} @argument%{@macro%["normalsize"]@macro%["texttt" @argument%{@|a|}]}]) 19 | 20 | (define (id->latex [i : Id]) 21 | (id-style (id->text i))) 22 | 23 | (define (anchor-id->latex [node : Id] [anchor : Id]) 24 | (id-style (anchor-id->text node anchor))) 25 | 26 | (define (id->latex/margin [i : Id]) 27 | @macro%["marginnote" @argument%{@(id->latex i)}]) 28 | 29 | (define (id->label [i : Id]) 30 | @text-tex%{morg-generated!@(id-contents i)}) 31 | 32 | (define (hypertarget [label : TextTeXLike] [text : TextTeXLike]) 33 | @macro%["hypertarget" @argument%{@|label|} @argument%{@|text|}]) 34 | 35 | (define (hyperlink [label : TextTeXLike] [text : TextTeXLike]) 36 | @macro%["hyperlink" @argument%{@|label|} @argument%{@|text|}]) 37 | 38 | (define (id->hypertarget [i : Id]) 39 | (hypertarget (id->label i) "")) 40 | 41 | (define (id->hyperlink [i : Id] [x : TextTeXLike]) 42 | (hyperlink (id->label i) x)) 43 | 44 | (define (anchor-id->label [node : Id] [anchor : Id]) 45 | @text-tex%{morg-generated-anchor!@(id-contents node)!@(id-contents anchor)}) 46 | 47 | (define (anchor-id->hypertarget [node : Id] [anchor : Id] [label : TextTeXLike]) 48 | (hypertarget (anchor-id->label node anchor) label)) 49 | 50 | (define (anchor-id->hyperlink [node : Id] [anchor : Id] [label : TextTeXLike]) 51 | (hyperlink (anchor-id->label node anchor) label)) 52 | -------------------------------------------------------------------------------- /morg/latex/inline.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/inline.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../data/node.rkt" 6 | "../data/article.rkt" 7 | "../data/splice.rkt" 8 | "../data/anchor-table.rkt" 9 | "../data/extension.rkt" 10 | "../markup/tex.rkt" 11 | "../markup/splice.rkt" 12 | "../text/numbering.rkt" 13 | "id.rkt" 14 | "splice.rkt" 15 | "state.rkt" 16 | "config.rkt") 17 | 18 | (provide inline->latex 19 | pure-inline->latex) 20 | 21 | (: inline->latex : (State . -> . (Inline . -> . tex:TextTeX))) 22 | (: pure-inline->latex : (PureInline . -> . tex:TextTeX)) 23 | 24 | (define (text->latex [x : Text]) : tex:TextTeX 25 | @text-tex%{@(text-contents x)}) 26 | 27 | (define ((ref->latex [st : State]) 28 | [x : Ref]) : tex:TextTeX 29 | (define i (ref-id x)) 30 | (define tbl (state-node-table st)) 31 | (define in? (node-table-has-key? tbl i)) 32 | (define text : TextTeXLike 33 | (cond 34 | [in? 35 | (define nd (node-table-ref tbl i)) 36 | (cond 37 | [(section-node? nd) 38 | (define mk (config-make-section-ref% (state-config st))) 39 | @(mk (length (node-trace nd)) 40 | (section-node-format-index nd))] 41 | [(article-node? nd) 42 | (define a (article-node-contents nd)) 43 | @%{@(pure-inline->latex (article-header a)) @(article-node-format-index nd)}])] 44 | [else (id->latex i)])) 45 | @text-tex%{@(id->hyperlink i text)}) 46 | 47 | (define (math->latex [x : Math]) : tex:TextTeX 48 | (tex:text-tex (tex:math (math-contents x)))) 49 | 50 | (define #:forall (Inline) 51 | ((list-item->latex [f : (Inline . -> . tex:TextTeX)]) 52 | [i : (ListItem Inline)]) : tex:TextTeX 53 | (define itm 54 | @macro%["item" @optional-argument%{@(f (list-item-head i))}]) 55 | @text-tex%{@|itm|@(f (list-item-contents i))}) 56 | 57 | (define #:forall (Inline) 58 | ((unordered-list->latex [f : (Inline . -> . tex:TextTeX)]) 59 | [ul : (UnorderedList Inline)]) : tex:TextTeX 60 | @text-tex%{ 61 | @environment%["itemize"]{ 62 | @(apply % (map (list-item->latex f) (unordered-list-contents ul))) 63 | } 64 | }) 65 | 66 | (define #:forall (Inline) 67 | ((ordered-list->latex [f : (Inline . -> . tex:TextTeX)]) 68 | [ol : (OrderedList Inline)]) : tex:TextTeX 69 | @text-tex%{ 70 | @environment%["enumerate"]{ 71 | @(apply % (map (list-item->latex f) (ordered-list-contents ol))) 72 | } 73 | }) 74 | 75 | (define #:forall (Inline) 76 | ((href->latex [f : (Inline . -> . tex:TextTeX)]) 77 | [h : (HRef Inline)]) : tex:TextTeX 78 | (define url (href-url h)) 79 | (define contents (href-contents h)) 80 | (define x @text-tex%{@macro%["url" @argument%{@|url|}]}) 81 | (if contents 82 | @text-tex%{@(f contents)@macro%["footnote" @argument%{@|x|}]} 83 | x)) 84 | 85 | (define #:forall (Inline) 86 | ((emph->latex [f : (Inline . -> . tex:TextTeX)]) 87 | [e : (Emph Inline)]) : tex:TextTeX 88 | @text-tex%{@macro%["emph" @argument%{@(f (emph-contents e))}]}) 89 | 90 | (define #:forall (Inline) 91 | ((display->latex [f : (Inline . -> . tex:TextTeX)]) 92 | [d : (Display Inline)]) : tex:TextTeX 93 | @text-tex%{@environment%["center"]{ 94 | @(f (display-contents d)) 95 | }}) 96 | 97 | (define #:forall (Inline) 98 | ((code->latex [f : (Inline . -> . tex:TextTeX)]) 99 | [c : (Code Inline)]) : tex:TextTeX 100 | @text-tex%{@macro%["texttt" @argument%{@(f (code-contents c))}]}) 101 | 102 | (define #:forall (Inline) 103 | ((dfn->latex [f : (Inline . -> . tex:TextTeX)]) 104 | [d : (Dfn Inline)]) : tex:TextTeX 105 | @text-tex%{@macro%["emph" @argument%{@(f (dfn-contents d))}]}) 106 | 107 | (define #:forall (Inline) 108 | ((pure-inline-element->latex [f : (Inline . -> . tex:TextTeX)]) 109 | [x : (PureInlineElement Inline)]) : tex:TextTeX 110 | (cond 111 | [(text? x) (text->latex x)] 112 | [(math? x) (math->latex x)] 113 | [(unordered-list? x) ((unordered-list->latex f) x)] 114 | [(ordered-list? x) ((ordered-list->latex f) x)] 115 | [(href? x) ((href->latex f) x)] 116 | [(emph? x) ((emph->latex f) x)] 117 | [(display? x) ((display->latex f) x)] 118 | [(code? x) ((code->latex f) x)] 119 | [(dfn? x) ((dfn->latex f) x)])) 120 | 121 | (define #:forall (PureInline) 122 | ((anchor->latex [st : State] 123 | [g : (PureInline . -> . tex:TextTeX)]) 124 | [a : (Anchor PureInline)]) : tex:TextTeX 125 | (define id-n (state-id st)) 126 | (define id-a (anchor-id a)) 127 | (define l (g (anchor-contents a))) 128 | @text-tex%{@(anchor-id->hypertarget id-n id-a l)}) 129 | 130 | (define ((anchor-ref->latex [st : State]) 131 | [ar : AnchorRef]) : tex:TextTeX 132 | (define id-n (anchor-ref-node ar)) 133 | (define id-a (anchor-ref-anchor ar)) 134 | (define key (anchor-key id-n id-a)) 135 | (define tbl (state-anchor-table st)) 136 | (cond 137 | [(anchor-table-has-key? tbl key) 138 | (define a (anchor-table-ref tbl key)) 139 | (define l (pure-inline->latex (anchor-contents a))) 140 | @text-tex%{@(anchor-id->hyperlink id-n id-a l)}] 141 | [else @text-tex%{@(anchor-id->latex id-n id-a)}])) 142 | 143 | (define #:forall (Inline) 144 | ((extension->latex [st : State] 145 | [f : (Inline . -> . tex:TextTeX)]) 146 | [s : (Extension (Listof Inline))]) : tex:TextTeX 147 | (define cfg (state-config st)) 148 | (define rnd (config-render-extension cfg)) 149 | (define g 150 | (ext-hash-ref rnd s (lambda () 151 | (lambda ([xs : (Listof TextTeXLike)]) 152 | (apply text-tex% xs))))) 153 | @text-tex%{@(g (map f (extension-contents s)))}) 154 | 155 | (define #:forall (PureInline Inline) 156 | ((inline-element->latex [st : State] 157 | [g : (PureInline . -> . tex:TextTeX)] 158 | [f : (Inline . -> . tex:TextTeX)]) 159 | [i : (InlineElement PureInline Inline)]) : tex:TextTeX 160 | (cond 161 | [(ref? i) ((ref->latex st) i)] 162 | [(anchor? i) ((anchor->latex st g) i)] 163 | [(anchor-ref? i) ((anchor-ref->latex st) i)] 164 | [(extension? i) ((extension->latex st f) i)] 165 | [else ((pure-inline-element->latex f) i)])) 166 | 167 | (define (pure-inline->latex pi) 168 | (define x (pure-inline-contents pi)) 169 | (define f pure-inline->latex) 170 | (cond 171 | [(splice? x) ((splice->latex f) x)] 172 | [else ((pure-inline-element->latex f) x)])) 173 | 174 | (define ((inline->latex st) i) 175 | (define x (inline-contents i)) 176 | (define f (inline->latex st)) 177 | (define g pure-inline->latex) 178 | (cond 179 | [(splice? x) ((splice->latex f) x)] 180 | [else ((inline-element->latex st g f) x)])) 181 | -------------------------------------------------------------------------------- /morg/latex/publish.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/id.rkt" 4 | "config.rkt" 5 | "convert.rkt" 6 | "../data/document.rkt") 7 | 8 | (require/typed racket/file 9 | [make-temporary-directory (-> Path)]) 10 | 11 | (require/typed racket/base 12 | [copy-file (Path Path Boolean . -> . Void)]) 13 | 14 | (provide ->latex/publish) 15 | 16 | (define (latex->pdf/publish [dst-dir : Path] [i : Id] [s : String]) : Void 17 | (define cmd (find-executable-path "latexmk")) 18 | (unless cmd 19 | (error "latexmk not found.")) 20 | (define name-base (id-contents i)) 21 | (define tmp-dir 22 | (make-temporary-directory)) 23 | (define tex-file 24 | (build-path tmp-dir (path-add-extension name-base ".tex"))) 25 | (call-with-output-file* tex-file 26 | (lambda ([port : Output-Port]) 27 | (write-string s port))) 28 | (define latex-res 29 | (parameterize ([current-directory tmp-dir]) 30 | (system* cmd "-pdf" "-lualatex" tex-file 31 | #:set-pwd? #t))) 32 | (unless latex-res 33 | (error "latexmk failed.")) 34 | (make-directory* dst-dir) 35 | (define name-pdf (path-add-extension name-base ".pdf")) 36 | (copy-file (build-path tmp-dir name-pdf) 37 | (build-path dst-dir name-pdf) 38 | #t) 39 | (void)) 40 | 41 | (define (->latex/publish #:config [cfg : Config default-config] 42 | [doc : (U Document)] 43 | [dst-dir : Path]) : Void 44 | (define s (->latex #:config cfg doc)) 45 | (latex->pdf/publish dst-dir (document-id doc) s)) 46 | -------------------------------------------------------------------------------- /morg/latex/section.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/section.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../data/node.rkt" 6 | "../data/article.rkt" 7 | "../data/block.rkt" 8 | "../markup/tex.rkt" 9 | "../markup/splice.rkt" 10 | "../text/numbering.rkt" 11 | "id.rkt" 12 | "inline.rkt" 13 | "block.rkt" 14 | "article.rkt" 15 | "state.rkt" 16 | "config.rkt") 17 | 18 | (provide section->latex) 19 | 20 | (define ((section-element->latex [st : State]) 21 | [x : SectionElement]) : tex:TextTeX 22 | (cond 23 | [(article? x) ((article->latex st) x)] 24 | [(block? x) ((block->latex st) x)])) 25 | 26 | (: section->latex : (State . -> . (Section . -> . tex:TextTeX))) 27 | 28 | (define ((section->latex st-1) s) 29 | (define id (section-id s)) 30 | (define st 31 | (struct-copy state st-1 32 | [id id])) 33 | (define cfg (state-config st)) 34 | (define tbl (state-node-table st)) 35 | (define untbl (state-unnumbered-node-table st)) 36 | (define place 37 | (if (node-table-has-key? tbl id) 38 | 'numbered 39 | 'unnumbered)) 40 | (define nd 41 | (cast (node-table-ref (case place 42 | [(numbered) tbl] 43 | [(unnumbered) untbl]) 44 | id) 45 | SectionNode)) 46 | (define depth 47 | (- (length (node-trace nd)) 1)) 48 | (define sms (config-section-macros cfg)) 49 | (define fbk (config-section-macro-fallback cfg)) 50 | (define sec-macro 51 | (if (< depth (length sms)) 52 | (list-ref sms depth) 53 | fbk)) 54 | (define title (pure-inline->latex (section-title s))) 55 | (define n : TextTeXLike 56 | @when%[(eq? place 'numbered)]{@(section-node-format-index nd)@macro%["enskip"]}) 57 | (define t 58 | @%{@|n|@|title|}) 59 | @text-tex%{ 60 | @macro%[sec-macro @optional-argument%{@|t|} @argument%{@|t|@(id->latex/margin id)}] 61 | @(id->hypertarget id) 62 | @(apply % (map (section-element->latex st) (section-contents s))) 63 | @(apply % (map (section->latex st) (section-subsections s))) 64 | }) 65 | -------------------------------------------------------------------------------- /morg/latex/splice.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/splice.rkt" 4 | (prefix-in tex: "../data/tex.rkt") 5 | "../markup/tex.rkt") 6 | 7 | (provide splice->latex) 8 | 9 | (define #:forall (X) 10 | ((splice->latex [f : (X . -> . tex:TextTeX)]) 11 | [x : (Splice X)]) : tex:TextTeX 12 | (text-tex% (splice-map f x))) 13 | -------------------------------------------------------------------------------- /morg/latex/state.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "config.rkt" 4 | "../data/id.rkt" 5 | "../data/index-table.rkt" 6 | "../data/anchor-table.rkt" 7 | "../data/node.rkt") 8 | 9 | (provide (struct-out state) State) 10 | 11 | (struct state 12 | ([config : Config] 13 | [id : Id] 14 | [index-table : IndexTable] 15 | [anchor-table : AnchorTable] 16 | [node-table : NodeTable] 17 | [unnumbered-node-table : NodeTable]) 18 | #:transparent 19 | #:type-name State) 20 | -------------------------------------------------------------------------------- /morg/main.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "markup/block.rkt" 4 | "markup/document.rkt" 5 | "markup/inline.rkt" 6 | "markup/section.rkt" 7 | "markup/date.rkt" 8 | "markup/index.rkt" 9 | "markup/splice.rkt" 10 | "markup/syntax.rkt") 11 | 12 | (provide 13 | (rename-out [paragraph% paragraph] 14 | [document% document] 15 | [ref% ref] 16 | [href% href] 17 | [date% date] 18 | [emph% emph] 19 | [display% disp] 20 | [code% code] 21 | [dfn% dfn] 22 | [anchor-ref% anchor-ref] 23 | [index% index] 24 | [print-index% print-index] 25 | [section% section]) 26 | anchor 27 | list-item 28 | ordered-list 29 | unordered-list 30 | (all-from-out "markup/splice.rkt") 31 | include-part) 32 | 33 | (define anchor (inst anchor% PureInlineLike)) 34 | (define list-item (inst list-item% PureInlineLike InlineLike)) 35 | (define ordered-list (inst ordered-list% PureInlineLike InlineLike)) 36 | (define unordered-list (inst unordered-list% PureInlineLike InlineLike)) 37 | -------------------------------------------------------------------------------- /morg/markup/article.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/article.rkt" 4 | "../data/id.rkt" 5 | "../data/index.rkt" 6 | "inline.rkt" 7 | "block.rkt" 8 | "splice.rkt" 9 | "../util/option.rkt") 10 | 11 | (provide article% 12 | (rename-out [article%/curried make-article]) 13 | (rename-out [proof%/curried make-proof]) 14 | proof%) 15 | 16 | (define ((article%/curried . [header : PureInlineLike *]) 17 | #:id [maybe-id : String] 18 | #:title [title : (Option PureInlineLike) #f] 19 | #:description [description : (Option PureInlineLike) #f] 20 | #:indexes [indexes : (Listof Index) '()] 21 | #:proof [proof : (Option Proof) #f] 22 | . [contents : BlockLike *]) : Article 23 | (article (id maybe-id) 24 | (apply pure-inline% header) 25 | (option-map pure-inline% title) 26 | (option-map pure-inline% description) 27 | indexes 28 | (apply block% contents) 29 | proof)) 30 | 31 | (define (article% #:id [maybe-id : String] 32 | #:header [header : PureInlineLike] 33 | #:title [title : (Option PureInlineLike) #f] 34 | #:indexes [indexes : (Listof Index) '()] 35 | #:proof [proof : (Option Proof) #f] 36 | . [contents : BlockLike *]) : Article 37 | ((article%/curried header) 38 | #:id maybe-id 39 | #:title title 40 | #:indexes indexes 41 | #:proof proof 42 | (apply % contents))) 43 | 44 | (define ((proof%/curried . [header : PureInlineLike *]) 45 | . [contents : BlockLike *]) : Proof 46 | (proof (apply pure-inline% header) 47 | (apply block% contents))) 48 | 49 | (define (proof% #:header [header : PureInlineLike "Proof"] 50 | . [contents : BlockLike *]) : Proof 51 | (apply (proof%/curried header) contents)) 52 | -------------------------------------------------------------------------------- /morg/markup/block.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/block.rkt" 4 | "../data/splice.rkt" 5 | "inline.rkt" 6 | (submod "index.rkt" print)) 7 | 8 | (provide BlockLike 9 | block-like->block 10 | block% 11 | print-index% 12 | paragraph%) 13 | 14 | (define-type BlockLike 15 | (Rec X (U Block 16 | (Splice X) 17 | PrintIndex 18 | Paragraph))) 19 | 20 | (define (block-like->block [x : BlockLike]) : Block 21 | (cond 22 | [(block? x) x] 23 | [(splice? x) 24 | (block (splice-map block-like->block x))] 25 | [else (block x)])) 26 | 27 | (define (block% . [xs : BlockLike *]) : Block 28 | (block-like->block (splice xs))) 29 | 30 | (define (paragraph% . [xs : InlineLike *]) : Paragraph 31 | (paragraph (apply inline% xs))) 32 | -------------------------------------------------------------------------------- /morg/markup/date.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/date.rkt") 4 | 5 | (provide date%) 6 | 7 | (define (date% [year : Integer] 8 | [month : (Option Exact-Positive-Integer) #f] 9 | [day : (Option Exact-Positive-Integer) #f]) 10 | (date year month day)) 11 | -------------------------------------------------------------------------------- /morg/markup/document.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "../data/id.rkt" 5 | "../data/section.rkt" 6 | "../data/date.rkt" 7 | "../util/option.rkt" 8 | "block.rkt" 9 | "inline.rkt") 10 | 11 | (provide document%) 12 | 13 | (define (document% #:id [maybe-id : String] 14 | #:author [author : (Listof PureInlineLike)] 15 | #:title [title : PureInlineLike] 16 | #:description [description : (Option PureInlineLike) #f] 17 | #:date [d : Date (current-date)] 18 | #:contents [contents : BlockLike (block%)] 19 | #:front [front : (Listof Section) (list)] 20 | #:back [back : (Listof Section) (list)] 21 | . [main : Section *]) : Document 22 | (document (id maybe-id) 23 | (map pure-inline% author) 24 | (pure-inline% title) 25 | (option-map pure-inline% description) 26 | d 27 | (block% contents) 28 | front 29 | main 30 | back)) 31 | -------------------------------------------------------------------------------- /morg/markup/index.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/index.rkt" 4 | "../data/index-table.rkt" 5 | "../data/inline.rkt" 6 | "../data/article.rkt" 7 | "../data/block.rkt" 8 | "inline.rkt") 9 | 10 | (provide index-list->inline 11 | (rename-out [index%/curried make-index]) 12 | index%) 13 | 14 | (define (make-index-type) 15 | (idx-type)) 16 | 17 | (define (index-list->inline 18 | #:less-than? [less-than? : (IndexItem IndexItem . -> . Boolean) 19 | index-iteminline 12 | PureInlineLike 13 | pure-inline-like->pure-inline 14 | ref% 15 | math% 16 | list-item% 17 | unordered-list% 18 | ordered-list% 19 | href% 20 | emph% 21 | display% 22 | code% 23 | dfn% 24 | anchor% 25 | anchor-ref% 26 | pure-inline% 27 | inline%) 28 | 29 | (define-type InlineLike 30 | (U Inline 31 | PureInline 32 | (Splice InlineLike) 33 | (InlineElement PureInlineLike InlineLike) 34 | StringTreeLike)) 35 | 36 | (define-type PureInlineLike 37 | (U PureInline 38 | (Splice PureInlineLike) 39 | (PureInlineElement PureInlineLike) 40 | StringTreeLike)) 41 | 42 | (define (inline-like->inline [x : InlineLike]) : Inline 43 | (cond 44 | [(inline? x) x] 45 | [(pure-inline? x) (pure-inline->inline x)] 46 | [(splice? x) 47 | (inline (splice-map inline-like->inline x))] 48 | [((make-predicate StringTreeLike) x) 49 | (inline (text (string-tree-like->string x)))] 50 | [else 51 | (inline ((inline-element-map pure-inline-like->pure-inline 52 | inline-like->inline) 53 | x))])) 54 | 55 | (define (pure-inline-like->pure-inline [x : PureInlineLike]) : PureInline 56 | (cond 57 | [(pure-inline? x) x] 58 | [(splice? x) 59 | (pure-inline (splice-map pure-inline-like->pure-inline x))] 60 | [((make-predicate StringTreeLike) x) 61 | (pure-inline (text (string-tree-like->string x)))] 62 | [else (pure-inline ((pure-inline-element-map pure-inline-like->pure-inline) x))])) 63 | 64 | (define (inline% . [xs : InlineLike *]) : Inline 65 | (inline-like->inline (splice xs))) 66 | 67 | (define (pure-inline% . [xs : PureInlineLike *]) : PureInline 68 | (pure-inline-like->pure-inline (splice xs))) 69 | 70 | (define (ref% [maybe-id : String]) : Ref 71 | (ref (id maybe-id))) 72 | 73 | (define (math% . [xs : MathTeXLike *]) : Math 74 | (math (apply math-tex% xs))) 75 | 76 | (struct (PureInline Inline) list-item+ 77 | ([head : PureInline] 78 | [id : (Option Id)] 79 | [contents : Inline]) 80 | #:transparent 81 | #:type-name ListItem+) 82 | 83 | (define #:forall (PureInline Inline) 84 | (list-item% #:head [head : (U StringTreeLike PureInline) "-"] 85 | #:id [maybe-id : (Option String) #f] 86 | . [xs : Inline *]) 87 | (list-item+ head (option-map id maybe-id) (splice xs))) 88 | 89 | (define #:forall (PureInline Inline) 90 | (list-item+->list-item [li : (ListItem+ PureInline Inline)]) 91 | : (ListItem (U Inline PureInline (Anchor PureInline))) 92 | (define id (list-item+-id li)) 93 | (define head (list-item+-head li)) 94 | (define contents (list-item+-contents li)) 95 | (if id 96 | (list-item (anchor id head) contents) 97 | (list-item head contents))) 98 | 99 | (define #:forall (PureInline Inline) 100 | (unordered-list% . [xs : (ListItem+ PureInline Inline) *]) 101 | (unordered-list 102 | (map (inst list-item+->list-item PureInline Inline) xs))) 103 | 104 | (define (ordered-list%:default-format [n : Natural]) 105 | (number->string n)) 106 | 107 | (define #:forall (PureInline Inline) 108 | ((ordered-list%:modify-item [fmt : (Natural . -> . PureInline)]) 109 | [i : (ListItem+ PureInline Inline)] [n : Natural]) 110 | (list-item+->list-item 111 | (list-item+ (fmt (+ n 1)) 112 | (list-item+-id i) 113 | (list-item+-contents i)))) 114 | 115 | (define #:forall (PureInline Inline) 116 | (ordered-list% #:format [fmt : (Natural . -> . (U StringTreeLike PureInline)) 117 | ordered-list%:default-format] 118 | . [xs : (ListItem+ PureInline Inline) *]) 119 | (define rng (range (length xs))) 120 | (define ys 121 | (map ((inst ordered-list%:modify-item (U StringTreeLike PureInline) Inline) fmt) xs rng)) 122 | (ordered-list ys)) 123 | 124 | (define #:forall (Inline) 125 | (href% [url : String] . [xs : Inline *]) 126 | (define contents 127 | (if (null? xs) 128 | #f 129 | (splice xs))) 130 | (href url contents)) 131 | 132 | (define #:forall (Inline) 133 | (emph% . [xs : Inline *]) 134 | (emph (splice xs))) 135 | 136 | (define #:forall (Inline) 137 | (display% . [xs : Inline *]) 138 | (display (splice xs))) 139 | 140 | (define #:forall (Inline) 141 | (code% . [xs : Inline *]) 142 | (code (splice xs))) 143 | 144 | (define #:forall (Inline) 145 | (dfn% . [xs : Inline *]) 146 | (dfn (splice xs))) 147 | 148 | (define #:forall (Inline) 149 | (anchor% #:id [maybe-id : String] . [xs : Inline *]) 150 | (anchor (id maybe-id) (splice xs))) 151 | 152 | (define (anchor-ref% #:anchor [maybe-anchor : String] 153 | #:node [maybe-node : String]) : AnchorRef 154 | (anchor-ref (id maybe-anchor) (id maybe-node))) 155 | -------------------------------------------------------------------------------- /morg/markup/section.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/section.rkt" 4 | "../data/id.rkt" 5 | "../data/article.rkt" 6 | "../util/option.rkt" 7 | "inline.rkt" 8 | "block.rkt") 9 | 10 | (provide section%) 11 | 12 | (define-type SectionElementLike 13 | (U Article BlockLike)) 14 | 15 | (define (section-element-like->section-element [x : SectionElementLike]) : SectionElement 16 | (cond 17 | [(article? x) x] 18 | [((make-predicate BlockLike) x) 19 | (block% x)])) 20 | 21 | (define (section% #:id [maybe-id : String] 22 | #:title [title : PureInlineLike] 23 | #:description [description : (Option PureInlineLike) #f] 24 | #:subsections [subsections : (Listof Section) (list)] 25 | . [contents : SectionElementLike *]) : Section 26 | (section (id maybe-id) 27 | (pure-inline% title) 28 | (option-map pure-inline% description) 29 | (map section-element-like->section-element contents) 30 | subsections)) 31 | -------------------------------------------------------------------------------- /morg/markup/splice.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/splice.rkt") 4 | 5 | (provide % 6 | when%) 7 | 8 | (define #:forall (A) 9 | (% . [xs : A *]) : (Splice A) 10 | (splice xs)) 11 | 12 | (define-syntax-rule (when% cond body ...) 13 | (if cond 14 | (% body ...) 15 | (%))) 16 | -------------------------------------------------------------------------------- /morg/markup/string.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/tree.rkt" 4 | "../data/splice.rkt") 5 | 6 | (provide StringTree StringTreeLike 7 | string-tree-like->string-tree 8 | string-tree->string 9 | string-tree-like->string 10 | string-tree-like->string* 11 | string%) 12 | 13 | (define-type StringTree 14 | (Tree String)) 15 | 16 | (define-type StringTreeLike 17 | (Rec X (U StringTree String (Splice X)))) 18 | 19 | (define (string-tree-like->string-tree [x : StringTreeLike]) : StringTree 20 | (cond 21 | [((make-predicate StringTree) x) x] 22 | [(string? x) (leaf x)] 23 | [(splice? x) 24 | (node (map string-tree-like->string-tree (splice-contents x)))])) 25 | 26 | (define (string% . [xs : StringTreeLike *]) : StringTree 27 | (string-tree-like->string-tree (splice xs))) 28 | 29 | (define (string-tree->string [x : StringTree]) : String 30 | (apply string-append (tree-flatten x))) 31 | 32 | (define (string-tree-like->string [x : StringTreeLike]) : String 33 | (string-tree->string (string-tree-like->string-tree x))) 34 | 35 | (define (string-tree-like->string* . [xs : StringTreeLike *]) : String 36 | (string-tree-like->string (splice xs))) 37 | -------------------------------------------------------------------------------- /morg/markup/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (for-syntax typed/racket)) 4 | 5 | (provide include-part 6 | dynamic-include-part 7 | provide-part) 8 | 9 | (define-for-syntax part-name #'part) 10 | 11 | (define-syntax (part-name stx) 12 | (with-syntax ([part part-name]) 13 | #''part)) 14 | 15 | (define-syntax (include-part stx) 16 | (syntax-case stx () 17 | [(_ path) 18 | (with-syntax ([part part-name]) 19 | #'(let () 20 | (local-require (rename-in path [part part:local])) 21 | part:local))])) 22 | 23 | (define (dynamic-include-part [mod : Module-Path]) 24 | (dynamic-require mod (part-name))) 25 | 26 | (module tools typed/racket 27 | (provide path->id) 28 | 29 | (define (path->id [path : Path-String]) 30 | (path->string 31 | (path-replace-extension 32 | (assert (file-name-from-path path) path?) 33 | "")))) 34 | 35 | (require (for-syntax 'tools)) 36 | 37 | (define-syntax (provide-part-0 stx) 38 | (syntax-case stx () 39 | [(_ form) 40 | (with-syntax ([part part-name]) 41 | #'(begin 42 | (provide (rename-out [part:local part])) 43 | (define part:local 44 | form)))])) 45 | 46 | (define-syntax (provide-part stx) 47 | (syntax-case stx () 48 | [(_ (id-var) body ...) 49 | (with-syntax ([id (path->id (syntax-source stx))]) 50 | #'(provide-part-0 51 | (let ([id-var id]) 52 | body ...)))])) 53 | 54 | (module* internal #f 55 | (provide provide-part-0)) 56 | -------------------------------------------------------------------------------- /morg/markup/tex.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/tex.rkt" 4 | "../data/splice.rkt" 5 | "splice.rkt" 6 | "string.rkt" 7 | "../util/list.rkt") 8 | 9 | (provide MathTeXLike 10 | AtomLike 11 | atom-like->atom 12 | math-tex-like->math-tex 13 | math-tex% 14 | sub-sup% 15 | TextTeXLike 16 | text-tex-like->text-tex 17 | text-tex% 18 | argument% 19 | optional-argument% 20 | star-argument% 21 | macro% 22 | macro-1% 23 | group% 24 | special% 25 | options% 26 | environment%) 27 | 28 | (define-type TextLike 29 | (U Text StringTreeLike)) 30 | 31 | (define-type (AtomLike X) 32 | (U (Atom X) 33 | TextLike 34 | Special 35 | (Macro X) 36 | (Group X))) 37 | 38 | (define-type MathTeXAtomLike 39 | (AtomLike MathTeXLike)) 40 | 41 | (define-type MathTeXLike 42 | (U MathTeX 43 | MathTeXAtomLike 44 | (SubSup MathTeXAtomLike MathTeXLike) 45 | (Splice MathTeXLike))) 46 | 47 | (define (text-like->text [x : TextLike]) : Text 48 | (cond 49 | [(text? x) x] 50 | [((make-predicate StringTreeLike) x) 51 | (text (string-tree-like->string x))])) 52 | 53 | (define #:forall (X) 54 | (atom-like->atom [x : (AtomLike X)]) : (Atom X) 55 | (cond 56 | [(atom? x) x] 57 | [((make-predicate TextLike) x) 58 | (atom (text-like->text x))] 59 | [else (atom x)])) 60 | 61 | (define (math-tex-atom-like->math-tex-atom [x : MathTeXAtomLike]) : (Atom MathTeX) 62 | ((atom-map math-tex-like->math-tex) (atom-like->atom x))) 63 | 64 | (define (math-tex-like->math-tex [x : MathTeXLike]) : MathTeX 65 | (cond 66 | [(math-tex? x) x] 67 | [((make-predicate MathTeXAtomLike) x) 68 | (math-tex (math-tex-atom-like->math-tex-atom x))] 69 | [(splice? x) 70 | (math-tex (splice-map math-tex-like->math-tex x))] 71 | [(sub-sup? x) 72 | (math-tex 73 | ((sub-sup-map math-tex-atom-like->math-tex-atom math-tex-like->math-tex) x))] 74 | [else (math-tex x)])) 75 | 76 | (define (math-tex% . [xs : MathTeXLike *]) : MathTeX 77 | (math-tex-like->math-tex (splice xs))) 78 | 79 | (define #:forall (A X) 80 | (sub-sup% [base : A] 81 | #:_ [sub : (Option X) #f] 82 | #:^ [sup : (Option X) #f]) : (U (SubSup A X) A) 83 | (cond 84 | [(or sub sup) (sub-sup base sub sup)] 85 | [else base])) 86 | 87 | (define-type TextTeXAtomLike 88 | (AtomLike TextTeXLike)) 89 | 90 | (define-type TextTeXLike 91 | (U TextTeX 92 | TextTeXAtomLike 93 | (Splice TextTeXLike) 94 | Math)) 95 | 96 | (define (text-tex-atom-like->text-tex-atom [x : TextTeXAtomLike]) : (Atom TextTeX) 97 | ((atom-map text-tex-like->text-tex) (atom-like->atom x))) 98 | 99 | (define (text-tex-like->text-tex [x : TextTeXLike]) : TextTeX 100 | (cond 101 | [(text-tex? x) x] 102 | [((make-predicate TextTeXAtomLike) x) 103 | (text-tex (text-tex-atom-like->text-tex-atom x))] 104 | [(splice? x) (text-tex (splice-map text-tex-like->text-tex x))] 105 | [else (text-tex x)])) 106 | 107 | (define (text-tex% . [xs : TextTeXLike *]) : TextTeX 108 | (text-tex-like->text-tex (splice xs))) 109 | 110 | (define #:forall (X) 111 | (argument% #:parentheses [parens : (Pairof String String) '("{" . "}")] 112 | . [xs : X *]) 113 | (argument (splice xs) parens)) 114 | 115 | (define #:forall (X) 116 | (optional-argument% . [xs : X *]) 117 | (argument (splice xs) '("[" . "]"))) 118 | 119 | (define star-argument% 120 | (argument "*" '("" . ""))) 121 | 122 | (define #:forall (X) 123 | (macro% [head : StringTreeLike] 124 | . [args : (Argument X) *]) : (Macro X) 125 | (macro (string-tree-like->string head) args)) 126 | 127 | (define #:forall (X) 128 | ((macro-1% [head : StringTreeLike]) 129 | . [xs : X *]) : (Macro (Splice X)) 130 | (macro% head (apply argument% xs))) 131 | 132 | (define #:forall (X) 133 | (group% . [xs : X *]) : (Group (Splice X)) 134 | (group (splice xs))) 135 | 136 | (define special% special) 137 | 138 | (define #:forall (X) 139 | (environment% [name : StringTreeLike] 140 | #:arguments [args : (Listof (Argument X)) (list)] 141 | . [body : X *]) 142 | (define arg-1 (argument% name)) 143 | @%{ 144 | @(apply (inst macro% (U X StringTreeLike)) "begin" arg-1 args) 145 | @(apply % body) 146 | @((inst macro% (U X StringTreeLike)) "end" arg-1) 147 | }) 148 | 149 | (define #:forall (X) 150 | (option% [x : (U String (Pairof String X))]) 151 | (cond 152 | [(string? x) @%{@|x|}] 153 | [(pair? x) @%{@(car x)=@(cdr x)}])) 154 | 155 | (define #:forall (X) 156 | (options% . [xs : (U String (Pairof String X)) *]) 157 | (apply % (list-join-1 (map (inst option% X) xs) ","))) 158 | -------------------------------------------------------------------------------- /morg/markup/xexpr.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require typed/xml 4 | "../data/splice.rkt" 5 | "string.rkt") 6 | 7 | (provide XExprs XExprsLike 8 | xexprs-like->xexprs 9 | xexprs% 10 | tagged%) 11 | 12 | (define-type XExprs (Listof XExpr)) 13 | 14 | (define-type XExprsLike 15 | (U XExprs 16 | XExpr 17 | StringTreeLike 18 | (Splice XExprsLike))) 19 | 20 | (define (xexprs-like->xexprs [x : XExprsLike]) : XExprs 21 | (cond 22 | [((make-predicate XExprs) x) x] 23 | [((make-predicate XExpr) x) (list x)] 24 | [((make-predicate StringTreeLike) x) 25 | (list (string-tree-like->string x))] 26 | [(splice? x) 27 | (apply append (map xexprs-like->xexprs (splice-contents x)))])) 28 | 29 | (define (xexprs% . [xs : XExprsLike *]) : XExprs 30 | (xexprs-like->xexprs (splice xs))) 31 | 32 | (define (tagged% [tag : Symbol] 33 | [attrs : (Listof (List Symbol String))] 34 | . [xs : XExprsLike *]) : XExprs 35 | (xexprs% 36 | `(,tag ,attrs 37 | ,@(apply xexprs% xs)))) 38 | -------------------------------------------------------------------------------- /morg/math.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "math/markup.rkt" 4 | "math/inline.rkt" 5 | "math/level.rkt" 6 | "markup/tex.rkt") 7 | 8 | (provide 9 | MathTeX+Like 10 | MathTeXAtom+Like 11 | (rename-out [paren% paren] 12 | [paren%/curried paren/curried] 13 | [dec-degree% dec-degree] 14 | [binary% binary] 15 | [unary% unary] 16 | [big-op% big-op] 17 | [delimiter% delimiter] 18 | [apply-with-parens% apply-with-parens] 19 | [sup-op% sup-op] 20 | [sub-op% sub-op] 21 | [monoid% monoid]) 22 | sub-sup _ ^ 23 | macro 24 | macro-1 25 | group 26 | argument 27 | optional-argument 28 | make-level 29 | define-levels 30 | math) 31 | 32 | (define sub-sup (inst sub-sup% MathTeXAtom+Like MathTeX+Like)) 33 | 34 | (define (_ [base : MathTeXAtom+Like] [sub : MathTeX+Like]) 35 | (sub-sup base #:_ sub)) 36 | 37 | (define (^ [base : MathTeXAtom+Like] [sup : MathTeX+Like]) 38 | (sub-sup base #:^ sup)) 39 | 40 | (define macro (inst macro% MathTeX+Like)) 41 | (define macro-1 (inst macro-1% MathTeX+Like)) 42 | (define group (inst group% MathTeX+Like)) 43 | (define argument (inst argument% MathTeX+Like)) 44 | (define optional-argument (inst optional-argument% MathTeX+Like)) 45 | -------------------------------------------------------------------------------- /morg/math/config.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide (struct-out config) Config 4 | default-config) 5 | 6 | (struct config 7 | ([levels : (Listof Symbol)]) 8 | #:transparent 9 | #:type-name Config) 10 | 11 | (define default-config 12 | (config 13 | '(+ * generic-bin generic-rel comma))) 14 | -------------------------------------------------------------------------------- /morg/math/format.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "tex-plus.rkt" 4 | "level.rkt" 5 | "../data/tex.rkt" 6 | "../data/splice.rkt" 7 | "../markup/tex.rkt") 8 | 9 | (provide (struct-out state) State 10 | format-math-tex+) 11 | 12 | (struct state 13 | ([level : Level]) 14 | #:transparent 15 | #:type-name State) 16 | 17 | (: format-math-tex+ : (State . -> . (MathTeX+ . -> . MathTeX))) 18 | 19 | (define ((format-paren [st : State]) 20 | [p : (Paren MathTeX+)]) : MathTeXLike 21 | (define cur-lv (state-level st)) 22 | (define lv (paren-level p)) 23 | (define st-1 24 | (struct-copy state st 25 | [level lv])) 26 | (define f (format-math-tex+ st-1)) 27 | (define contents (f (paren-contents p))) 28 | (define comp (lv . level-compare . cur-lv)) 29 | (case comp 30 | [(<) contents] 31 | [else 32 | (define l (f (paren-left p))) 33 | (define r (f (paren-right p))) 34 | (math-tex% l contents r)])) 35 | 36 | (define ((format-atom [st : State]) 37 | [a : (Atom MathTeX+)]) : (Atom MathTeX) 38 | ((atom-map (format-math-tex+ st)) a)) 39 | 40 | (define ((format-sub-sup [st : State]) 41 | [s : (SubSup (Atom MathTeX+) MathTeX+)]) : (SubSup (Atom MathTeX) MathTeX) 42 | (define st-1 43 | (struct-copy state st 44 | [level #f])) 45 | (define st-2 46 | (struct-copy state st 47 | [level #t])) 48 | ((sub-sup-map (format-atom st-1) (format-math-tex+ st-2)) s)) 49 | 50 | (define ((format-math-tex+ st) m) 51 | (define x (math-tex+-contents m)) 52 | (cond 53 | [(atom? x) (math-tex ((format-atom st) x))] 54 | [(splice? x) (math-tex (splice-map (format-math-tex+ st) x))] 55 | [(paren? x) (math-tex% ((format-paren st) x))] 56 | [(sub-sup? x) (math-tex ((format-sub-sup st) x))])) 57 | -------------------------------------------------------------------------------- /morg/math/inline.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "markup.rkt" 4 | "format.rkt" 5 | (prefix-in i: "../data/inline.rkt")) 6 | 7 | (provide math) 8 | 9 | (define (math . [xs : MathTeX+Like *]) : i:Math 10 | (define st (state #t)) 11 | (i:math ((format-math-tex+ st) (apply math-tex+% xs)))) 12 | -------------------------------------------------------------------------------- /morg/math/level.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (module+ test 4 | (require typed/rackunit)) 5 | 6 | (require (for-syntax racket 7 | syntax/parse)) 8 | 9 | (provide Level 10 | rational->level 11 | level-dec-degree 12 | level-compare 13 | define-levels 14 | ComparisonResult) 15 | 16 | (struct id 17 | () 18 | #:type-name Id) 19 | 20 | (struct level 21 | ([value : Exact-Rational] 22 | [id : Id] 23 | [degree : Nonpositive-Integer]) 24 | #:transparent 25 | #:type-name Level-) 26 | 27 | (define-type LevelBottom #f) 28 | (define-type LevelTop #t) 29 | (define-type Level 30 | (U Level- LevelBottom LevelTop)) 31 | 32 | (define (rational->level [r : Exact-Rational]) 33 | (level r (id) 0)) 34 | 35 | (define (level-dec-degree [x : Level]) 36 | (case x 37 | [(#f #t) x] 38 | [else 39 | (level (level-value x) 40 | (level-id x) 41 | (- (level-degree x) 1))])) 42 | 43 | (define-type ComparisonResult 44 | (U '< '= '> '?)) 45 | 46 | (define (level-compare- 47 | [x : Level-] 48 | [y : Level-]) : ComparisonResult 49 | (define x:v (level-value x)) 50 | (define y:v (level-value y)) 51 | (cond 52 | [(x:v . < . y:v) '<] 53 | [(x:v . > . y:v) '>] 54 | [else 55 | (define x:i (level-id x)) 56 | (define y:i (level-id y)) 57 | (cond 58 | [(eq? x:i y:i) 59 | (define x:d (level-degree x)) 60 | (define y:d (level-degree y)) 61 | (cond 62 | [(x:d . < . y:d) '<] 63 | [(x:d . > . y:d) '>] 64 | [else '=])] 65 | [else '?])])) 66 | 67 | (define (level-compare 68 | [x : Level] 69 | [y : Level]) : ComparisonResult 70 | (case x 71 | [(#f) 72 | (case y 73 | [(#f) '=] 74 | [else '<])] 75 | [(#t) 76 | (case y 77 | [(#t) '=] 78 | [else '>])] 79 | [else 80 | (case y 81 | [(#f) '>] 82 | [(#t) '<] 83 | [else 84 | (level-compare- x y)])])) 85 | 86 | (module+ test 87 | (define x1 (rational->level 1/2)) 88 | (check-equal? 89 | (x1 . level-compare . x1) 90 | '=) 91 | (define y1 (rational->level 3/4)) 92 | (check-equal? 93 | (x1 . level-compare . y1) 94 | '<) 95 | (define z1 (rational->level 1/2)) 96 | (check-equal? 97 | (x1 . level-compare . z1) 98 | '?) 99 | (define x2 (level-dec-degree x1)) 100 | (check-equal? 101 | (x1 . level-compare . x2) 102 | '>)) 103 | 104 | (define-syntax (define-levels stx) 105 | (syntax-parse stx 106 | [(_ (~alt (~optional (~seq #:init init:number)) 107 | (~optional (~seq #:step step:number))) 108 | ... 109 | id:identifier ...) 110 | (define n 111 | (length (syntax->list #'(id ...)))) 112 | (define rng (range n)) 113 | (define x0 (syntax->datum #'(~? init 0))) 114 | (define dx (syntax->datum #'(~? step 1))) 115 | (with-syntax ([(value ...) 116 | (map (lambda (i) (+ x0 (* i dx))) rng)]) 117 | #'(begin 118 | (define id : Exact-Rational value) 119 | ...))])) 120 | -------------------------------------------------------------------------------- /morg/math/markup.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "tex-plus.rkt" 4 | "level.rkt" 5 | "../data/tex.rkt" 6 | "../data/splice.rkt" 7 | "../util/list.rkt" 8 | "../markup/splice.rkt" 9 | "../markup/tex.rkt") 10 | 11 | (provide MathTeXAtom+Like 12 | MathTeX+Like 13 | math-tex+-like->math-tex+ 14 | (rename-out [->level make-level]) 15 | paren% 16 | paren%/curried 17 | dec-degree% 18 | binary% 19 | unary% 20 | monoid% 21 | big-op% 22 | delimiter% 23 | apply-with-parens% 24 | sup-op% 25 | sub-op% 26 | math-tex+%) 27 | 28 | (define-type MathTeXAtom+Like 29 | (AtomLike MathTeX+Like)) 30 | 31 | (define-type MathTeX+Like 32 | (U MathTeX+ 33 | MathTeXAtom+Like 34 | (Splice MathTeX+Like) 35 | (Paren MathTeX+Like) 36 | (SubSup MathTeXAtom+Like MathTeX+Like))) 37 | 38 | (define (math-tex-atom+-like->math-tex-atom+ [x : MathTeXAtom+Like]) : (Atom MathTeX+) 39 | ((atom-map math-tex+-like->math-tex+) 40 | (atom-like->atom x))) 41 | 42 | (define (math-tex+-like->math-tex+ [x : MathTeX+Like]) : MathTeX+ 43 | (cond 44 | [(math-tex+? x) x] 45 | [((make-predicate MathTeXAtom+Like) x) 46 | (math-tex+ (math-tex-atom+-like->math-tex-atom+ x))] 47 | [(splice? x) 48 | (math-tex+ (splice-map math-tex+-like->math-tex+ x))] 49 | [(paren? x) 50 | (math-tex+ ((paren-map math-tex+-like->math-tex+) x))] 51 | [(sub-sup? x) 52 | (math-tex+ 53 | ((sub-sup-map math-tex-atom+-like->math-tex-atom+ 54 | math-tex+-like->math-tex+) 55 | x))] 56 | [else (math-tex+ x)])) 57 | 58 | (define (math-tex+% . [xs : MathTeX+Like *]) : MathTeX+ 59 | (math-tex+-like->math-tex+ (splice xs))) 60 | 61 | (define-type OpLevel (U Exact-Rational Level)) 62 | 63 | (define (->level [x : OpLevel]) 64 | (cond 65 | [(rational? x) (rational->level x)] 66 | [else x])) 67 | 68 | (define (paren%/curried #:level [lv1 : OpLevel #t] 69 | #:left [left : MathTeX+Like "("] 70 | #:right [right : MathTeX+Like ")"]) 71 | (define lv (->level lv1)) 72 | (lambda [xs : MathTeX+Like *] : (Paren MathTeX+Like) 73 | (paren lv left right (splice xs)))) 74 | 75 | (define (paren% #:level [lv : OpLevel #t] 76 | #:left [left : MathTeX+Like "("] 77 | #:right [right : MathTeX+Like ")"] 78 | . [xs : MathTeX+Like *]) : (Paren MathTeX+Like) 79 | (apply (paren%/curried #:level lv #:left left #:right right) xs)) 80 | 81 | (define (dec-degree% . [xs : MathTeX+Like *]) : MathTeX+ 82 | (math-tex+-dec-degree (apply math-tex+% xs))) 83 | 84 | (define (binary% #:level [lv1 : OpLevel] 85 | #:assoc [assoc : (U 'left 'right 'none) 'none] 86 | [op : MathTeX+Like]) 87 | (define lv (->level lv1)) 88 | (lambda ([a : MathTeX+Like] [b : MathTeX+Like]) : (Paren MathTeX+Like) 89 | (define-values (l r) 90 | (case assoc 91 | [(left) (values (dec-degree% a) b)] 92 | [(right) (values a (dec-degree% b))] 93 | [else (values a b)])) 94 | (paren% #:level lv 95 | l op r))) 96 | 97 | (define (unary% #:level [lv1 : OpLevel] 98 | [op : MathTeX+Like]) 99 | (define lv (->level lv1)) 100 | (lambda [xs : MathTeX+Like *] 101 | (paren% #:level lv 102 | op (apply dec-degree% xs)))) 103 | 104 | (define (monoid% #:level [lv1 : OpLevel] 105 | [unit : MathTeX+Like] 106 | [bin : MathTeX+Like]) 107 | (define lv (->level lv1)) 108 | (lambda[xs : MathTeX+Like *] : MathTeX+Like 109 | (define n (length xs)) 110 | (cond 111 | [(eq? n 0) unit] 112 | [(eq? n 1) (list-ref xs 0)] 113 | [else 114 | (apply (paren%/curried #:level lv) (list-join-1 xs bin))]))) 115 | 116 | (define (big-op% #:level [lv1 : OpLevel] 117 | [op : MathTeXAtom+Like]) 118 | (define lv (->level lv1)) 119 | (lambda (#:_ [sub : (Option MathTeX+Like) #f] 120 | #:^ [sup : (Option MathTeX+Like) #f] 121 | . [xs : MathTeX+Like *]) : (Paren MathTeX+Like) 122 | (paren% #:level lv 123 | ((inst sub-sup% MathTeXAtom+Like MathTeX+Like) op #:_ sub #:^ sup) 124 | (apply dec-degree% xs)))) 125 | 126 | (define ((delimiter% #:left [left : MathTeX+Like] 127 | #:right [right : MathTeX+Like]) 128 | . [xs : MathTeX+Like *]) : MathTeX+Like 129 | (% left 130 | (apply (paren%/curried #:level #t #:left "" #:right "") xs) 131 | right)) 132 | 133 | (define (apply-with-parens% #:left [left : MathTeX+Like "("] 134 | #:right [right : MathTeX+Like ")"] 135 | #:level [lv1 : OpLevel]) 136 | (define lv (->level lv1)) 137 | (lambda ([f : MathTeX+Like] . [xs : MathTeX+Like *]) : (Paren MathTeX+Like) 138 | (paren% #:level lv 139 | (dec-degree% f) 140 | (apply (delimiter% #:left left #:right right) xs)))) 141 | 142 | (define (sup-op% #:level [lv1 : OpLevel] 143 | [op : MathTeX+Like]) 144 | (define lv (->level lv1)) 145 | (lambda [xs : MathTeX+Like *] 146 | (paren% #:level lv 147 | ((inst sub-sup% MathTeXAtom+Like MathTeX+Like) (apply group% xs) #:^ op)))) 148 | 149 | (define (sub-op% #:level [lv1 : OpLevel] 150 | [op : MathTeX+Like]) 151 | (define lv (->level lv1)) 152 | (lambda [xs : MathTeX+Like *] 153 | (paren% #:level lv 154 | ((inst sub-sup% MathTeXAtom+Like MathTeX+Like) 155 | (apply group% xs) #:_ op)))) 156 | -------------------------------------------------------------------------------- /morg/math/tex-plus.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/tex.rkt" 4 | "../data/splice.rkt" 5 | "level.rkt") 6 | 7 | (provide (struct-out paren) Paren 8 | (struct-out math-tex+) MathTeX+ 9 | paren-map 10 | math-tex+-dec-degree) 11 | 12 | (struct (X) paren 13 | ([level : Level] 14 | [left : X] 15 | [right : X] 16 | [contents : X]) 17 | #:transparent 18 | #:type-name Paren) 19 | 20 | (struct math-tex+ 21 | ([contents : (U (Atom MathTeX+) 22 | (Splice MathTeX+) 23 | (Paren MathTeX+) 24 | (SubSup (Atom MathTeX+) MathTeX+))]) 25 | #:transparent 26 | #:type-name MathTeX+) 27 | 28 | (define #:forall (X Y) 29 | ((paren-map [f : (X . -> . Y)]) 30 | [p : (Paren X)]) : (Paren Y) 31 | (paren (paren-level p) 32 | (f (paren-left p)) 33 | (f (paren-right p)) 34 | (f (paren-contents p)))) 35 | 36 | (define #:forall (X) 37 | ((paren-dec-degree [f : (X . -> . X)]) 38 | [p : (Paren X)]) : (Paren X) 39 | (paren (level-dec-degree (paren-level p)) 40 | (f (paren-left p)) 41 | (f (paren-right p)) 42 | (f (paren-contents p)))) 43 | 44 | (define (math-tex+-dec-degree [m : MathTeX+]) : MathTeX+ 45 | (define f math-tex+-dec-degree) 46 | (define g (atom-map f)) 47 | (define x (math-tex+-contents m)) 48 | (cond 49 | [(atom? x) (math-tex+ (g x))] 50 | [(splice? x) (math-tex+ (splice-map f x))] 51 | [(paren? x) (math-tex+ ((paren-dec-degree f) x))] 52 | [(sub-sup? x) (math-tex+ ((sub-sup-map g f) x))])) 53 | -------------------------------------------------------------------------------- /morg/math/tex.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../math.rkt" 4 | "../markup/splice.rkt") 5 | 6 | (require (for-syntax racket 7 | syntax/parse)) 8 | 9 | (define-for-syntax (make-provide-syntax stx fun) 10 | (syntax-parse stx 11 | [(_ id:identifier) 12 | (with-syntax ([str (symbol->string (syntax->datum #'id))] 13 | [tmp (gensym "tmp")] 14 | [f fun]) 15 | #'(begin 16 | (provide (rename-out [tmp id])) 17 | (define tmp (f str))))])) 18 | 19 | (define-syntax (provide-macro stx) 20 | (make-provide-syntax stx #'macro)) 21 | 22 | (define-syntax-rule (provide-macros id ...) 23 | (begin (provide-macro id) ...)) 24 | 25 | (define-syntax (provide-macro-1 stx) 26 | (make-provide-syntax stx #'macro-1)) 27 | 28 | (define-syntax-rule (provide-macros-1 id ...) 29 | (begin (provide-macro-1 id) ...)) 30 | 31 | ;;; Macros supported by both LaTeX and KaTeX 32 | 33 | (provide-macros-1 34 | acute 35 | bar 36 | breve 37 | check 38 | dot 39 | ddot 40 | grave 41 | hat 42 | widehat 43 | tilde 44 | widetilde 45 | vec 46 | overleftarrow 47 | mathring 48 | overrightarrow 49 | overbrace 50 | underbrace 51 | underbar) 52 | 53 | (provide-macros 54 | \{ 55 | \} 56 | \| 57 | lbrack 58 | rbrack 59 | lbrace 60 | rbrace 61 | langle 62 | rangle 63 | vert 64 | Vert 65 | lceil 66 | rceil 67 | lfloor 68 | rfloor 69 | lmoustache 70 | rmoustache 71 | lgroup 72 | rgroup 73 | uparrow 74 | downarrow 75 | updownarrow 76 | Uparrow 77 | Downarrow 78 | Updownarrow 79 | backslash) 80 | 81 | (define ((make-delimit-cmd [a : String]) 82 | [x : MathTeX+Like]) 83 | (% (macro a) x)) 84 | 85 | (define-syntax (provide-delimit-macro stx) 86 | (make-provide-syntax stx #'make-delimit-cmd)) 87 | 88 | (define-syntax-rule (provide-delimit-macros id ...) 89 | (begin (provide-delimit-macro id) ...)) 90 | 91 | (provide-delimit-macros 92 | left 93 | right 94 | big 95 | Big 96 | bigg 97 | Bigg 98 | bigl 99 | bigm 100 | bigr 101 | Bigl 102 | Bigm 103 | Bigr 104 | biggl 105 | biggm 106 | biggr 107 | Biggl 108 | Biggm 109 | Biggr) 110 | 111 | (provide-macros 112 | alpha 113 | beta 114 | gamma 115 | delta 116 | epsilon 117 | zeta 118 | eta 119 | theta 120 | iota 121 | kappa 122 | lambda 123 | mu 124 | nu 125 | xi 126 | pi 127 | rho 128 | sigma 129 | tau 130 | upsilon 131 | phi 132 | chi 133 | psi 134 | omega 135 | varepsilon 136 | vartheta 137 | varpi 138 | varrho 139 | varsigma 140 | varphi 141 | Gamma 142 | Delta 143 | Theta 144 | Lambda 145 | Xi 146 | Pi 147 | Sigma 148 | Upsilon 149 | Phi 150 | Psi 151 | Omega 152 | aleph 153 | imath 154 | jmath 155 | ell 156 | wp 157 | Re 158 | Im 159 | partial 160 | infty 161 | prime 162 | emptyset 163 | nabla 164 | top 165 | bot 166 | triangle 167 | forall 168 | exists 169 | neg 170 | lnot 171 | flat 172 | natural 173 | sharp 174 | clubsuit 175 | diamondsuit 176 | heartsuit 177 | spadesuit 178 | hbar 179 | surd 180 | angle 181 | bigvee 182 | bigwedge 183 | biguplus 184 | bigcap 185 | bigcup 186 | intop 187 | int 188 | prod 189 | coprod 190 | sum 191 | bigotimes 192 | bigoplus 193 | bigodot 194 | oint 195 | bigsqcup 196 | smallint 197 | triangleleft 198 | triangleright 199 | bigtriangleup 200 | bigtriangledown 201 | wedge 202 | vee 203 | land 204 | lor 205 | cap 206 | cup 207 | ddagger 208 | dagger 209 | sqcap 210 | sqcup 211 | uplus 212 | amalg 213 | diamond 214 | bullet 215 | wr 216 | div 217 | odot 218 | oslash 219 | otimes 220 | ominus 221 | oplus 222 | mp 223 | pm 224 | circ 225 | bigcirc 226 | setminus 227 | cdot 228 | ast 229 | times 230 | star 231 | propto 232 | sqsubseteq 233 | sqsupseteq 234 | parallel 235 | mid 236 | dashv 237 | vdash 238 | nearrow 239 | searrow 240 | nwarrow 241 | swarrow 242 | Leftrightarrow 243 | Leftarrow 244 | Rightarrow 245 | neq 246 | ne 247 | leq 248 | geq 249 | le 250 | ge 251 | succ 252 | prec 253 | approx 254 | succeq 255 | preceq 256 | supset 257 | subset 258 | supseteq 259 | subseteq 260 | in 261 | ni 262 | owns 263 | gg 264 | ll 265 | not 266 | leftrightarrow 267 | leftarrow 268 | rightarrow 269 | gets 270 | to 271 | mapsto 272 | sim 273 | simeq 274 | perp 275 | equiv 276 | asymp 277 | smile 278 | frown 279 | leftharpoonup 280 | leftharpoondown 281 | rightharpoonup 282 | rightharpoondown 283 | cong 284 | notin 285 | rightleftharpoons 286 | doteq 287 | hookrightarrow 288 | hookleftarrow 289 | bowtie 290 | models 291 | Longrightarrow 292 | longrightarrow 293 | longleftarrow 294 | Longleftarrow 295 | longmapsto 296 | longleftrightarrow 297 | Longleftrightarrow 298 | iff 299 | ldotp 300 | cdotp 301 | colon 302 | dots 303 | ldots 304 | cdots 305 | vdots 306 | ddots) 307 | 308 | (provide (rename-out [tex:stackrel stackrel])) 309 | (define (tex:stackrel [top : MathTeX+Like] [body : MathTeX+Like]) 310 | (macro "stackrel" (argument top) (argument body))) 311 | 312 | (provide-macros-1 313 | smash) 314 | 315 | (provide-macros 316 | \, 317 | thinspace 318 | > 319 | \: 320 | medspace 321 | \; 322 | thickspace 323 | enspace 324 | quad 325 | qquad 326 | | | 327 | nobreakspace 328 | space 329 | ! 330 | negthinspace 331 | negmedspace 332 | negthickspace 333 | mathstrut) 334 | 335 | (provide-macros-1 336 | phantom 337 | hphantom 338 | vphantom) 339 | 340 | (provide (rename-out [tex:frac frac])) 341 | (define (tex:frac [num : MathTeX+Like] [den : MathTeX+Like]) 342 | (macro "frac" (argument num) (argument den))) 343 | 344 | (define ((make-binom-cmd [a : String]) 345 | [x : MathTeX+Like] [y : MathTeX+Like]) 346 | (group x (macro a) y)) 347 | 348 | (define-syntax (provide-binom-macro stx) 349 | (make-provide-syntax stx #'make-binom-cmd)) 350 | 351 | (define-syntax-rule (provide-binom-macros id ...) 352 | (begin (provide-binom-macro id) ...)) 353 | 354 | (provide-binom-macros 355 | choose 356 | brack 357 | brace) 358 | 359 | (provide-macros 360 | log 361 | lg 362 | ln 363 | lim 364 | limsup 365 | liminf 366 | sin 367 | arcsin 368 | sinh 369 | cos 370 | arccos 371 | cosh 372 | tan 373 | arctan 374 | tanh 375 | cot 376 | coth 377 | sec 378 | csc 379 | max 380 | min 381 | sup 382 | inf 383 | arg 384 | ker 385 | dim 386 | hom 387 | det 388 | exp 389 | Pr 390 | gcd 391 | deg 392 | bmod 393 | pmod) 394 | 395 | (provide (rename-out [tex:sqrt sqrt])) 396 | (define (tex:sqrt #:base [base : (Option MathTeX+Like) #f] 397 | [body : MathTeX+Like]) 398 | (define a (argument body)) 399 | (if base 400 | (macro "sqrt" (optional-argument base) a) 401 | (macro "sqrt" a))) 402 | 403 | (provide-macros-1 404 | mathbin 405 | mathclose 406 | mathinner 407 | mathop 408 | mathopen 409 | mathord 410 | mathpunct 411 | mathrel 412 | mathrm 413 | mathnormal 414 | textrm 415 | textnormal 416 | mathsf 417 | textsf 418 | mathbf 419 | textbf 420 | textmd 421 | mathtt 422 | texttt 423 | mathit 424 | textit 425 | textup 426 | mathcal) 427 | 428 | (provide-macros 429 | displaystyle 430 | textstyle 431 | scriptstyle 432 | scriptscriptstyle 433 | limits 434 | nolimits) 435 | -------------------------------------------------------------------------------- /morg/proof.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "markup/article.rkt") 4 | 5 | (provide make-proof) 6 | -------------------------------------------------------------------------------- /morg/scribblings/morg.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[@for-label[racket/base]] 3 | 4 | @title{morg} 5 | @author{Taichi Uemura} 6 | -------------------------------------------------------------------------------- /morg/text/article.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/article.rkt" 4 | "../markup/string.rkt" 5 | "../data/node.rkt" 6 | "../markup/splice.rkt" 7 | "block.rkt" 8 | "inline.rkt" 9 | "id.rkt" 10 | "numbering.rkt" 11 | "state.rkt") 12 | 13 | (provide article->text) 14 | 15 | (define ((article->text [st : State]) [a : Article]) : StringTree 16 | @string%{ 17 | 18 | @(head a st) 19 | @(body a st) 20 | }) 21 | 22 | (define (head [a : Article] [st : State]) : StringTree 23 | (define tbl (state-node-table st)) 24 | (define id (article-id a)) 25 | (define in? (node-table-has-key? tbl id)) 26 | (define h (pure-inline->text (article-header a))) 27 | (define title (article-title a)) 28 | (define num 29 | @string%{@when%[in?]{@(article-node-format-index (cast (node-table-ref tbl id) ArticleNode)) }}) 30 | (define tt 31 | @string%{@when%[title]{ (@(pure-inline->text title))}}) 32 | (define i 33 | (id->text id)) 34 | @string%{ 35 | @|num|@|i| @|h|@|tt| 36 | }) 37 | 38 | (define (body [a : Article] [st : State]) : StringTree 39 | (define pf (article-proof a)) 40 | @string%{ 41 | @((block->text st) (article-contents a)) 42 | @when%[pf]{ 43 | @((proof->text st) pf) 44 | } 45 | }) 46 | 47 | (define ((proof->text [st : State]) [p : Proof]) : StringTree 48 | @string%{ 49 | 50 | @(pure-inline->text (proof-header p)) 51 | @((block->text st) (proof-contents p)) 52 | }) 53 | -------------------------------------------------------------------------------- /morg/text/block.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/block.rkt" 4 | "../data/splice.rkt" 5 | "../markup/string.rkt" 6 | "../markup/index.rkt" 7 | "../data/index-table.rkt" 8 | "splice.rkt" 9 | "inline.rkt" 10 | "state.rkt") 11 | 12 | (provide block->text) 13 | 14 | (: block->text : (State . -> . (Block . -> . StringTree))) 15 | 16 | (define ((paragraph->text [st : State]) [p : Paragraph]) : StringTree 17 | @string%{ 18 | 19 | @((inline->text st) (paragraph-contents p)) 20 | 21 | }) 22 | 23 | (define ((print-index->text [st : State]) [p : PrintIndex]) : StringTree 24 | (define type (print-index-type p)) 25 | (define tbl (state-index-table st)) 26 | (define in? (index-table-has-key? tbl type)) 27 | (cond 28 | [in? 29 | ((inline->text st) (index-list->inline (index-table-ref tbl type)))] 30 | [else @string%{}])) 31 | 32 | (define ((block->text st) b) 33 | (define x (block-contents b)) 34 | (cond 35 | [(paragraph? x) 36 | ((paragraph->text st) x)] 37 | [(print-index? x) 38 | ((print-index->text st) x)] 39 | [(splice? x) 40 | ((splice->text (block->text st)) x)] 41 | [else (error "Unimplemented.")])) 42 | -------------------------------------------------------------------------------- /morg/text/config.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../markup/string.rkt") 4 | 5 | (provide (struct-out config) Config 6 | default-config 7 | config-make-section-ref%) 8 | 9 | (struct config 10 | ([make-section-ref : (Natural String . -> . StringTreeLike)]) 11 | #:transparent 12 | #:type-name Config) 13 | 14 | (define (default-config:make-section-ref [_depth : Natural] [num : String]) : StringTreeLike 15 | @string%{Section @|num|}) 16 | 17 | (define default-config 18 | (config 19 | default-config:make-section-ref)) 20 | 21 | (define ((config-make-section-ref% [cfg : Config]) 22 | [depth : Natural] . [num : StringTreeLike *]) 23 | ((config-make-section-ref cfg) depth (apply string-tree-like->string* num))) 24 | -------------------------------------------------------------------------------- /morg/text/convert.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "../data/section.rkt" 5 | "../data/article.rkt" 6 | "../data/node.rkt" 7 | "../data/index-table.rkt" 8 | "../data/anchor-table.rkt" 9 | "../markup/string.rkt" 10 | "document.rkt" 11 | "section.rkt" 12 | "article.rkt" 13 | "config.rkt" 14 | "state.rkt") 15 | 16 | (provide ->text) 17 | 18 | (define (->text #:config [cfg : Config default-config] [doc : (U Document Section Article)]) : String 19 | (define x 20 | (cond 21 | [(document? doc) ((document->text cfg) doc)] 22 | [(section? doc) 23 | (define st 24 | (state cfg empty-index-table 25 | empty-anchor-table 26 | (make-node-table (list doc)))) 27 | ((section->text st) doc)] 28 | [(article? doc) 29 | (define st 30 | (state cfg empty-index-table 31 | empty-anchor-table 32 | (make-node-table (list)))) 33 | ((article->text st) doc)])) 34 | (string-tree->string x)) 35 | -------------------------------------------------------------------------------- /morg/text/date.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/date.rkt" 4 | "../markup/string.rkt" 5 | "../markup/splice.rkt") 6 | 7 | (provide date->text) 8 | 9 | (define (date->text [d : Date]) : StringTree 10 | (define yyyy (~r (date-year d) #:min-width 4 #:pad-string "0")) 11 | (define mm (date-month d)) 12 | (define -mm : StringTreeLike 13 | @when%[mm]{-@(~r mm #:min-width 2 #:pad-string "0")}) 14 | (define dd (date-day d)) 15 | (define -dd : StringTreeLike 16 | @when%[dd]{-@(~r dd #:min-width 2 #:pad-string "0")}) 17 | @string%{@|yyyy|@|-mm|@|-dd|}) 18 | -------------------------------------------------------------------------------- /morg/text/document.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/document.rkt" 4 | "../markup/string.rkt" 5 | "../data/node.rkt" 6 | "../data/index-table.rkt" 7 | "../data/anchor-table.rkt" 8 | "../util/list.rkt" 9 | "section.rkt" 10 | "inline.rkt" 11 | "block.rkt" 12 | "date.rkt" 13 | "state.rkt" 14 | "config.rkt") 15 | 16 | (provide document->text) 17 | 18 | (define ((document->text [cfg : Config]) [doc : Document]) : StringTree 19 | (define front (document-front doc)) 20 | (define main (document-main doc)) 21 | (define back (document-back doc)) 22 | (define st 23 | (state cfg 24 | (make-index-table doc) 25 | (make-anchor-table doc) 26 | (make-node-table main))) 27 | (define f pure-inline->text) 28 | (define g (section->text st)) 29 | (define h (block->text st)) 30 | @string%{ 31 | @(f (document-title doc)) 32 | ======================================== 33 | 34 | @(apply string% 35 | (list-join-1 36 | (map f (document-author doc)) 37 | ", ")) 38 | 39 | @(date->text (document-date doc)) 40 | @(h (document-contents doc)) 41 | @(apply string% (map g front)) 42 | @(apply string% (map g main)) 43 | @(apply string% (map g back)) 44 | }) 45 | -------------------------------------------------------------------------------- /morg/text/id.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/id.rkt" 4 | "../markup/string.rkt") 5 | 6 | (provide id->text 7 | anchor-id->text) 8 | 9 | (define (id->text [i : Id]) : StringTree 10 | @string%{[@(id-contents i)]}) 11 | 12 | (define (anchor-id->text [node : Id] [anchor : Id]) : StringTree 13 | @string%{[@(id-contents node)#@(id-contents anchor)]}) 14 | -------------------------------------------------------------------------------- /morg/text/inline.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/inline.rkt" 4 | "../data/splice.rkt" 5 | "../data/node.rkt" 6 | "../data/article.rkt" 7 | "../data/anchor-table.rkt" 8 | "../data/extension.rkt" 9 | "../markup/string.rkt" 10 | "../markup/splice.rkt" 11 | "splice.rkt" 12 | "numbering.rkt" 13 | "id.rkt" 14 | "tex.rkt" 15 | "config.rkt" 16 | "state.rkt") 17 | 18 | (provide inline->text 19 | pure-inline->text) 20 | 21 | (: inline->text : (State . -> . (Inline . -> . StringTree))) 22 | (: pure-inline->text : (PureInline . -> . StringTree)) 23 | 24 | (define (text->text [t : Text]) : StringTree 25 | (string% (text-contents t))) 26 | 27 | (define ((ref->text [st : State]) [r : Ref]) : StringTree 28 | (define tbl (state-node-table st)) 29 | (define id (ref-id r)) 30 | (define in? (node-table-has-key? tbl id)) 31 | (define s 32 | (cond 33 | [in? 34 | (define user (state-config st)) 35 | (define mk (config-make-section-ref% user)) 36 | (define nd (node-table-ref tbl id)) 37 | (define s1 38 | (cond 39 | [(section-node? nd) 40 | (mk (length (node-trace nd)) 41 | (section-node-format-index nd))] 42 | [(article-node? nd) 43 | @string%{@(pure-inline->text (article-header (article-node-contents nd))) @(article-node-format-index nd)}])) 44 | @string%{@|s1| }] 45 | [else @string%{}])) 46 | @string%{@|s|@(id->text id)}) 47 | 48 | (define (math->text [m : Math]) : StringTree 49 | @string%{\(@(math-tex->text (math-contents m))\)}) 50 | 51 | (define #:forall (Inline) 52 | ((list-item->text [f : (Inline . -> . StringTree)]) 53 | [i : (ListItem Inline)]) : StringTree 54 | @string%{ @(f (list-item-head i)) @(f (list-item-contents i))}) 55 | 56 | (define #:forall (Inline) 57 | ((unordered-list->text [f : (Inline . -> . StringTree)]) 58 | [ul : (UnorderedList Inline)]) : StringTree 59 | @string%{ 60 | {@(apply % (map (list-item->text f) (unordered-list-contents ul)))} 61 | }) 62 | 63 | (define #:forall (Inline) 64 | ((ordered-list->text [f : (Inline . -> . StringTree)]) 65 | [ol : (OrderedList Inline)]) : StringTree 66 | @string%{ 67 | {@(apply % (map (list-item->text f) (ordered-list-contents ol)))} 68 | }) 69 | 70 | (define #:forall (Inline) 71 | ((href->text [f : (Inline . -> . StringTree)]) 72 | [h : (HRef Inline)]) : StringTree 73 | (define url (href-url h)) 74 | (define contents (href-contents h)) 75 | (if contents 76 | @string%{[@(f contents)](@|url|)} 77 | @string%{<@|url|>})) 78 | 79 | (define #:forall (Inline) 80 | ((emph->text [f : (Inline . -> . StringTree)]) 81 | [e : (Emph Inline)]) : StringTree 82 | @string%{*@(f (emph-contents e))*}) 83 | 84 | (define #:forall (Inline) 85 | ((display->text [f : (Inline . -> . StringTree)]) 86 | [d : (Display Inline)]) : StringTree 87 | @string%{ 88 | 89 | 90 | @(f (display-contents d)) 91 | 92 | 93 | }) 94 | 95 | (define #:forall (Inline) 96 | ((code->text [f : (Inline . -> . StringTree)]) 97 | [c : (Code Inline)]) : StringTree 98 | @string%{`@(f (code-contents c))`}) 99 | 100 | (define #:forall (Inline) 101 | ((dfn->text [f : (Inline . -> . StringTree)]) 102 | [d : (Dfn Inline)]) : StringTree 103 | @string%{*@(f (dfn-contents d))*}) 104 | 105 | (define #:forall (Inline) 106 | ((pure-inline-element->text [f : (Inline . -> . StringTree)]) 107 | [pi : (PureInlineElement Inline)]) : StringTree 108 | (cond 109 | [(text? pi) (text->text pi)] 110 | [(math? pi) (math->text pi)] 111 | [(unordered-list? pi) ((unordered-list->text f) pi)] 112 | [(ordered-list? pi) ((ordered-list->text f) pi)] 113 | [(href? pi) ((href->text f) pi)] 114 | [(emph? pi) ((emph->text f) pi)] 115 | [(display? pi) ((display->text f) pi)] 116 | [(code? pi) ((code->text f) pi)] 117 | [(dfn? pi) ((dfn->text f) pi)])) 118 | 119 | (define ((anchor-ref->text [st : State]) 120 | [ar : AnchorRef]) : StringTree 121 | (define tbl (state-anchor-table st)) 122 | (define id-n (anchor-ref-node ar)) 123 | (define id-a (anchor-ref-anchor ar)) 124 | (define key (anchor-key id-n id-a)) 125 | (if (anchor-table-has-key? tbl key) 126 | (pure-inline->text (anchor-contents (anchor-table-ref tbl key))) 127 | @string%{@(anchor-id->text id-n id-a)})) 128 | 129 | (define #:forall (Inline) 130 | ((extension->text [_st : State] 131 | [f : (Inline . -> . StringTree)]) 132 | [s : (Extension (Listof Inline))]) : StringTree 133 | (apply string% (map f (extension-contents s)))) 134 | 135 | (define #:forall (PureInline Inline) 136 | ((inline-element->text [st : State] 137 | [g : (PureInline . -> . StringTree)] 138 | [f : (Inline . -> . StringTree)]) 139 | [i : (InlineElement PureInline Inline)]) : StringTree 140 | (cond 141 | [(ref? i) ((ref->text st) i)] 142 | [(anchor? i) (g (anchor-contents i))] 143 | [(anchor-ref? i) ((anchor-ref->text st) i)] 144 | [(extension? i) ((extension->text st f) i)] 145 | [else ((pure-inline-element->text f) i)])) 146 | 147 | (define ((inline->text st) i) 148 | (define x (inline-contents i)) 149 | (define f (inline->text st)) 150 | (define g pure-inline->text) 151 | (cond 152 | [(splice? x) (string% (splice-map f x))] 153 | [else ((inline-element->text st g f) x)])) 154 | 155 | (define (pure-inline->text pi) 156 | (define x (pure-inline-contents pi)) 157 | (define f pure-inline->text) 158 | (cond 159 | [(splice? x) (string% (splice-map f x))] 160 | [else ((pure-inline-element->text f) x)])) 161 | -------------------------------------------------------------------------------- /morg/text/numbering.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/node.rkt" 4 | "../markup/string.rkt" 5 | "../util/list.rkt") 6 | 7 | (provide section-node-format-index 8 | article-node-format-index) 9 | 10 | (define (section-node-format-index [n : SectionNode]) : StringTree 11 | (define is (map node-index (node-trace n))) 12 | (define ns (map number-format is)) 13 | (define xs (list-join-1 ns ".")) 14 | (apply string% xs)) 15 | 16 | (define (article-node-format-index [n : ArticleNode]) : StringTree 17 | (define i (article-node-index n)) 18 | (define p (article-node-parent n)) 19 | @string%{@(section-node-format-index p)*@(number-format i)}) 20 | 21 | (define (number-format [n : Natural]) : String 22 | (number->string (+ n 1))) 23 | -------------------------------------------------------------------------------- /morg/text/preview.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "convert.rkt" 4 | "../markup/syntax.rkt") 5 | 6 | (provide preview) 7 | 8 | (define-syntax-rule (preview) 9 | (display (->text (include-part (submod ".."))))) 10 | -------------------------------------------------------------------------------- /morg/text/section.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/section.rkt" 4 | "../data/node.rkt" 5 | "../data/article.rkt" 6 | "../data/block.rkt" 7 | "../markup/string.rkt" 8 | "../markup/splice.rkt" 9 | "state.rkt" 10 | "inline.rkt" 11 | "block.rkt" 12 | "article.rkt" 13 | "id.rkt" 14 | "numbering.rkt") 15 | 16 | (provide section->text) 17 | 18 | (define ((section->text [st : State]) [s : Section]) : StringTree 19 | @string%{ 20 | 21 | @(header s st) 22 | 23 | @(body s st) 24 | 25 | @(sub s st) 26 | }) 27 | 28 | (define (header [s : Section] [st : State]) : StringTree 29 | (define tbl (state-node-table st)) 30 | (define id (section-id s)) 31 | (define in? (node-table-has-key? tbl id)) 32 | (define title (pure-inline->text (section-title s))) 33 | (define num 34 | @string%{@when%[in?]{@(section-node-format-index (cast (node-table-ref tbl id) SectionNode)) }}) 35 | (define i 36 | (id->text id)) 37 | @string%{ 38 | @|num|@|i| @|title| 39 | ---------------------------------------- 40 | }) 41 | 42 | (define ((section-element->text [st : State]) [e : SectionElement]) : StringTree 43 | (cond 44 | [(article? e) ((article->text st) e)] 45 | [(block? e) ((block->text st) e)])) 46 | 47 | (define (body [s : Section] [st : State]) : StringTree 48 | (apply string% 49 | (map (section-element->text st) (section-contents s)))) 50 | 51 | (define (sub [s : Section] [st : State]) : StringTree 52 | (apply string% 53 | (map (section->text st) (section-subsections s)))) 54 | -------------------------------------------------------------------------------- /morg/text/splice.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "../data/splice.rkt" 4 | "../markup/string.rkt") 5 | 6 | (provide splice->text) 7 | 8 | (define #:forall (X) 9 | ((splice->text [f : (X . -> . StringTree)]) 10 | [x : (Splice X)]) : StringTree 11 | (string% (splice-map f x))) 12 | -------------------------------------------------------------------------------- /morg/text/state.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require "config.rkt" 4 | "../data/index-table.rkt" 5 | "../data/anchor-table.rkt" 6 | "../data/node.rkt") 7 | 8 | (provide (struct-out state) State) 9 | 10 | (struct state 11 | ([config : Config] 12 | [index-table : IndexTable] 13 | [anchor-table : AnchorTable] 14 | [node-table : NodeTable]) 15 | #:transparent 16 | #:type-name State) 17 | -------------------------------------------------------------------------------- /morg/text/tex.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp typed/racket 2 | 3 | (require "../data/tex.rkt" 4 | "../markup/string.rkt" 5 | "../markup/splice.rkt" 6 | "../data/splice.rkt" 7 | "splice.rkt" 8 | "../util/escape.rkt") 9 | 10 | (provide text-tex->text 11 | math-tex->text) 12 | 13 | (define escape-text-tex 14 | (hash "#" "\\#" 15 | "$" "\\$" 16 | "%" "\\%" 17 | "&" "\\&" 18 | "_" "\\_" 19 | "{" "\\{" 20 | "}" "\\}" 21 | "~" "\\textasciitilde " 22 | "^" "\\textasciicircum " 23 | "\\" "\\textbackslash ")) 24 | 25 | (define escape-math-tex 26 | (hash "#" "\\#" 27 | "$" "\\$" 28 | "%" "\\%" 29 | "&" "\\&" 30 | "_" "\\_" 31 | "{" "\\{" 32 | "}" "\\}" 33 | "~" "\\~{}" 34 | "^" "\\^{}" 35 | "\\" "\\backslash ")) 36 | 37 | (define (text-tex->text:text [x : Text]) : StringTree 38 | @string%{@(escape escape-text-tex (text-contents x))}) 39 | 40 | (define (math-tex->text:text [x : Text]) : StringTree 41 | @string%{@(escape escape-math-tex (text-contents x))}) 42 | 43 | (define #:forall (X) 44 | ((argument->text [f : (X . -> . StringTree)]) 45 | [x : (Argument X)]) : StringTree 46 | (define body (argument-contents x)) 47 | (define parens (argument-parentheses x)) 48 | (define left (car parens)) 49 | (define right (cdr parens)) 50 | @string%{@|left|@(f body)@|right|}) 51 | 52 | (define #:forall (X) 53 | ((macro->text [f : (X . -> . StringTree)]) 54 | [x : (Macro X)]) : StringTree 55 | (define y (macro-head x)) 56 | (define args (macro-arguments x)) 57 | (define head 58 | (cond 59 | [(or (regexp-match-exact? #px"[[:alpha:]]+" y) 60 | (eq? (string-length y) 1)) 61 | @string%{\@|y|}] 62 | [else 63 | @string%{\csname @|y|\endcsname}])) 64 | @string%{@|head| @(apply % (map ((inst argument->text X) f) args))}) 65 | 66 | (define #:forall (X) 67 | ((group->text [f : (X . -> . StringTree)]) 68 | [x : (Group X)]) : StringTree 69 | @string%{{@(f (group-contents x))}}) 70 | 71 | (define #:forall (X) 72 | ((atom->text [f : (X . -> . StringTree)] 73 | [t : (Text . -> . StringTree)]) 74 | [x : (Atom X)]) : StringTree 75 | (define y (atom-contents x)) 76 | (cond 77 | [(text? y) (t y)] 78 | [(special? y) @string%{@(special-contents y)}] 79 | [(macro? y) ((macro->text f) y)] 80 | [(group? y) ((group->text f) y)])) 81 | 82 | (define (math->text [x : Math]) : StringTree 83 | @string%{\(@(math-tex->text (math-contents x))\)}) 84 | 85 | (define #:forall (A X) 86 | ((sub-sup->text [g : (A . -> . StringTree)] [f : (X . -> . StringTree)]) 87 | [x : (SubSup A X)]) : StringTree 88 | (define base (sub-sup-base x)) 89 | (define sub (sub-sup-sub x)) 90 | (define sup (sub-sup-sup x)) 91 | (define b (g base)) 92 | (cond 93 | [(and sub sup) 94 | @string%{@|b|_{@(f sub)}^{@(f sup)}}] 95 | [sub 96 | @string%{@|b|_{@(f sub)}}] 97 | [sup 98 | @string%{@|b|^{@(f sup)}}] 99 | [else (error "This must not happen.")])) 100 | 101 | (define (text-tex->text [x : TextTeX]) : StringTree 102 | (define y (text-tex-contents x)) 103 | (cond 104 | [(atom? y) 105 | ((atom->text text-tex->text text-tex->text:text) y)] 106 | [(splice? y) ((splice->text text-tex->text) y)] 107 | [(math? y) (math->text y)] 108 | [else (error "Unimplemented.")])) 109 | 110 | (define (math-tex->text [x : MathTeX]) : StringTree 111 | (define y (math-tex-contents x)) 112 | (define g (atom->text math-tex->text math-tex->text:text)) 113 | (cond 114 | [(atom? y) (g y)] 115 | [(splice? y) ((splice->text math-tex->text) y)] 116 | [(sub-sup? y) (((inst sub-sup->text (Atom MathTeX) MathTeX) g math-tex->text) y)] 117 | [else (error "Unimplemented.")])) 118 | -------------------------------------------------------------------------------- /morg/util/escape.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide escape) 4 | 5 | (module+ test 6 | (require typed/rackunit)) 7 | 8 | (define (escape [h : (HashTable String String)] [s : String]) : String 9 | (define pat 10 | (regexp 11 | (string-join (map regexp-quote (hash-keys h)) 12 | "|"))) 13 | (regexp-replace* pat s 14 | (lambda ([x : String] . _rest) 15 | (hash-ref h x)))) 16 | 17 | (module+ test 18 | (define h 19 | (hash "\\" "\\\\" 20 | "#" "\\#")) 21 | (check-equal? 22 | (escape h "Hello \\world#\\#") 23 | "Hello \\\\world\\#\\\\\\#")) 24 | -------------------------------------------------------------------------------- /morg/util/list.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide list-join list-join-1 4 | list-group 5 | list-map) 6 | 7 | (module+ test 8 | (require typed/rackunit)) 9 | 10 | (: list-join : (All (X) ((Listof (Listof X)) (Listof X) . -> . (Listof X)))) 11 | 12 | (define (list-join xss sep) 13 | (match xss 14 | [(list) (list)] 15 | [(list xs) xs] 16 | [(list* xs ys xss) 17 | (append xs sep (list-join (list* ys xss) sep))])) 18 | 19 | (define #:forall (X) 20 | (list-join-1 [xs : (Listof X)] [sep : X]) : (Listof X) 21 | (list-join (map (lambda ([x : X]) (list x)) xs) (list sep))) 22 | 23 | (define #:forall (X Y) 24 | ((list-map [f : (X . -> . Y)]) 25 | [x : (Listof X)]) : (Listof Y) 26 | (map f x)) 27 | 28 | (: list-group:aux (All (X) ((Listof X) Exact-Positive-Integer (Listof (Listof X)) . -> . (Listof (Listof X))))) 29 | 30 | (define (list-group:aux ls n acc) 31 | (cond 32 | [(null? ls) (reverse acc)] 33 | [else 34 | (define-values (h t) (split-at ls n)) 35 | (list-group:aux t n (list* h acc))])) 36 | 37 | (define #:forall (X) 38 | (list-group [ls : (Listof X)] [n : Exact-Positive-Integer]) : (Listof (Listof X)) 39 | (list-group:aux ls n (list))) 40 | 41 | (module+ test 42 | (check-equal? (list-group '(0 1 2 3 4 5) 2) 43 | '((0 1) (2 3) (4 5))) 44 | (check-equal? (list-group '(0 1 2 3 4 5) 3) 45 | '((0 1 2) (3 4 5))) 46 | (check-exn exn:fail? 47 | (lambda () 48 | (list-group '(0 1 2 3 4) 2))) 49 | (check-true (assert-typecheck-fail 50 | (list-group '(0 1 2 3) 0) 51 | #:result #t))) 52 | -------------------------------------------------------------------------------- /morg/util/option.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (provide option-map) 4 | 5 | (define #:forall (X Y) 6 | (option-map [f : (X . -> . Y)] [x : (Option X)]) : (Option Y) 7 | (if x (f x) #f)) 8 | --------------------------------------------------------------------------------