├── examples ├── haskell.png ├── Example.book ├── Fragment.markdown ├── Headings.markdown └── Mixed.markdown ├── .hunspell ├── stack.yaml ├── .ghci ├── tests ├── fragments │ ├── Blockquotes.markdown │ ├── Poetry.markdown │ ├── Headings.markdown │ ├── LatexBlocks.markdown │ ├── CodeBlocks.markdown │ ├── PipeTable.md │ ├── WeirdInlines.markdown │ ├── DivBlocks.markdown │ ├── HtmlBlocks.markdown │ ├── DefinitionList.markdown │ ├── MultilineTable.markdown │ ├── Paragraphs.markdown │ ├── BulletList.markdown │ └── OrderedList.markdown ├── problematic │ ├── RelativeImage.markdown │ └── Strike.markdown ├── Example.book ├── TestSuite.hs ├── ReformatTest.hs ├── WalkPandocTest.hs ├── CompareFragments.hs ├── CheckBookfileParser.hs └── CheckTableProperties.hs ├── .gitignore ├── Makefile ├── CHANGELOG.md ├── symlinks ├── src ├── Environment.hs ├── FormatMain.hs ├── LatexOutputReader.hs ├── ParseBookfile.hs ├── Utilities.hs ├── FormatDocument.hs ├── RenderMain.hs ├── LatexPreamble.hs ├── PandocToMarkdown.hs └── RenderDocument.hs ├── .github └── workflows │ └── check.yaml ├── LICENSE ├── doc ├── Examples.md ├── Tutorial.md ├── Background.md └── Docker.md ├── README.md └── package.yaml /examples/haskell.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aesiniath/publish/HEAD/examples/haskell.png -------------------------------------------------------------------------------- /examples/Example.book: -------------------------------------------------------------------------------- 1 | % publish v2 2 | % begin 3 | Fragment.markdown 4 | haskell.png 5 | % end 6 | -------------------------------------------------------------------------------- /.hunspell: -------------------------------------------------------------------------------- 1 | LaTeX 2 | PNG 3 | toolchains 4 | SVG 5 | SVGs 6 | PDFs 7 | pre 8 | pandoc 9 | pdf 10 | xetex 11 | svg 12 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-22.23 2 | compiler: ghc-9.6.5 3 | packages: 4 | - . 5 | ghc-options: 6 | HsOpenSSL: -optc=-Wno-incompatible-pointer-types 7 | -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | :set -isrc:tests 2 | :set -XOverloadedStrings 3 | 4 | import Data.Text (Text) 5 | import qualified Data.Text as T 6 | import qualified Data.Text.IO as T 7 | -------------------------------------------------------------------------------- /tests/fragments/Blockquotes.markdown: -------------------------------------------------------------------------------- 1 | > This is a test of the **Emergency Broadcast System**. Do not be alarmed. If 2 | > this were not a test, you wouldn't _need_ to know. Hic. 3 | -------------------------------------------------------------------------------- /tests/problematic/RelativeImage.markdown: -------------------------------------------------------------------------------- 1 | This path is relative. 2 | 3 | ![One](here.png) 4 | 5 | ![Two](fragments/below.png) 6 | 7 | ![Three](../above.png) 8 | 9 | Done 10 | -------------------------------------------------------------------------------- /tests/fragments/Poetry.markdown: -------------------------------------------------------------------------------- 1 | Noirmontier 2 | =========== 3 | 4 | Beginning: 5 | 6 | | There rises, from the mist 7 | | More than a rock 8 | | Home 9 | 10 | That's not much of a poem. 11 | -------------------------------------------------------------------------------- /tests/Example.book: -------------------------------------------------------------------------------- 1 | % publish v2 2 | preamble.latex 3 | % begin 4 | Introduction.markdown 5 | RelatedWork.markdown 6 | Results.latex 7 | chart-07.svg 8 | Analysis.markdown 9 | Conclusion.markdown 10 | References.latex 11 | % end 12 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # build artifacts 2 | /.stack-work/ 3 | /stack.yaml.lock 4 | /tags 5 | /publish.cabal 6 | /.vscode 7 | 8 | # symlinks to executables 9 | /render 10 | /format 11 | /check 12 | /experiment 13 | 14 | # runtime debris 15 | /.target 16 | *.pdf 17 | -------------------------------------------------------------------------------- /tests/fragments/Headings.markdown: -------------------------------------------------------------------------------- 1 | First level Heading 2 | =================== 3 | 4 | Normal text 5 | 6 | Secon level heading 7 | ------------------- 8 | 9 | Normal text 10 | 11 | ### Third level heading 12 | 13 | Normal text 14 | 15 | #### Fourth level heading 16 | 17 | Normal text 18 | -------------------------------------------------------------------------------- /tests/problematic/Strike.markdown: -------------------------------------------------------------------------------- 1 | 2 | This is ~~not~~ kosher. 3 | 4 | 1) example: 5 | Two alternatives 6 | a) Review Manager 7 | b) Spreadsheet 8 | 9 | ↓ 10 | 11 | ? Manual step 12 | 13 | Now a known smaller image: 14 | 15 | ![](examples/haskell.png) 16 | 17 | done. 18 | 19 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: links 2 | 3 | links: render 4 | 5 | ifdef V 6 | MAKEFLAGS=-R 7 | else 8 | MAKEFLAGS=-s -R 9 | REDIRECT=2>/dev/null 10 | endif 11 | 12 | render: 13 | @echo -e "LN\t$@" 14 | ln -s `stack exec -- which render` render 15 | 16 | clean: 17 | @echo -e "CLEAN\tsymlinks" 18 | -rm -f render 19 | 20 | tags: 21 | hasktags -c -x src tests 22 | -------------------------------------------------------------------------------- /tests/fragments/LatexBlocks.markdown: -------------------------------------------------------------------------------- 1 | Ideally, someone will leave the LaTeX to the experts: 2 | 3 | \begin{image} 4 | \includegraphics{haskell.png} 5 | \end{image} 6 | 7 | There is undoubtedly some strange behaviour to be had. 8 | 9 | It's more confusing when we look at \textbf{strong} text that is formatted 10 | with inline LaTeX. 11 | 12 | But you never know. 13 | -------------------------------------------------------------------------------- /tests/fragments/CodeBlocks.markdown: -------------------------------------------------------------------------------- 1 | Some people think Haskell is a difficult language to understand. They're 2 | right: 3 | 4 | ```haskell 5 | x = Right "This is too hard" 6 | 7 | mail :: IO () 8 | main = print x 9 | ``` 10 | 11 | But only a little right. If they were `Left` it would be easy. 12 | 13 | If you don't want to say the language you speak: 14 | 15 | ``` 16 | This might be text 17 | ``` 18 | 19 | that's ok. 20 | -------------------------------------------------------------------------------- /tests/fragments/PipeTable.md: -------------------------------------------------------------------------------- 1 | Introduction this is. 2 | 3 | | Centered Header | Default Aligned | Right Aligned | Left Aligned | 4 | |:-----------------:|-------------------|------------------:|:------------------| 5 | | First | row1 | `12.0` | Example of a row that goes on and on and spans multiple lines. | 6 | | Second | row2 | `5.0` | Here’s another one. Note the blank line between rows. | 7 | | Tee | row3 | `4567.1` | Now this is interesting. | 8 | 9 | And we’re done. 10 | -------------------------------------------------------------------------------- /tests/fragments/WeirdInlines.markdown: -------------------------------------------------------------------------------- 1 | There are some strange inlines in [Pandoc]{.smallcaps}-flavoured Markdown. 2 | 3 | Sometimes people feel the need to go on ~~strike~~. This is not the same as 4 | spending $200 and passing Go. But if you wish to $x$ it out, go right ahead. 5 | 6 | There are some rules about H~2~O and large numbers like 2^64^ that you 7 | probably want to know about. Like the one about escaping P~a\ cat~. 8 | 9 | Meanwhile [this]{.sticky} is not a link! 10 | -------------------------------------------------------------------------------- /tests/TestSuite.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | import CheckBookfileParser 5 | import CheckTableProperties 6 | import CompareFragments 7 | import Control.Exception.Safe qualified as Safe 8 | import Test.Hspec 9 | 10 | main :: IO () 11 | main = do 12 | Safe.finally (hspec suite) (putStrLn ".") 13 | 14 | suite :: Spec 15 | suite = do 16 | checkTableProperties 17 | checkByComparingFragments 18 | checkBookfileParser 19 | -------------------------------------------------------------------------------- /examples/Fragment.markdown: -------------------------------------------------------------------------------- 1 | Example 2 | ======= 3 | 4 | This is an example. 5 | 6 | Standard challenges 7 | ------------------- 8 | 9 | This is a test of the **Emergency Broadcast System**. Do not be alarmed. If this 10 | were not a test, you wouldn't _need_ to know. Hic. 11 | 12 | ### Below the line 13 | 14 | Subheadings are out of vogue, but you wouldn't know it. Images, on the other 15 | hand, are very much the thing: 16 | 17 | ![](haskell.png) 18 | 19 | One of my favourites. 20 | 21 | 22 | -------------------------------------------------------------------------------- /examples/Headings.markdown: -------------------------------------------------------------------------------- 1 | HEADINGS 2 | ======== 3 | 4 | This is a file with many headings. 5 | 6 | Second level 7 | ------------ 8 | 9 | Subheadings are the magical beings of document organization. 10 | 11 | ### Third level 12 | 13 | The third level can be used for headings within the second level. Which is 14 | somewhat radical, but that's only the half of it. 15 | 16 | #### Fourth level 17 | 18 | After fourth level, you're getting silly. 19 | 20 | Another section 21 | --------------- 22 | 23 | And now we conclude. 24 | 25 | -------------------------------------------------------------------------------- /tests/ReformatTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Core.Program 6 | import FormatDocument (loadFragment) 7 | import PandocToMarkdown (pandocToMarkdown) 8 | 9 | main :: IO () 10 | main = execute $ do 11 | setVerbosityLevel Debug 12 | 13 | event "Load fragment" 14 | doc <- loadFragment "tests/fragments/PipeTable.md" 15 | debugS "doc" doc 16 | 17 | event "Convert..." 18 | let text = pandocToMarkdown doc 19 | debug "text" text 20 | 21 | event "Complete" 22 | terminate 0 23 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | - _v0.4.4_ 2 | This release fixes support for running within a Linux container via 3 | docker-machine on a Mac. Also showcased is continued work on the 4 | experimental Markdown reformatting tool. 5 | 6 | - _v0.4.1_ 7 | Add `--temp` option, allowing user to override the default behaviour of 8 | randomly allocating a temporary directory and recording it in the 9 | _.target_ file. 10 | 11 | - _v0.4.0_ 12 | Initial release of _format_ tool (EXPERIMENTAL). 13 | 14 | - _v0.3.2_ 15 | Initial public release. 16 | -------------------------------------------------------------------------------- /symlinks: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ROOTDIR=`stack path --local-install-root` 4 | DISTDIR=`stack path --dist-dir` 5 | 6 | link () { 7 | NAME="$2" 8 | ORIGIN="$1" 9 | 10 | if [ -L ./${NAME} ] ; then 11 | rm -f ./${NAME} 12 | fi 13 | if [ -f ./${NAME} ] ; then 14 | exit 1 15 | fi 16 | ln -s ${ORIGIN} ${NAME} 17 | } 18 | 19 | # symlink a "executable" binary 20 | e () { 21 | NAME="$1" 22 | link "${ROOTDIR}/bin/${NAME}" "${NAME}" 23 | } 24 | 25 | # symlink a "test-suite" binary 26 | t () { 27 | NAME="$1" 28 | link "${DISTDIR}/build/${NAME}/${NAME}" "${NAME}" 29 | } 30 | 31 | 32 | # main 33 | e render 34 | e format 35 | t experiment 36 | t check 37 | -------------------------------------------------------------------------------- /tests/fragments/DivBlocks.markdown: -------------------------------------------------------------------------------- 1 | (Note that this code tests attributes as well) 2 | 3 | :::greeting 4 | Hello world. 5 | 6 | This is a test. 7 | ::: 8 | 9 | ::: {.greeting .earthlings} 10 | Hello world 11 | 12 | ``` 13 | This is some code 14 | ``` 15 | ::: 16 | 17 | ::: {#hello} 18 | Hello world 19 | ::: 20 | 21 | ::: {#hello metadata=definite} 22 | Hello world 23 | ::: 24 | 25 | ::: {.greeting .earthlings metadata=definite} 26 | Hello world 27 | ::: 28 | 29 | ::: {#hello .greeting .earthlings metadata=definite} 30 | Hello world 31 | ::: 32 | 33 | Ultimately I'm not sure of the purpose of this syntax; it's rather HTML 34 | centric in that it doesn't seem to do much good en-route to LaTeX. 35 | -------------------------------------------------------------------------------- /examples/Mixed.markdown: -------------------------------------------------------------------------------- 1 | Level 1 Heading 2 | =============== 3 | 4 | This is an example. 5 | 6 | ## A subheading 7 | 8 | That should be normalized to an setext style heading, 9 | 10 | Some _for_ breakfast: 11 | 12 | Italics in that sentance should remain underscores. 13 | 14 | \begin{image} 15 | \includegraphics{haskell.png} 16 | \end{image} 17 | 18 | Whitespace here should be preserved. 19 | 20 | ```haskell 21 | mail :: IO () 22 | main = print "Hello" 23 | ``` 24 | 25 | ### Third level heading 26 | 27 | An image tag should be unchanged, but this being a long paragraph with long lines 28 | should be rewrapped to be under 75 characters. 29 | 30 | ![](haskell.png) 31 | 32 | because it's immutable. 33 | 34 | 35 | -------------------------------------------------------------------------------- /tests/fragments/HtmlBlocks.markdown: -------------------------------------------------------------------------------- 1 | Some people just can't resist: 2 | 3 |
4 | 5 | I don't know what I'm doing. Do you have 6 | the **foggiest** idea? Not that this is a standard Markdown Paragraph block 7 | with Markdown inlines. The HTML input tag above is treated as an inline. 8 | 9 |
10 | 11 | I'm not thrilled about the newlines separating the HTML block elements from 12 | the following ones, but leaving it this way emphasizes that it's not one 13 | container block (as it is in HTML) but rather the open and close tags are 14 | individual independant Markdown Raw blocks. 15 | 16 | But you never know. 17 | 18 | 19 | -------------------------------------------------------------------------------- /src/Environment.hs: -------------------------------------------------------------------------------- 1 | module Environment 2 | ( Env (..), 3 | initial, 4 | Bookfile (..), 5 | ) 6 | where 7 | 8 | import System.Posix.Directory (getWorkingDirectory) 9 | 10 | data Env = Env 11 | { startingDirectoryFrom :: FilePath, 12 | intermediateFilenamesFrom :: [FilePath], 13 | masterFilenameFrom :: FilePath, 14 | resultFilenameFrom :: FilePath, 15 | tempDirectoryFrom :: FilePath 16 | } 17 | 18 | initial :: IO Env 19 | initial = do 20 | cwd <- getWorkingDirectory 21 | return (Env cwd [] "/dev/null" "/dev/null" "/dev/null") 22 | 23 | data Bookfile = Bookfile 24 | { versionFrom :: Int, 25 | preamblesFrom :: [FilePath], 26 | fragmentsFrom :: [FilePath], 27 | trailersFrom :: [FilePath] 28 | } 29 | deriving (Show, Eq) 30 | -------------------------------------------------------------------------------- /tests/WalkPandocTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Data.Text (Text) 4 | import qualified Data.Text.IO as T 5 | import Text.Pandoc 6 | import Text.Pandoc.Walk (walk) 7 | 8 | behead :: Block -> Block 9 | behead (Header n _ xs) | n >= 2 = Para [Emph xs] 10 | behead x = x 11 | 12 | readDoc :: PandocMonad m => Text -> m Pandoc 13 | readDoc s = readMarkdown def s 14 | 15 | writeDoc :: PandocMonad m => Pandoc -> m Text 16 | writeDoc doc = writeMarkdown def doc 17 | 18 | 19 | 20 | main :: IO () 21 | main = do 22 | input <- T.readFile "examples/Headings.markdown" 23 | result <- runIOorExplode (process input) 24 | T.putStrLn result 25 | 26 | process :: Text -> PandocIO Text 27 | process input = do 28 | doc <- readDoc input 29 | let doc' = walk behead doc 30 | writeDoc doc' 31 | -------------------------------------------------------------------------------- /tests/fragments/DefinitionList.markdown: -------------------------------------------------------------------------------- 1 | Definition lists (called description lists in LaTeX) are funny! 2 | 3 | First 4 | 5 | : Some text. That was a demonstration of the power of main but even despite 6 | the evidence before your eyes most of you will disbelieve. 7 | 8 | Secondly 9 | 10 | : Some terms need further explanation. 11 | 12 | With details! 13 | 14 | : Apparently including extra definitions? What does that even mean? 15 | 16 | Third 17 | 18 | : It is undeniable that the left fold is superior to the right fold but only 19 | if it strictly adheres to the laws laid down in holy scripture. Should the 20 | warnings of Saint Simon not be respected, you can expect a great rising of 21 | space leaking from the firey depths of your deepest darkest memory heap. 22 | 23 | Done. 24 | -------------------------------------------------------------------------------- /.github/workflows/check.yaml: -------------------------------------------------------------------------------- 1 | name: Check 2 | on: 3 | pull_request: 4 | workflow_dispatch: 5 | 6 | jobs: 7 | build: 8 | name: Build and Test 9 | runs-on: ubuntu-latest 10 | steps: 11 | - name: Clone project 12 | uses: actions/checkout@v4 13 | 14 | - name: Cache dependencies 15 | uses: actions/cache@v4 16 | with: 17 | path: ~/.stack 18 | key: ${{ runner.os }}-${{ hashFiles('stack.yaml') }} 19 | restore-keys: ${{ runner.os }}- 20 | 21 | - name: Setup GHC 22 | run: | 23 | stack --version 24 | stack setup 25 | 26 | - name: Build sources 27 | run: | 28 | stack build 29 | 30 | - name: Run tests 31 | run: | 32 | stack test 33 | -------------------------------------------------------------------------------- /tests/fragments/MultilineTable.markdown: -------------------------------------------------------------------------------- 1 | Introduction this is. 2 | 3 | ---------------------------------------------------------------------- 4 | Centered Default Right Left Aligned 5 | Header Aligned Aligned 6 | ----------- ----------- ----------- ---------------------------------- 7 | First row1 `12.0` Example of a row that goes on and 8 | on and spans multiple lines. 9 | 10 | Second row2 `5.0` Here's another one. Note the blank 11 | line between rows. 12 | 13 | Tee row3 `4567.1` Now this is interesting. 14 | ---------------------------------------------------------------------- 15 | 16 | And we're done. 17 | -------------------------------------------------------------------------------- /tests/fragments/Paragraphs.markdown: -------------------------------------------------------------------------------- 1 | This is a test of the **Emergency Broadcast System**. Do not be alarmed. If 2 | this were not a test, you wouldn't _need_ to know. Hic. 3 | 4 | Paragraphs often include [links](https://www.example.com/) and raw URIs of the 5 | form or something like that. 6 | 7 | Some [links](http://www.example.com "Click here!") have titles. And believe it 8 | or not some [other](http://www.example.com){.darkgray} links have attributes! 9 | 10 | Confusingly, there are paragraphs that have `
` in them. Called line breaks 11 | in the ancient dialect, 12 | these need to be treated specially when represented as Markdown. Otherwise the 13 | lines that aren't lines will end up as lines that are part of other lines, and 14 | be wrapped, or unwrapped, accordingly. 15 | 16 | Worst of all, however, is that some things \[not what you'd expect\] need to 17 | be _\_really\__ escaped. 18 | -------------------------------------------------------------------------------- /tests/fragments/BulletList.markdown: -------------------------------------------------------------------------------- 1 | Simple list: 2 | 3 | - This is the first item 4 | - This is the second item 5 | 6 | Simple list with longer lines: 7 | 8 | - This is a third item which rambles on and and on and then has some more 9 | text which goes on. 10 | - And this is the fourth item, enough of that. 11 | 12 | We also have more complex bullet lists: 13 | 14 | - This is the fifth item. 15 | 16 | It has a second paragrah; 17 | 18 | - This is the sixth item, which has lots of words about current events and 19 | learned discussion about whether the stock market will go up or down 20 | depending on whether the `launchTheMissiles()` function gets called today 21 | or tomorrow; and 22 | 23 | - Finally, a 7th item. Wasn't there a book about Seven Signs? Maybe it was a 24 | movie, _Seven Samurai_. 25 | 26 | And we're done. 27 | 28 | - Except we're not done, because 29 | What happens if we have a line break? 30 | It had better work. 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright © 2016-2020 Athae Eredh Siniath and Others 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a 4 | copy of this software and associated documentation files (the "Software"), 5 | to deal in the Software without restriction, including without limitation 6 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 7 | and/or sell copies of the Software, and to permit persons to whom the 8 | Software is furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 18 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 19 | DEALINGS IN THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /src/FormatMain.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE QuasiQuotes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Main where 7 | 8 | import Core.Program 9 | import Core.Text 10 | import FormatDocument (program) 11 | 12 | #ifdef __GHCIDE__ 13 | version :: Version 14 | version = "0" 15 | #else 16 | version :: Version 17 | version = $(fromPackage) 18 | #endif 19 | 20 | main :: IO () 21 | main = do 22 | context <- 23 | configure 24 | version 25 | None 26 | ( simpleConfig 27 | [ Option 28 | "inplace" 29 | (Just 'i') 30 | Empty 31 | [quote| 32 | Overwrite the original file with the reformatted version. WARNING 33 | This tool is experimental. You should ensure you have a safe copy 34 | of your original (ie, add it to Git's index) before running with 35 | this option enabled. 36 | |], 37 | Argument 38 | "document" 39 | [quote| 40 | The file containing the markdown to be reformatted 41 | |] 42 | ] 43 | ) 44 | 45 | executeWith context program 46 | -------------------------------------------------------------------------------- /src/LatexOutputReader.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module LatexOutputReader 4 | ( parseOutputForError 5 | ) 6 | where 7 | 8 | import Core.Text 9 | import qualified Data.ByteString.Lazy.Char8 as L 10 | 11 | {- 12 | The build command returned a non-zero exit code, so there is a 13 | reasonable assumption that there is indeed an error to be extracted. 14 | -} 15 | -- Originally written in lazy ByteString as that is output from readProcess 16 | parseOutputForError :: FilePath -> Rope -> Rope 17 | parseOutputForError tmpdir = 18 | let 19 | needle = L.pack tmpdir 20 | 21 | stripBeginning [] = [] 22 | stripBeginning (b:bs) = if L.isPrefixOf needle b 23 | then b : bs 24 | else stripBeginning bs 25 | 26 | dropEnding [] = [] 27 | dropEnding (b:bs) = if L.isPrefixOf "Output written on" b || "No pages of output." == b 28 | then [] 29 | else b : dropEnding bs 30 | in 31 | intoRope . L.intercalate "\n" . dropEnding . stripBeginning . L.lines . fromRope 32 | 33 | 34 | -- Error stream from xelatex looks like this: 35 | {- 36 | /tmp/publish-Km3eN1/Junk.tex:8: Undefined control sequence. 37 | l.8 \broken 38 | 39 | No pages of output. 40 | Transcript written on /tmp/publish-Km3eN1/Junk.log 41 | -} 42 | -------------------------------------------------------------------------------- /doc/Examples.md: -------------------------------------------------------------------------------- 1 | Examples 2 | ======== 3 | 4 | Subdirectories 5 | -------------- 6 | 7 | A work with multiple chapters and images in different subdirectories could be 8 | described as follows 9 | 10 | ``` 11 | % publish v2 12 | preamble.tex 13 | % begin 14 | chapters/Introduction.md 15 | chapters/RelatedWork.md 16 | chapters/Results.tex 17 | chapters/chart-07.svg 18 | chapters/Analysis.md 19 | chapters/Conclusion.md 20 | generated/References.tex 21 | % end 22 | ``` 23 | 24 | If you put that list into _EnormousThesis.book_ in the current directory it 25 | can be rendered as follows: 26 | 27 | ``` 28 | $ render EnormousThesis.book 29 | ``` 30 | 31 | the result will be written to _EnormousThesis.pdf_, assuming you had 32 | `\documentclass` in _preamble.tex_, along with all the prerequisite LaTeX 33 | packages installed on your system. 34 | 35 | Including images 36 | ---------------- 37 | 38 | In the file _chapters/Analysis.md_ the markup used to include the SVG 39 | image would be: 40 | 41 | ```markdown 42 | ![A plot showing our analysis](chart-07.pdf) 43 | ``` 44 | 45 | Note that the filename extension is _.pdf_ not _.svg_. **publish** will 46 | convert the SVG to a PDF fragment suitable for inclusion in your output 47 | document, so you need to tell the LaTeX processor to include that, not the 48 | source SVG. 49 | 50 | Of course this translates to a LaTeX command, 51 | 52 | ```latex 53 | \includegraphics{chart-07.pdf} 54 | ``` 55 | 56 | which you can use inline in _.md_ files or raw in _.tex_ source files. 57 | 58 | Other documentation: 59 | 60 | - [Getting Started](Tutorial.md) 61 | - [Background](Background.md) 62 | - [README](../README.md) 63 | -------------------------------------------------------------------------------- /tests/CompareFragments.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLists #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module CompareFragments ( 6 | checkByComparingFragments, 7 | ) where 8 | 9 | import Core.Text 10 | import qualified Data.Text.IO as T 11 | import FormatDocument (markdownToPandoc) 12 | import PandocToMarkdown (pandocToMarkdown) 13 | import Test.Hspec hiding (context) 14 | 15 | fragments :: [(String, FilePath)] 16 | fragments = 17 | [ ("headings", "tests/fragments/Headings.markdown") 18 | , ("paragraphs", "tests/fragments/Paragraphs.markdown") 19 | , ("code blocks", "tests/fragments/CodeBlocks.markdown") 20 | , ("div blocks", "tests/fragments/DivBlocks.markdown") 21 | , ("LaTeX blocks", "tests/fragments/LatexBlocks.markdown") 22 | , ("HTML blocks", "tests/fragments/HtmlBlocks.markdown") 23 | , ("poem passage", "tests/fragments/Poetry.markdown") 24 | , ("blockquotes", "tests/fragments/Blockquotes.markdown") 25 | , ("bullet list", "tests/fragments/BulletList.markdown") 26 | , ("ordered list", "tests/fragments/OrderedList.markdown") 27 | , ("definition list", "tests/fragments/DefinitionList.markdown") 28 | , ("pipe table", "tests/fragments/PipeTable.md") 29 | , ("weird inlines", "tests/fragments/WeirdInlines.markdown") 30 | ] 31 | 32 | checkByComparingFragments :: Spec 33 | checkByComparingFragments = 34 | describe "Compare fragments" $ do 35 | sequence_ (map compareFragment fragments) 36 | 37 | compareFragment :: (String, FilePath) -> SpecWith () 38 | compareFragment (label, file) = 39 | it ("Formats " ++ label ++ " correctly") $ do 40 | original <- T.readFile file 41 | doc <- markdownToPandoc original 42 | let text = pandocToMarkdown doc 43 | fromRope text `shouldBe` original 44 | -------------------------------------------------------------------------------- /tests/fragments/OrderedList.markdown: -------------------------------------------------------------------------------- 1 | Simple list: 2 | 3 | 1. Number one. 4 | 2. Number two. 5 | 3. Number three. 6 | 4. Number four. 7 | 5. FIVE GOLDEN RINGS 8 | 6. Four calling birds. 9 | 7. Three French Hens. 10 | 8. Henry Turtledove. 11 | 9. And a partial function in a pear tree. 12 | 10. Number ten. Oh my goodness this is the most amazing thing like it totally 13 | is the thing we've always wanted oh my god. I mean totally is the thing 14 | we've really always wanted like you know what I mean? 15 | 11. Elevensies is my kind of meal. 16 | 17 | Nested list: 18 | 19 | 1. Genesis. 20 | 2. Exodus: 21 | a) To begin with? 22 | b) Continuing, 23 | i. Part the first 24 | ii. Part the second 25 | iii. Part the third 26 | iv. Part the fourth 27 | v. Part the fifth 28 | vi. Part the sixth 29 | vii. Part the seventh 30 | viii. Part the eigth 31 | ix. Part the ninth 32 | c) Now to get something straight! 33 | 3. The third one 34 | 4. I like numbers. 35 | i) Like "pi"; and 36 | ii) The number "fourty-two". 37 | 5. What is a deuteronomy? 38 | 39 | Spaced list: 40 | 41 | 1. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec tristique 42 | turpis vel orci sagittis, ut accumsan enim tincidunt. Morbi gravida 43 | dignissim diam. Donec condimentum elit risus, non lobortis magna tristique 44 | ac. 45 | 46 | 2. Aenean ultrices eget risus efficitur placerat. Suspendisse vitae pharetra 47 | erat, posuere laoreet nisi. Quisque eget luctus mi. Sed sit amet sem mi. 48 | Vestibulum non porta turpis. Donec accumsan pharetra tortor. 49 | 50 | i. Un 51 | 52 | ii. Deux 53 | 54 | iii. Trois 55 | 56 | iv. Quatre 57 | 58 | v. Cinq 59 | 60 | 3. Vivamus egestas eget sem non mollis. Duis auctor odio libero, a sodales mi 61 | efficitur vel. Orci varius natoque penatibus et magnis dis parturient 62 | montes, nascetur ridiculus mus. Cras eleifend nunc sed tellus eleifend 63 | commodo. 64 | -------------------------------------------------------------------------------- /src/ParseBookfile.hs: -------------------------------------------------------------------------------- 1 | module ParseBookfile where 2 | 3 | import Control.Monad 4 | import Data.Void 5 | import Environment (Bookfile (..)) 6 | import Text.Megaparsec 7 | import Text.Megaparsec.Char 8 | import qualified Text.Megaparsec.Char.Lexer as L 9 | 10 | -- use String, since we need FilePaths which are type aliases over String anyway. 11 | type Parser = Parsec Void String 12 | 13 | __VERSION__ :: Int 14 | __VERSION__ = 2 15 | 16 | parseMagicLine :: Parser Int 17 | parseMagicLine = do 18 | void (char '%') "first line to begin with % character" 19 | void spaceChar "a space character" 20 | void (string "publish") 21 | void spaceChar "a space character" 22 | void (char 'v') "the character v and then a number" 23 | v <- L.decimal "the bookfile schema version number" 24 | unless (v == __VERSION__) (fail ("currently recognized bookfile schema version is v" ++ show __VERSION__)) 25 | void newline 26 | return v 27 | 28 | parseBeginLine :: Parser () 29 | parseBeginLine = try $ 30 | label "begin marker" $ do 31 | void (string "% begin") 32 | void newline 33 | 34 | parseFileLine :: Parser FilePath 35 | parseFileLine = do 36 | notFollowedBy (char '%') 37 | file <- takeWhile1P (Just "line containing a filename") (/= '\n') 38 | return file 39 | 40 | parseEndLine :: Parser () 41 | parseEndLine = try $ 42 | label "end marker" $ do 43 | void (string "% end") 44 | void newline 45 | 46 | parseBlank :: Parser () 47 | parseBlank = do 48 | void (hidden (many newline)) 49 | 50 | parseBookfile :: Parser Bookfile 51 | parseBookfile = do 52 | version <- parseMagicLine 53 | preambles <- many (parseBlank *> parseFileLine <* parseBlank) 54 | parseBeginLine 55 | fragments <- many (parseBlank *> parseFileLine <* parseBlank) 56 | parseEndLine 57 | trailers <- many (parseBlank *> parseFileLine <* parseBlank) 58 | return 59 | Bookfile 60 | { versionFrom = version 61 | , preamblesFrom = preambles 62 | , fragmentsFrom = fragments 63 | , trailersFrom = trailers 64 | } 65 | -------------------------------------------------------------------------------- /src/Utilities.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module Utilities ( 6 | ensureDirectory, 7 | ifNewer, 8 | isNewer, 9 | ) where 10 | 11 | import Control.Monad (when) 12 | import Core.Data 13 | import Core.Program 14 | import Core.System 15 | import System.Directory ( 16 | createDirectoryIfMissing, 17 | doesDirectoryExist, 18 | doesFileExist, 19 | getModificationTime, 20 | ) 21 | import System.FilePath.Posix (takeDirectory) 22 | 23 | {- 24 | Some source files live in subdirectories. Replicate that directory 25 | structure in the temporary build space 26 | -} 27 | ensureDirectory :: FilePath -> Program t () 28 | ensureDirectory target = 29 | let subdir = takeDirectory target 30 | in liftIO $ do 31 | probe <- doesDirectoryExist subdir 32 | when (not probe) $ do 33 | createDirectoryIfMissing True subdir 34 | 35 | {- | 36 | If the source file is newer than the target file, then run an action. For 37 | example, if you want to install a file but only do so if the file has been 38 | rebuilt, then you could do this: 39 | 40 | @ 41 | copyFileIfNewer :: 'FilePath' -> 'FilePath' -> 'Program' τ () 42 | copyFileIfNewer source target = do 43 | 'ifNewer' source target $ do 44 | 'liftIO' ('copyFileWithMetadata' source target) 45 | @ 46 | 47 | This is basically a build system in a box, although the usual caveats 48 | about the brittleness of timestamps apply. 49 | 50 | TODO this could potentially move to the **unbeliever** library 51 | -} 52 | ifNewer :: FilePath -> FilePath -> Program t () -> Program t () 53 | ifNewer source target program = do 54 | changed <- isNewer source target 55 | when changed $ do 56 | program 57 | 58 | isNewer :: FilePath -> FilePath -> Program t Bool 59 | isNewer source target = liftIO $ do 60 | time1 <- getModificationTime source 61 | time2 <- 62 | doesFileExist target >>= \case 63 | True -> getModificationTime target 64 | False -> return (fromTime epochTime) 65 | return (time1 > time2) 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Publishing tools for papers, books, and presentations 2 | ===================================================== 3 | 4 | Authoring a high quality document and rendering it to a PDF suitable for 5 | printing means using a toolchain different than those used to assemble content 6 | into web pages. LaTeX processors are the dominant way to typeset documents, 7 | but while the results are often beautiful it is an environment which has 8 | accreted cruft over decades and can be difficult to use. We have faith that 9 | the gods in the computing pantheon will someday grant us peace (e.g. the end 10 | of the editor wars) and better tools (or at least ones that give useful error 11 | messages), but while we wait for the millennium (when LaTeX will be replaced 12 | with something whose syntax doesn't make your eyes bleed) we wanted to see if 13 | we could offer a slightly less unpleasant authoring experience. 14 | 15 | Ideally we could: 16 | 17 | - write content in lightly marked-up plain text (_i.e._ Markdown) as much as 18 | possible; 19 | 20 | - use localized typesetting commands inline when slightly greater 21 | expressiveness is needed; and 22 | 23 | - directly pass-through entire blobs of LaTeX when complex incantations and 24 | arcane summonings are necessary to appease the vengeful daemons who make 25 | the office printer work. 26 | 27 | and that is what **publish** provides. It gives you a way to: 28 | 29 | 1. list the _.md_ and _.tex_ files that make up your document; 30 | 31 | 2. convert Markdown fragments into LaTeX using **pandoc**; 32 | 33 | 3. use **inkscape** programmatically to convert _.svg_ images into something 34 | that can be included by the LaTeX processors; and 35 | 36 | 4. combine the resultant intermediate pieces and render them to a _.pdf_ 37 | using the **lualatex** toolchain. 38 | 39 | Documentation 40 | ------------- 41 | 42 | There is a [getting started][Tutorial] tutorial, [background][Background] 43 | notes, and several [examples][Examples]. And you can get help from the 44 | command-line: 45 | 46 | ``` 47 | $ render --help 48 | ``` 49 | 50 | [Tutorial]: doc/Tutorial.md 51 | [Background]: doc/Background.md 52 | [Examples]: doc/Examples.md 53 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: publish 2 | version: 2.6.0 3 | synopsis: Publishing tools for papers, books, and presentations 4 | description: | 5 | Tools for rendering markdown-centric documents into PDFs. There are two 6 | programs: 7 | 8 | [/render/]for generating PDFs from Markdown and LaTeX input; and 9 | 10 | [/format/]for word-wrapping and nicely formatting Markdown files. 11 | 12 | A description of this package, a list of features, and some background 13 | to its design is contained in the 14 | 15 | on GitHub. 16 | 17 | stability: experimental 18 | license: MIT 19 | license-file: LICENSE 20 | author: Andrew Cowie 21 | maintainer: Andrew Cowie 22 | copyright: © 2016-2023 Athae Eredh Siniath and Others 23 | category: Text 24 | tested-with: GHC == 9.4.6 25 | github: aesiniath/publish 26 | 27 | dependencies: 28 | - base >= 4.11 && < 5 29 | - bytestring 30 | - deepseq 31 | - directory 32 | - filepath 33 | - megaparsec 34 | - pandoc-types >= 1.22 35 | - pandoc >= 2.11 36 | - template-haskell 37 | - text 38 | - typed-process 39 | - core-text >= 0.3.4 40 | - core-data >= 0.3.3 41 | - core-program >= 0.6.5 42 | - core-telemetry >= 0.2.7 43 | - safe-exceptions 44 | - unix 45 | - unordered-containers 46 | 47 | ghc-options: -threaded -Wall -Wwarn -fwarn-tabs 48 | 49 | executables: 50 | render: 51 | source-dirs: src 52 | main: RenderMain.hs 53 | other-modules: 54 | - Environment 55 | - LatexPreamble 56 | - LatexOutputReader 57 | - PandocToMarkdown 58 | - ParseBookfile 59 | - RenderDocument 60 | - Utilities 61 | 62 | format: 63 | source-dirs: src 64 | main: FormatMain.hs 65 | other-modules: 66 | - FormatDocument 67 | - PandocToMarkdown 68 | 69 | tests: 70 | check: 71 | dependencies: 72 | - hspec 73 | ghc-options: -threaded 74 | source-dirs: 75 | - src 76 | - tests 77 | main: TestSuite.hs 78 | other-modules: 79 | - CheckBookfileParser 80 | - CheckTableProperties 81 | - CompareFragments 82 | - Environment 83 | - FormatDocument 84 | - PandocToMarkdown 85 | - ParseBookfile 86 | 87 | 88 | -------------------------------------------------------------------------------- /tests/CheckBookfileParser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module CheckBookfileParser 6 | ( checkBookfileParser, 7 | ) 8 | where 9 | 10 | import Core.Text 11 | import Environment (Bookfile (..)) 12 | import ParseBookfile 13 | import Test.Hspec 14 | import Text.Megaparsec 15 | 16 | checkBookfileParser :: Spec 17 | checkBookfileParser = do 18 | describe "Parse bookfile format" $ do 19 | it "Correctly parses a complete first line" $ do 20 | parseMaybe parseMagicLine "% publish v2\n" `shouldBe` Just 2 21 | it "Errors if first line has incorrect syntax" $ do 22 | parseMaybe parseMagicLine "%\n" `shouldBe` Nothing 23 | parseMaybe parseMagicLine "%publish\n" `shouldBe` Nothing 24 | parseMaybe parseMagicLine "% publish\n" `shouldBe` Nothing 25 | parseMaybe parseMagicLine "% publish \n" `shouldBe` Nothing 26 | parseMaybe parseMagicLine "% publish v\n" `shouldBe` Nothing 27 | parseMaybe parseMagicLine "% publish v2\n" `shouldBe` Nothing 28 | parseMaybe parseMagicLine "% publish v1\n" `shouldBe` Nothing 29 | parseMaybe parseMagicLine "% publish v2 asdf\n" `shouldBe` Nothing 30 | 31 | it "Correctly parses a preamble line" $ do 32 | parseMaybe parseFileLine "preamble.latex" `shouldBe` Just "preamble.latex" 33 | it "Parses two filenames in a list" $ do 34 | parseMaybe (many (parseFileLine <* parseBlank)) "one.markdown\ntwo.markdown" 35 | `shouldBe` Just (["one.markdown", "two.markdown"] :: [FilePath]) 36 | 37 | it "Parses two filenames with a blank line between them" $ do 38 | parseMaybe 39 | (many (parseFileLine <* parseBlank)) 40 | [quote| 41 | one.markdown 42 | 43 | two.markdown 44 | |] 45 | `shouldBe` Just (["one.markdown", "two.markdown"] :: [FilePath]) 46 | 47 | it "Correctly parses a begin end end pragmas" $ do 48 | parseMaybe parseBeginLine "% begin\n" `shouldBe` Just () 49 | parseMaybe parseEndLine "% end\n" `shouldBe` Just () 50 | 51 | it "Correctly parses a complete bookfile" $ do 52 | parseMaybe 53 | parseBookfile 54 | [quote| 55 | % publish v2 56 | preamble.latex 57 | % begin 58 | Introduction.markdown 59 | Conclusion.markdown 60 | % end 61 | |] 62 | `shouldBe` Just (Bookfile 2 ["preamble.latex"] ["Introduction.markdown", "Conclusion.markdown"] []) 63 | 64 | it "Correctly parses a complete bookfile with no preamble" $ do 65 | parseMaybe 66 | parseBookfile 67 | [quote| 68 | % publish v2 69 | % begin 70 | Introduction.markdown 71 | Conclusion.markdown 72 | % end 73 | |] 74 | `shouldBe` Just (Bookfile 2 [] ["Introduction.markdown", "Conclusion.markdown"] []) 75 | 76 | it "Correctly parses a complete bookfile with trailing fragments" $ do 77 | parseMaybe 78 | parseBookfile 79 | [quote| 80 | % publish v2 81 | % begin 82 | Introduction.markdown 83 | % end 84 | Conclusion.markdown 85 | |] 86 | `shouldBe` Just (Bookfile 2 [] ["Introduction.markdown"] ["Conclusion.markdown"]) 87 | -------------------------------------------------------------------------------- /src/FormatDocument.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module FormatDocument ( 6 | program, 7 | loadFragment, 8 | markdownToPandoc, 9 | ) where 10 | 11 | import Core.Program 12 | import Core.System 13 | import Core.Text 14 | import qualified Data.Text as T (Text) 15 | import qualified Data.Text.IO as T 16 | import PandocToMarkdown 17 | import System.Directory (getFileSize, renameFile) 18 | import Text.Pandoc ( 19 | Extension (..), 20 | Extensions, 21 | Pandoc, 22 | ReaderOptions (readerExtensions), 23 | def, 24 | disableExtension, 25 | pandocExtensions, 26 | readMarkdown, 27 | runIOorExplode, 28 | ) 29 | 30 | program :: Program None () 31 | program = do 32 | info "Identify document fragment" 33 | file <- getFragmentName 34 | 35 | info "Load to Pandoc internal representation" 36 | parsed <- loadFragment file 37 | 38 | info "Write to Markdown format" 39 | writeResult file parsed 40 | 41 | info "Complete" 42 | 43 | getFragmentName :: Program None FilePath 44 | getFragmentName = do 45 | fragment <- queryArgument "document" 46 | pure (fromRope fragment) 47 | 48 | loadFragment :: FilePath -> Program None Pandoc 49 | loadFragment file = 50 | liftIO $ do 51 | contents <- T.readFile file 52 | markdownToPandoc contents 53 | 54 | -- 55 | -- Unlike the render use case, here we suppress certain 56 | -- options which mess up the ASCII form of the source documents 57 | -- 58 | markdownToPandoc :: T.Text -> IO Pandoc 59 | markdownToPandoc contents = 60 | let disableFrom :: Extensions -> [Extension] -> Extensions 61 | disableFrom extensions list = foldr disableExtension extensions list 62 | readingOptions = 63 | def 64 | { readerExtensions = 65 | disableFrom 66 | pandocExtensions 67 | [ Ext_implicit_figures 68 | , Ext_shortcut_reference_links 69 | , Ext_smart 70 | ] 71 | } 72 | in do 73 | runIOorExplode $ do 74 | readMarkdown readingOptions contents 75 | 76 | data Inplace = Inplace | Console 77 | 78 | writeResult :: FilePath -> Pandoc -> Program None () 79 | writeResult file doc = 80 | let contents' = pandocToMarkdown doc 81 | result = file ++ "~tmp" 82 | in do 83 | mode <- 84 | queryOptionFlag "inplace" >>= \case 85 | True -> pure Inplace 86 | False -> pure Console 87 | 88 | case mode of 89 | Inplace -> liftIO $ do 90 | withFile result WriteMode $ \handle -> 91 | hWrite handle contents' 92 | 93 | size <- getFileSize result 94 | if size == 0 95 | then error "Zero content, not overwriting" 96 | else renameFile result file 97 | Console -> liftIO $ do 98 | hWrite stdout contents' 99 | -------------------------------------------------------------------------------- /src/RenderMain.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE QuasiQuotes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Main where 7 | 8 | import Core.Program 9 | import Core.Telemetry 10 | import Core.Text 11 | import Environment (initial) 12 | import RenderDocument (program) 13 | 14 | #ifdef __GHCIDE__ 15 | version :: Version 16 | version = "0" 17 | #else 18 | version :: Version 19 | version = $(fromPackage) 20 | #endif 21 | 22 | main :: IO () 23 | main = do 24 | env <- initial 25 | context <- 26 | configure 27 | version 28 | env 29 | ( simpleConfig 30 | [ Option 31 | "builtin-preamble" 32 | (Just 'p') 33 | Empty 34 | [quote| 35 | Wrap a built-in LaTeX preamble (and ending) around your 36 | supplied source fragments. Most documents will put their own 37 | custom preamble as the first fragment in the .book file, but 38 | for getting started a suitable default can be employed via this 39 | option. 40 | |] 41 | , Option 42 | "watch" 43 | Nothing 44 | Empty 45 | [quote| 46 | Watch all sources listed in the bookfile and re-run the 47 | rendering engine if changes are detected. 48 | |] 49 | , Option 50 | "no-copy" 51 | Nothing 52 | Empty 53 | [quote| 54 | Should the resultant PDF be copied to this directory? Of course 55 | it should, so the default is true. Select this if you want to 56 | leave the file in /tmp. 57 | |] 58 | , Option 59 | "temp" 60 | Nothing 61 | (Value "TMPDIR") 62 | [quote| 63 | The working location for assembling converted fragments and 64 | caching intermediate results between runs. By default, a 65 | temporary directory will be created in /tmp. 66 | |] 67 | , Option 68 | "docker" 69 | Nothing 70 | (Value "IMAGE") 71 | [quote| 72 | Run the specified Docker image in a container, mount the target 73 | directory into it as a volume, and do the build there. This allows 74 | you to have all of the LaTeX dependencies separate from the machine 75 | you are editing on. 76 | |] 77 | , Argument 78 | "bookfile" 79 | [quote| 80 | The file containing the list of fragments making up this book. 81 | If the argument is specified as "Hobbit.book" then "Hobbit" 82 | will be used as the basename for the final output .pdf file. 83 | |] 84 | ] 85 | ) 86 | 87 | context' <- initializeTelemetry [consoleExporter, structuredExporter, honeycombExporter] context 88 | 89 | executeWith context' program 90 | -------------------------------------------------------------------------------- /doc/Tutorial.md: -------------------------------------------------------------------------------- 1 | Tutorial 2 | ======== 3 | 4 | Let's say we want to write a book about trees. 5 | 6 | You start with writing your content in a text file using Markdown syntax to 7 | add semantic markup to the text as you see fit. We'll make the assumption that 8 | you know the basics of Markdown syntax from having used it on GitHub, your 9 | blog, or elsewhere. If you need to learn more about Markdown syntax, see this 10 | [tutorial](https://commonmark.org/help/)). 11 | 12 | For our example, 13 | 14 | ```text 15 | On the subject of trees 16 | ======================= 17 | 18 | This may come as a complete surprise 19 | to you, but trees are **green**. 20 | 21 | ``` 22 | 23 | Put your text into a file called _Introduction.md_. 24 | 25 | You now need to tell **publish** which files make up the document you want to 26 | render. Create another file which lists the pieces of your manuscript, one per 27 | line. Here we've only got one fragment, so this won't take long: 28 | 29 | ```text 30 | % publish v2 31 | % begin 32 | Introduction.md 33 | % end 34 | ``` 35 | 36 | Put the list into a file named _Trees.book_. The filename extension does not 37 | matter, but we've adopted the convention of using _.book_ to identify such 38 | "bookfiles". The basename of the file _does_ matter; it will be used to name 39 | the PDF we're going to generate. 40 | 41 | Now you can render your document. The tool installed by **publish** package is 42 | called _render_. Run that as follows: 43 | 44 | ```shell 45 | $ render -p Trees.book 46 | $ 47 | ``` 48 | 49 | That's it! If you want a bit more detail about what it's doing, you can use 50 | `--verbose` (or `-v` for short): 51 | 52 | ```shell 53 | $ render -p -v Trees.book 54 | 08:52:24Z (00000.002) Reading bookfile 55 | 08:52:24Z (00000.003) Setup temporary directory 56 | 08:52:24Z (00000.004) Convert document fragments to LaTeX 57 | 08:52:24Z (00000.004) Write intermediate LaTeX file 58 | 08:52:24Z (00000.004) Render document to PDF 59 | 08:52:24Z (00000.085) Copy resultant document here 60 | 08:52:24Z (00000.087) Complete 61 | $ 62 | ``` 63 | 64 | either way you've now got a file called _Trees.pdf_: 65 | 66 | ``` 67 | $ ls 68 | Introduction.md 69 | Trees.book 70 | Trees.pdf 71 | $ 72 | ``` 73 | 74 | Open that with your favourite PDF viewer and you'll see your fabulous book 75 | about the arboreal arts, ready to be sent to the printer. 76 | 77 | Preamble 78 | -------- 79 | 80 | The `-p` in the above example was important. It's short for 81 | `--builtin-preamble`. Using that option tells the _render_ program to wrap a 82 | simple built-in LaTeX preamble around your document. 83 | 84 | More advanced users will happily use their own LaTeX preamble based on years 85 | of experience writing academic papers or typesetting mathematical memoirs. 86 | They should put their preamble as the first item in the bookfile, perhaps: 87 | 88 | ``` 89 | % publish v2 90 | preamble.tex 91 | % begin 92 | Introduction.md 93 | % end 94 | ``` 95 | 96 | Docker integration 97 | ------------------ 98 | 99 | Assuming you _don't_ have years of experience using LaTeX toolchains, you can 100 | use a presupplied built-in preamble. If you want to install the packages 101 | yourself you can freely do so. There is also an option to run the render in a 102 | Docker container. 103 | 104 | ```shell 105 | $ render --builtin-preamble --docker=aesiniath/publish-builtin:latest Trees.book 106 | $ 107 | ``` 108 | 109 | If you specify the `--docker` option _render_ will spawn a Docker container 110 | from the image you specify. The image shown above has the dependencies You're 111 | welcome to use any container you like. Further details are on the 112 | [Docker](Docker.md) page. 113 | 114 | See also: 115 | 116 | - [Further examples](Examples.md) 117 | - [Background](Background.md) 118 | -------------------------------------------------------------------------------- /tests/CheckTableProperties.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module CheckTableProperties ( 6 | checkTableProperties, 7 | ) where 8 | 9 | import Core.Text 10 | import PandocToMarkdown ( 11 | tableToMarkdown, 12 | ) 13 | import Test.Hspec 14 | import Text.Pandoc 15 | 16 | checkTableProperties :: Spec 17 | checkTableProperties = do 18 | describe "Table rendering code" $ do 19 | it "Header rows format" $ 20 | let result = 21 | tableToMarkdown 22 | ("", [], []) 23 | ( Caption 24 | Nothing 25 | [] 26 | ) 27 | [ (AlignRight, ColWidthDefault) 28 | , (AlignCenter, ColWidthDefault) 29 | , (AlignDefault, ColWidth 0.5) 30 | ] 31 | ( TableHead 32 | ("", [], []) 33 | [ Row 34 | ("", [], []) 35 | [ Cell 36 | ("", [], []) 37 | AlignDefault 38 | (RowSpan 1) 39 | (ColSpan 1) 40 | [Plain [Str "First"]] 41 | , Cell 42 | ("", [], []) 43 | AlignDefault 44 | (RowSpan 1) 45 | (ColSpan 1) 46 | [Plain [Str "Second"]] 47 | , Cell 48 | ("", [], []) 49 | AlignDefault 50 | (RowSpan 1) 51 | (ColSpan 1) 52 | [Plain [Str "Third"]] 53 | ] 54 | ] 55 | ) 56 | [ ( TableBody 57 | ("", [], []) 58 | (RowHeadColumns 0) 59 | [] 60 | [ Row 61 | ("", [], []) 62 | [ Cell 63 | ("", [], []) 64 | AlignDefault 65 | (RowSpan 1) 66 | (ColSpan 1) 67 | [Plain [Str "1"]] 68 | , Cell 69 | ("", [], []) 70 | AlignDefault 71 | (RowSpan 1) 72 | (ColSpan 1) 73 | [Plain [Str "2"]] 74 | , Cell 75 | ("", [], []) 76 | AlignDefault 77 | (RowSpan 1) 78 | (ColSpan 1) 79 | [Plain [Str "3"]] 80 | ] 81 | ] 82 | ) 83 | ] 84 | ( TableFoot 85 | ("", [], []) 86 | [] 87 | ) 88 | in do 89 | result 90 | `shouldBe` [quote| 91 | | First | Second | Third | 92 | |-------:|:------:|---------------------------------------| 93 | | 1 | 2 | 3 | 94 | |] 95 | -------------------------------------------------------------------------------- /doc/Background.md: -------------------------------------------------------------------------------- 1 | Background 2 | ========== 3 | 4 | Web pages are the global standard for displaying and searching information but 5 | authoring content for them in raw HTML is tedious. This led to the advent of 6 | lightweight markup formats like Markdown that could easily be converted to 7 | HTML (it is no co-incidence that these styles represent documents using 8 | formatting conventions that were evolved in the early days of the internet by 9 | users who wanted to convey semantic information in text-based mailing lists 10 | and Usenet newsgroups). 11 | 12 | Somewhat surprisingly, the web continues to struggle with taking content into 13 | print form. Perhaps browser vendors are so overwhelmed by their own success 14 | that they don't feel the need to cater for this use case; certainly many 15 | people are happy to read content on screens surrounded by flashy banner ads. 16 | 17 | For some audiences, however, getting high-quality printed output on **paper** 18 | (or at least into a form that _could_ be printed to paper) is the primary 19 | requirement. These users include 20 | 21 | - researchers needing to document results; 22 | - students submitting essays and other papers; 23 | - engineers writing requirements, design, and system documentation; 24 | - business and organizations wishing to circulate content for review and 25 | approval; 26 | - authors wishing to produce their work in manuscript form suitable for 27 | editing; 28 | - publishers needing to do typesetting and actual pre-press rendering of 29 | manuscripts into "camera ready" form; and 30 | - humans who don't like flashy banner ads. 31 | 32 | So we want to work in Markdown, but render to PDF. The challenges and 33 | complications of this process are considerable. Fortunately there is an 34 | awesome tool that can help: Pandoc. 35 | 36 | Pandoc is a document conversion tool. It has a wide variety of "readers" which 37 | take as input any of number of different document formats and converts them to 38 | an internal representation which is then suitable for any one of various 39 | "writers" to onwards convert them to the desired target format. 40 | 41 | After considerable usage (which is to say, fighting with) the _pandoc_ command 42 | and the "templates" it ships with we had learned enough to realize we didn't 43 | need it to render the PDF but could instead rely on it to get us to LaTeX as 44 | an intermediate format. Our initial solution was to use the _pandoc_ command 45 | to convert _.md_ files to LaTeX _.tex_ and then invoke _pdflatex_ ourselves to 46 | get the desired _.pdf_ output. We later switched to _latexmk_ to handle the 47 | multiple passes necessary to resolve cross-references arising when rendering a 48 | LaTeX document, and _lualatex_ for more modern font handling. 49 | 50 | Pandoc is itself a (very large) Haskell library, so it was not a particularly 51 | earthshattering conceptual leap to consider calling into the library directly 52 | from a wrapper program ourselves, especially as we were no longer relying on 53 | it to build the PDF for us. 54 | 55 | **publish**, then, is a tool suite which allows you to specify the files 56 | comprising a manuscript, converts them from Markdown to LaTeX, then combines 57 | them together as input to the LaTeX processor for conversion to Portable 58 | Document Format ready for previewing or printing. 59 | 60 | Images 61 | ------ 62 | 63 | Further complications arise when dealing with graphics. While LaTeX grudgingly 64 | passes through raster images such as PNG and photos in JPEG form (and results 65 | will be acceptable so long as the source image is of sufficiently high 66 | resolution), the LaTeX typesetting toolchains have no native support for SVG 67 | vector images. 68 | 69 | This is a surprise to many users as SVG support has been dominant on the web 70 | for some years and the target format, PDF, is itself a high-quality vector 71 | format. 72 | 73 | The solution, or at least work-around, is render (convert) each of the SVGs to 74 | a PDF first using **inkscape**'s command-line program and then include these 75 | fragments in the typeset document. While we tend to think of PDFs as "pages" 76 | it is at its essence just a way of describing vector graphics, and (again not 77 | something you would have thought of) you can include PDF fragments in \[what 78 | will become\] another PDF document using the `\inclugegraphics` command. 79 | 80 | Extensions 81 | ---------- 82 | 83 | Both _.markdown_ and _.md_ are supported for files containing Markdown. Both 84 | _.latex_ and _.tex_ are supported for pure LaTeX files. 85 | 86 | Further reading: 87 | 88 | - [Getting Started](Tutorial.md) 89 | - [Examples](Examples.md) 90 | -------------------------------------------------------------------------------- /doc/Docker.md: -------------------------------------------------------------------------------- 1 | Docker Support 2 | ============== 3 | 4 | Using Docker for LaTeX dependencies 5 | ----------------------------------- 6 | 7 | Anyone who has used of LaTeX will be aware that rendering even a simple document 8 | requires hundreds of packages to be installed. If you want to install the 9 | packages yourself on your computer you can freely do so. 10 | 11 | To help people get started we supply an optional, builtin preamble; it still 12 | depends on some 216 LaTeX packages, though. The process of working through 13 | trying to render a document and one-by-one hunting down the packages you need 14 | to install can be tedious. 15 | 16 | So to compliment the builtin preamble we supply a prebuilt Docker image with 17 | these packages already installed. You can instruct _render_ to run the LaTeX 18 | processor in there, rather than on your own system, by specifying the 19 | `--docker` option: 20 | 21 | ```shell 22 | $ render --builtin-preamble --docker=aesiniath/publish-builtin:latest Trees.book 23 | $ 24 | ``` 25 | 26 | You are welcome to use any container you like. You need Latexmk installed (the 27 | **latexmk** package) with the LuaLaTeX processor installed (the 28 | **texlive-lualatex** collection should pull it in) as _render_ will invoke 29 | _latexmk_ command to build your resultant PDF. Images require that _inkscape_ 30 | is present (supplied by **inkscape** package on Fedora) on your host system. 31 | 32 | If you specify the `--docker` option, _render_ will spawn a Docker container 33 | from the image you specify, mount the temporary directory with the intermediate 34 | fragments _render_ has generated into the container, and then run the necessary 35 | _latexmk_ commands therein. 36 | 37 | If you don't use the `--docker` option, _render_ runs the exact same commands, 38 | but on your machine directly. 39 | 40 | Docker Inception 41 | ---------------- 42 | 43 | You can also run the _render_ tool itself in a Docker container. There's an 44 | image available at `docker.io/aesiniath/publish-render`. This means conceptually 45 | you should be able to do: 46 | 47 | ```shell 48 | $ docker run \ 49 | --rm=true \ 50 | --volume=`pwd`:/mnt \ 51 | aesiniath/publish-render:latest \ 52 | render \ 53 | --builtin-preamble \ 54 | --docker=aesiniath/publish-builtin:latest \ 55 | Trees.book 56 | $ 57 | ``` 58 | 59 | Nothing is ever simple in Dockerland, however. The first problem is that the 60 | _docker_ command line program needs to be installed in the container that 61 | _render_ is running in. When you just run these programs ordinarily on a Linux 62 | host then it of course has access to run Docker. But if run inside a container 63 | we need to install the binary and make the host's "docker control socket" 64 | available to it: 65 | 66 | ```shell 67 | $ docker run \ 68 | --rm=true \ 69 | --volume=/var/run/docker.sock:/var/run/docker.sock \ 70 | --volume=`pwd`:/mnt \ 71 | mypublish:latest \ 72 | render \ 73 | --builtin-preamble \ 74 | --docker=aesiniath/publish-builtin:latest \ 75 | Trees.book 76 | $ 77 | ``` 78 | 79 | where `mypublish` is a locally created image built from `aesiniath/publish-render` 80 | that adds the **docker-ce-cli** and **librsvg2-bin** packages. 81 | 82 | The second trouble is that there's no way to get the temporary directory 83 | (normally created with a random name by _render_ in _/tmp/publish-XXXXXX_ and 84 | recorded in _.target_) that is in the outer container that _render_ is running 85 | in mounted into the inner container that the _latexmk_ process runs in. 86 | 87 | You could get this to work if you "volume mount" the temporary directory in, 88 | but you have to do it from the **host**, because that's where the docker engine 89 | is; volumes requested from within one container (the outer one) won't be in the 90 | same namespace and thus will appear empty in the second (inner) container. 91 | 92 | We added an option to _render_ allowing you to override the temporary directory 93 | and manually force the directory name to be used. Creating it on the host, 94 | volume mounting it in to the outer container and then using `--temp` to specify 95 | it to the inner one works: 96 | 97 | ```shell 98 | $ mkdir /tmp/publish-local 99 | $ docker run \ 100 | --rm=true \ 101 | --volume=/var/run/docker.sock:/var/run/docker.sock \ 102 | --volume=/tmp/publish-local:/tmp/publish-local \ 103 | --volume=`pwd`:/mnt \ 104 | mypublish:latest \ 105 | render \ 106 | --temp=/tmp/publish-local \ 107 | --builtin-preamble \ 108 | --docker=aesiniath/publish-builtin:latest \ 109 | Trees.book 110 | $ 111 | ``` 112 | 113 | This could probably be easier, but it is at least possible, and how our users 114 | on Mac OS X are able to use the **publish** tools. 115 | 116 | The usual caveats about how evil it is to mount the Docker socket into a 117 | container apply. Don't do this at home. Or in prod at work, come to think of 118 | it. 119 | 120 | Other documentation: 121 | 122 | - [README](../README.md) 123 | - [Background](Background.md) 124 | - [Examples](Examples.md) 125 | 126 | -------------------------------------------------------------------------------- /src/LatexPreamble.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE QuasiQuotes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module LatexPreamble 7 | ( preamble, 8 | beginning, 9 | ending, 10 | ) 11 | where 12 | 13 | import Core.Program.Metadata 14 | import Core.Text 15 | 16 | preamble :: Rope 17 | preamble = 18 | [quote| 19 | \documentclass[12pt,a4paper,oneside,openany]{memoir} 20 | 21 | % 22 | % Load the TeX Gyre project's "Heros" font, which is an upgrade of URW's 23 | % lovely "Nimbus Sans L" sans-serif font. 24 | % 25 | 26 | \usepackage{fontspec} 27 | \setmainfont{Linux Libertine O} 28 | \setsansfont{TeX Gyre Heros}[Scale=MatchLowercase] 29 | \setmonofont{Inconsolata}[Scale=MatchLowercase] 30 | 31 | % use upquote for straight quotes in verbatim environments 32 | \usepackage{upquote} 33 | 34 | % use microtype 35 | \usepackage{microtype} 36 | \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts 37 | 38 | % 39 | % Customize paper size. Or not: A4 paper is 597pt x 845pt. 4:3 aka 768x1024 40 | % screen is 597pt x 796pt, but 16:9 aka 2560x1440 screen is 597pt x 1062pt. A4 41 | % in landscape is a fair way narrower. 42 | % 43 | 44 | \setlrmarginsandblock{2cm}{2.5cm}{*} 45 | \setulmarginsandblock{2cm}{2cm}{*} 46 | 47 | % 48 | % Setting the \footskip parameter is how you control the bottom margin width, 49 | % not "setting the bottom margin" since the typeblock will be set to be an 50 | % integer multiple of \baselineskip. 51 | % 52 | 53 | \setheadfoot{0pt}{25pt} 54 | \setheaderspaces{1cm}{*}{*} 55 | 56 | \checkandfixthelayout[classic] 57 | 58 | \usepackage{graphicx,grffile} 59 | 60 | \usepackage{longtable} 61 | 62 | \setlength{\emergencystretch}{3em} % prevent overfull lines 63 | 64 | \usepackage[hidelinks]{hyperref} 65 | 66 | % 67 | % Get rid of default headers and put page number in footer. 68 | % 69 | 70 | \makeoddfoot{plain}{}{}{\tiny\textsf{\thepage/\thelastpage}} 71 | \makeevenfoot{plain}{\tiny\textsf{\thepage/\thelastpage}}{}{} 72 | 73 | \makeoddhead{plain}{}{}{} 74 | \makeevenhead{plain}{}{}{} 75 | 76 | \pagestyle{plain} 77 | 78 | \SingleSpacing 79 | \nonzeroparskip 80 | \setlength{\parindent}{0em} 81 | 82 | % 83 | % Customize the section heading fonts to use this accordingly. 84 | % 85 | 86 | \chapterstyle{article} 87 | \setsecnumdepth{none} 88 | 89 | % FIXME Why isn't the \Huge font size command working? 90 | \renewcommand{\chaptitlefont}{\Large\sffamily\bfseries} 91 | 92 | \setsecheadstyle{\large\sffamily} 93 | \setsubsecheadstyle{\normalsize\sffamily\bfseries} 94 | \setsubsubsecheadstyle{\normalsize\rmfamily\itshape} 95 | 96 | |] 97 | 98 | #ifdef __GHCIDE__ 99 | version :: Version 100 | version = "0" 101 | #else 102 | version :: Version 103 | version = $(fromPackage) 104 | #endif 105 | 106 | beginning :: Rope 107 | beginning = 108 | [quote| 109 | 110 | % 111 | % Output from Skylighting.styleToLaTeX 112 | % 113 | 114 | \usepackage{color} 115 | \usepackage{fancyvrb} 116 | \newcommand{\VerbBar}{|} 117 | \newcommand{\VERB}{\Verb[commandchars=\\\{\}]} 118 | \DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\{\}} 119 | % Add ',fontsize=\small' for more characters per line 120 | \usepackage{framed} 121 | \definecolor{shadecolor}{RGB}{248,248,248} 122 | \newenvironment{Shaded}{\begin{snugshade}}{\end{snugshade}} 123 | \newcommand{\AlertTok}[1]{\textcolor[rgb]{0.94,0.16,0.16}{#1}} 124 | \newcommand{\AnnotationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}} 125 | \newcommand{\AttributeTok}[1]{\textcolor[rgb]{0.77,0.63,0.00}{#1}} 126 | \newcommand{\BaseNTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}} 127 | \newcommand{\BuiltInTok}[1]{#1} 128 | \newcommand{\CharTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}} 129 | \newcommand{\CommentTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textit{#1}}} 130 | \newcommand{\CommentVarTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}} 131 | \newcommand{\ConstantTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}} 132 | \newcommand{\ControlFlowTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{\textbf{#1}}} 133 | \newcommand{\DataTypeTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{#1}} 134 | \newcommand{\DecValTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}} 135 | \newcommand{\DocumentationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}} 136 | \newcommand{\ErrorTok}[1]{\textcolor[rgb]{0.64,0.00,0.00}{\textbf{#1}}} 137 | \newcommand{\ExtensionTok}[1]{#1} 138 | \newcommand{\FloatTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}} 139 | \newcommand{\FunctionTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}} 140 | \newcommand{\ImportTok}[1]{#1} 141 | \newcommand{\InformationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}} 142 | \newcommand{\KeywordTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{\textbf{#1}}} 143 | \newcommand{\NormalTok}[1]{#1} 144 | \newcommand{\OperatorTok}[1]{\textcolor[rgb]{0.81,0.36,0.00}{\textbf{#1}}} 145 | \newcommand{\OtherTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{#1}} 146 | \newcommand{\PreprocessorTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textit{#1}}} 147 | \newcommand{\RegionMarkerTok}[1]{#1} 148 | \newcommand{\SpecialCharTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}} 149 | \newcommand{\SpecialStringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}} 150 | \newcommand{\StringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}} 151 | \newcommand{\VariableTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}} 152 | \newcommand{\VerbatimStringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}} 153 | \newcommand{\WarningTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}} 154 | 155 | % 156 | % Enable strikeout (specifically the \st command) 157 | % 158 | 159 | \usepackage{soul} 160 | |] 161 | <> "\\hypersetup{pdfproducer={Markdown and Latex rendered via Publish " 162 | <> intoRope (versionNumberFrom version) 163 | <> "},pdfcreator={lualatex}}\n" 164 | <> "\\begin{document}\n" 165 | 166 | ending :: Rope 167 | ending = 168 | [quote| 169 | \end{document} 170 | |] 171 | -------------------------------------------------------------------------------- /src/PandocToMarkdown.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | module PandocToMarkdown ( 7 | pandocToMarkdown, 8 | NotSafe (..), 9 | tableToMarkdown, 10 | ) where 11 | 12 | import qualified Control.Exception.Safe as Safe (impureThrow) 13 | import Core.System.Base 14 | import Core.Text 15 | import Data.Foldable (foldl') 16 | import Data.List (intersperse) 17 | import qualified Data.Text as T (Text, null) 18 | import Text.Pandoc ( 19 | Alignment (..), 20 | Attr, 21 | Block (..), 22 | Caption (..), 23 | Cell (..), 24 | ColSpan (..), 25 | ColSpec, 26 | ColWidth (..), 27 | Format (..), 28 | Inline (..), 29 | ListAttributes, 30 | MathType (..), 31 | Pandoc (..), 32 | QuoteType (..), 33 | Row (..), 34 | RowSpan (..), 35 | TableBody (..), 36 | TableFoot (..), 37 | TableHead (..), 38 | ) 39 | import Text.Pandoc.Shared (orderedListMarkers) 40 | 41 | __WIDTH__ :: Int 42 | __WIDTH__ = 78 43 | 44 | pandocToMarkdown :: Pandoc -> Rope 45 | pandocToMarkdown (Pandoc _ blocks) = 46 | blocksToMarkdown __WIDTH__ blocks 47 | 48 | blocksToMarkdown :: Int -> [Block] -> Rope 49 | blocksToMarkdown _ [] = emptyRope 50 | blocksToMarkdown margin (block1 : blocks) = 51 | convertBlock margin block1 52 | <> foldl' 53 | (\text block -> text <> "\n" <> convertBlock margin block) 54 | emptyRope 55 | blocks 56 | 57 | convertBlock :: Int -> Block -> Rope 58 | convertBlock margin block = 59 | let msg = "Unfinished block: " ++ show block -- FIXME 60 | in case block of 61 | Plain inlines -> plaintextToMarkdown margin inlines 62 | Para inlines -> paragraphToMarkdown margin inlines 63 | Header level _ inlines -> headingToMarkdown level inlines 64 | RawBlock (Format "tex") string -> intoRope string <> "\n" 65 | RawBlock (Format "html") string -> intoRope string <> "\n" 66 | RawBlock _ _ -> error msg 67 | CodeBlock attr string -> codeToMarkdown attr string 68 | LineBlock list -> poemToMarkdown list 69 | BlockQuote blocks -> quoteToMarkdown margin blocks 70 | BulletList blockss -> bulletlistToMarkdown margin blockss 71 | OrderedList attrs blockss -> orderedlistToMarkdown margin attrs blockss 72 | DefinitionList blockss -> definitionlistToMarkdown margin blockss 73 | HorizontalRule -> "---\n" 74 | Table attr caption alignments header rows footer -> tableToMarkdown attr caption alignments header rows footer 75 | Div attr blocks -> divToMarkdown margin attr blocks 76 | Figure _ _ _ -> error msg 77 | 78 | {- 79 | This does **not** emit a newline at the end. The intersperse happening in 80 | `blocksToMarkdown` will terminate the line, but you won't get a blank line 81 | between blocks as is the convention everywhere else (this was critical when 82 | lists were nested in tight lists). 83 | -} 84 | plaintextToMarkdown :: Int -> [Inline] -> Rope 85 | plaintextToMarkdown margin inlines = 86 | wrap' margin (inlinesToMarkdown inlines) 87 | 88 | {- 89 | Everything was great until we had to figure out how to deal with line 90 | breaks aka
, represented in Markdown by [' ',' ']. We do this by 91 | replacing the line break Inline with \x2028. This character, U+2028 LS, is 92 | the Line Separator character. It's one of those symbols up in General 93 | Punctuation that no one ever uses. So we use it as a sentinel internally 94 | here; first we break on those, and then we wrap the results. 95 | -} 96 | paragraphToMarkdown :: Int -> [Inline] -> Rope 97 | paragraphToMarkdown margin inlines = 98 | wrap' margin (inlinesToMarkdown inlines) <> "\n" 99 | 100 | wrap' :: Int -> Rope -> Rope 101 | wrap' margin = 102 | mconcat . intersperse " \n" . fmap (wrap margin) . breakPieces isLineSeparator 103 | where 104 | isLineSeparator = (== '\x2028') 105 | 106 | headingToMarkdown :: Int -> [Inline] -> Rope 107 | headingToMarkdown level inlines = 108 | let text = inlinesToMarkdown inlines 109 | in case level of 110 | 1 -> text <> "\n" <> underline '=' text <> "\n" 111 | 2 -> text <> "\n" <> underline '-' text <> "\n" 112 | n -> intoRope (replicate n '#') <> " " <> text <> "\n" 113 | 114 | codeToMarkdown :: Attr -> T.Text -> Rope 115 | codeToMarkdown attr literal = 116 | let body = intoRope literal 117 | lang = fencedAttributesToMarkdown attr 118 | in "```" <> lang <> "\n" 119 | <> body 120 | <> "\n" 121 | <> "```" 122 | <> "\n" 123 | 124 | poemToMarkdown :: [[Inline]] -> Rope 125 | poemToMarkdown list = 126 | mconcat (intersperse "\n" (fmap prefix list)) <> "\n" 127 | where 128 | prefix inlines = "| " <> inlinesToMarkdown inlines 129 | 130 | quoteToMarkdown :: Int -> [Block] -> Rope 131 | quoteToMarkdown margin blocks = 132 | foldl' (\text block -> text <> prefix block) emptyRope blocks 133 | where 134 | prefix :: Block -> Rope 135 | prefix = foldl' (\text line -> text <> "> " <> line <> "\n") emptyRope . rows 136 | rows :: Block -> [Rope] 137 | rows = breakLines . convertBlock (margin - 2) 138 | 139 | bulletlistToMarkdown :: Int -> [[Block]] -> Rope 140 | bulletlistToMarkdown = listToMarkdown (repeat "- ") 141 | 142 | orderedlistToMarkdown :: Int -> ListAttributes -> [[Block]] -> Rope 143 | orderedlistToMarkdown margin (num, style, delim) blockss = 144 | listToMarkdown (intoMarkers (num, style, delim)) margin blockss 145 | where 146 | intoMarkers = fmap pad . fmap intoRope . orderedListMarkers 147 | pad text = text <> if widthRope text > 2 then " " else " " 148 | 149 | definitionlistToMarkdown :: Int -> [([Inline], [[Block]])] -> Rope 150 | definitionlistToMarkdown margin definitions = 151 | case definitions of 152 | [] -> emptyRope 153 | (definition1 : definitionN) -> 154 | handleDefinition definition1 155 | <> foldl' 156 | (\text definition -> text <> "\n" <> handleDefinition definition) 157 | emptyRope 158 | definitionN 159 | where 160 | handleDefinition :: ([Inline], [[Block]]) -> Rope 161 | handleDefinition (term, blockss) = 162 | inlinesToMarkdown term <> "\n\n" <> listToMarkdown (repeat ": ") margin blockss 163 | 164 | listToMarkdown :: [Rope] -> Int -> [[Block]] -> Rope 165 | listToMarkdown markers margin items = 166 | case pairs of 167 | [] -> emptyRope 168 | ((marker1, blocks1) : pairsN) -> 169 | listitem marker1 blocks1 170 | <> foldl' 171 | (\text (markerN, blocksN) -> text <> spacer blocksN <> listitem markerN blocksN) 172 | emptyRope 173 | pairsN 174 | where 175 | pairs = zip markers items 176 | listitem :: Rope -> [Block] -> Rope 177 | listitem _ [] = emptyRope 178 | listitem marker blocks = indent marker blocks 179 | {- 180 | Tricky. Tight lists are represented by Plain, whereas more widely spaced 181 | lists are represented by Para. A complex block (specifically a nested 182 | list!) will handle its own spacing. This seems fragile. 183 | -} 184 | spacer :: [Block] -> Rope 185 | spacer [] = emptyRope 186 | spacer (block : _) = case block of 187 | Plain _ -> emptyRope 188 | Para _ -> "\n" 189 | _ -> emptyRope -- ie nested list 190 | indent :: Rope -> [Block] -> Rope 191 | indent marker = 192 | snd . foldl' (f marker) (True, emptyRope) . breakLines . blocksToMarkdown (margin - 4) 193 | f :: Rope -> (Bool, Rope) -> Rope -> (Bool, Rope) 194 | f marker (first, text) line 195 | | nullRope line = 196 | (False, text <> "\n") -- don't indent lines that should be blank 197 | | otherwise = 198 | if first 199 | then (False, text <> marker <> line <> "\n") 200 | else (False, text <> " " <> line <> "\n") 201 | 202 | {- 203 | In Pandoc flavoured Markdown,
are recognized as valid Markdown via 204 | the `native_divs` extension. We turn that off, in favour of the 205 | `fenced_divs` extension, three (or more) colons 206 | 207 | ::: {#identifier .class key=value} 208 | Content 209 | ::: 210 | 211 | -} 212 | divToMarkdown :: Int -> Attr -> [Block] -> Rope 213 | divToMarkdown margin attr blocks = 214 | let first = ":::" <> fencedAttributesToMarkdown attr 215 | trail = ":::" 216 | content = mconcat . intersperse "\n" . fmap (convertBlock margin) 217 | in first <> "\n" <> content blocks <> trail <> "\n" 218 | 219 | -- special case for (notably) code blocks where a single class doesn't need braces. 220 | fencedAttributesToMarkdown :: Attr -> Rope 221 | fencedAttributesToMarkdown ("", [], []) = emptyRope 222 | fencedAttributesToMarkdown ("", [single], []) = intoRope single 223 | fencedAttributesToMarkdown (identifier, [], []) = " " <> attributesToMarkdown (identifier, [], []) 224 | fencedAttributesToMarkdown (identifier, classes, pairs) = " " <> attributesToMarkdown (identifier, classes, pairs) 225 | 226 | -- present attributes, used by both fenced blocks and inline spans 227 | attributesToMarkdown :: Attr -> Rope 228 | attributesToMarkdown ("", [], []) = emptyRope 229 | attributesToMarkdown (identifier, [], []) = "{#" <> intoRope identifier <> "}" 230 | attributesToMarkdown (identifier, classes, pairs) = 231 | let i = 232 | if T.null identifier 233 | then emptyRope 234 | else "#" <> intoRope identifier <> " " 235 | cs = fmap (\c -> "." <> intoRope c) classes 236 | ps = fmap (\(k, v) -> intoRope k <> "=" <> intoRope v) pairs 237 | in "{" <> i <> mconcat (intersperse " " (cs ++ ps)) <> "}" 238 | 239 | tableToMarkdown :: 240 | Attr -> 241 | Caption -> 242 | [ColSpec] -> 243 | TableHead -> 244 | [TableBody] -> 245 | TableFoot -> 246 | Rope 247 | tableToMarkdown _ _ alignments thead tbodys _ = 248 | mconcat 249 | ( intersperse 250 | "\n" 251 | [ headerline 252 | , betweenline 253 | , bodylines 254 | ] 255 | ) 256 | <> "\n" 257 | where 258 | colonChar = singletonRope ':' 259 | dashChar = singletonRope '-' 260 | pipeChar = singletonRope '|' 261 | spaceChar = singletonRope ' ' 262 | newlineChar = singletonRope '\n' 263 | 264 | surround :: Rope -> Rope -> Rope 265 | surround char text = char <> text <> char 266 | 267 | headerline = headerToMarkdown thead 268 | 269 | betweenline = 270 | surround pipeChar . foldl' (<>) emptyRope 271 | . intersperse pipeChar 272 | . fmap columnToMarkdown 273 | $ alignments 274 | 275 | bodylines = bodiesToMarkdown tbodys 276 | 277 | headerToMarkdown :: TableHead -> Rope 278 | headerToMarkdown (TableHead _ [row]) = rowToMarkdown row 279 | headerToMarkdown _ = Safe.impureThrow (NotSafe "What do we do with this TableHead?") 280 | 281 | columnToMarkdown :: (Alignment, ColWidth) -> Rope 282 | columnToMarkdown (align, col) = 283 | let total = fromIntegral __WIDTH__ 284 | begin = case align of 285 | AlignLeft -> colonChar 286 | AlignCenter -> colonChar 287 | _ -> dashChar 288 | 289 | num = case col of 290 | ColWidth x -> floor (total * x) - 2 291 | ColWidthDefault -> 6 292 | middle = mconcat (replicate num dashChar) 293 | 294 | end = case align of 295 | AlignRight -> colonChar 296 | AlignCenter -> colonChar 297 | _ -> dashChar 298 | in begin <> middle <> end 299 | 300 | bodiesToMarkdown :: [TableBody] -> Rope 301 | bodiesToMarkdown = mconcat . intersperse newlineChar . fmap bodyToMarkdown 302 | 303 | bodyToMarkdown :: TableBody -> Rope 304 | bodyToMarkdown (TableBody _ _ _ rows) = 305 | foldl' (<>) emptyRope 306 | . intersperse newlineChar 307 | . fmap rowToMarkdown 308 | $ rows 309 | 310 | rowToMarkdown :: Row -> Rope 311 | rowToMarkdown (Row _ cells) = 312 | surround pipeChar . foldl' (<>) emptyRope 313 | . intersperse pipeChar 314 | . fmap (surround spaceChar . cellToMarkdown) 315 | $ cells 316 | 317 | cellToMarkdown :: Cell -> Rope 318 | cellToMarkdown (Cell _ _ (RowSpan 1) (ColSpan 1) [block]) = 319 | convert block 320 | cellToMarkdown _ = 321 | Safe.impureThrow (NotSafe "Multiple Blocks encountered") 322 | 323 | convert :: Block -> Rope 324 | convert (Plain inlines) = 325 | plaintextToMarkdown 100000 inlines 326 | convert _ = 327 | Safe.impureThrow (NotSafe "Incorrect Block type encountered") 328 | 329 | data NotSafe = NotSafe String 330 | deriving (Show) 331 | 332 | instance Exception NotSafe 333 | 334 | ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- 335 | 336 | inlinesToMarkdown :: [Inline] -> Rope 337 | inlinesToMarkdown inlines = 338 | foldl' (\text inline -> appendRope (convertInline inline) text) emptyRope inlines 339 | 340 | convertInline :: Inline -> Rope 341 | convertInline inline = 342 | let msg = "Unfinished inline: " ++ show inline 343 | in case inline of 344 | Space -> " " 345 | Str text -> stringToMarkdown text 346 | Emph inlines -> "_" <> inlinesToMarkdown inlines <> "_" 347 | Strong inlines -> "**" <> inlinesToMarkdown inlines <> "**" 348 | SoftBreak -> " " 349 | LineBreak -> "\x2028" 350 | Image attr inlines target -> imageToMarkdown attr inlines target 351 | Code _ string -> "`" <> intoRope string <> "`" 352 | RawInline (Format "tex") string -> intoRope string 353 | RawInline (Format "html") string -> intoRope string 354 | RawInline _ _ -> error msg 355 | Link ("", ["uri"], []) _ (url, _) -> uriToMarkdown url 356 | Link attr inlines target -> linkToMarkdown attr inlines target 357 | Strikeout inlines -> "~~" <> inlinesToMarkdown inlines <> "~~" 358 | Math mode text -> mathToMarkdown mode text 359 | -- then things start getting weird 360 | SmallCaps inlines -> smallcapsToMarkdown inlines 361 | Subscript inlines -> "~" <> inlinesToMarkdown inlines <> "~" 362 | Superscript inlines -> "^" <> inlinesToMarkdown inlines <> "^" 363 | Span attr inlines -> spanToMarkdown attr inlines 364 | -- I don't know what the point of these ones are 365 | Quoted SingleQuote inlines -> "'" <> inlinesToMarkdown inlines <> "'" 366 | Quoted DoubleQuote inlines -> "\"" <> inlinesToMarkdown inlines <> "\"" 367 | _ -> error msg 368 | 369 | {- 370 | Pandoc uses U+00A0 aka ASCII 160 aka   to mark a non-breaking space, which 371 | seems to be how it describes an escaped space in Markdown. So scan for these 372 | and replace the escaped space on output. 373 | -} 374 | stringToMarkdown :: T.Text -> Rope 375 | stringToMarkdown = 376 | escapeSpecialWith '\x00a0' ' ' 377 | . escapeSpecial '[' 378 | . escapeSpecial ']' 379 | . escapeSpecial '_' 380 | . intoRope 381 | 382 | escapeSpecial :: Char -> Rope -> Rope 383 | escapeSpecial c = escapeSpecialWith c c 384 | 385 | escapeSpecialWith :: Char -> Char -> Rope -> Rope 386 | escapeSpecialWith needle replacement = 387 | mconcat . intersperse (singletonRope '\\' <> singletonRope replacement) . breakPieces isNeedle . intoRope 388 | where 389 | isNeedle c = c == needle 390 | 391 | imageToMarkdown :: Attr -> [Inline] -> (T.Text, T.Text) -> Rope 392 | imageToMarkdown attr inlines (url, title) = 393 | let alt = inlinesToMarkdown inlines 394 | target = 395 | if T.null title 396 | then intoRope url 397 | else intoRope url <> " \"" <> intoRope title <> "\"" 398 | in "![" <> alt <> "](" <> target <> ")" <> attributesToMarkdown attr 399 | 400 | uriToMarkdown :: T.Text -> Rope 401 | uriToMarkdown url = 402 | let target = intoRope url 403 | in "<" <> target <> ">" 404 | 405 | linkToMarkdown :: Attr -> [Inline] -> (T.Text, T.Text) -> Rope 406 | linkToMarkdown attr inlines (url, title) = 407 | let text = inlinesToMarkdown inlines 408 | target = 409 | if T.null title 410 | then intoRope url 411 | else intoRope url <> " \"" <> intoRope title <> "\"" 412 | in "[" <> text <> "](" <> target <> ")" <> attributesToMarkdown attr 413 | 414 | -- is there more to this? 415 | mathToMarkdown :: MathType -> T.Text -> Rope 416 | mathToMarkdown (InlineMath) math = "$" <> intoRope math <> "$" 417 | mathToMarkdown (DisplayMath) math = "$$" <> intoRope math <> "$$" 418 | 419 | smallcapsToMarkdown :: [Inline] -> Rope 420 | smallcapsToMarkdown inlines = 421 | let text = inlinesToMarkdown inlines 422 | in "[" <> text <> "]{.smallcaps}" 423 | 424 | spanToMarkdown :: Attr -> [Inline] -> Rope 425 | spanToMarkdown attr inlines = 426 | let text = inlinesToMarkdown inlines 427 | in "[" <> text <> "]" <> attributesToMarkdown attr 428 | -------------------------------------------------------------------------------- /src/RenderDocument.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE QuasiQuotes #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module RenderDocument ( 8 | program, 9 | ) where 10 | 11 | import Control.Exception.Safe qualified as Safe 12 | import Control.Monad (filterM, forM_, forever, void) 13 | import Core.Data 14 | import Core.Program 15 | import Core.System 16 | import Core.Telemetry 17 | import Core.Text 18 | import Data.Char (isSpace) 19 | import Data.List qualified as List (dropWhileEnd, null) 20 | import Data.Text.IO qualified as T 21 | import Environment (Bookfile (..), Env (..)) 22 | import LatexOutputReader (parseOutputForError) 23 | import LatexPreamble (beginning, ending, preamble) 24 | import ParseBookfile (parseBookfile) 25 | import System.Directory ( 26 | copyFileWithMetadata, 27 | doesDirectoryExist, 28 | doesFileExist, 29 | renameFile, 30 | ) 31 | import System.Exit (ExitCode (..)) 32 | import System.FilePath.Posix ( 33 | dropExtension, 34 | replaceDirectory, 35 | replaceExtension, 36 | splitFileName, 37 | takeBaseName, 38 | takeExtension, 39 | ) 40 | import System.IO (hPutStrLn) 41 | import System.Posix.Directory (changeWorkingDirectory) 42 | import System.Posix.Temp (mkdtemp) 43 | import System.Posix.User (getEffectiveGroupID, getEffectiveUserID) 44 | import Text.Megaparsec (errorBundlePretty, runParser) 45 | import Text.Pandoc ( 46 | TopLevelDivision (TopLevelSection), 47 | def, 48 | pandocExtensions, 49 | readMarkdown, 50 | readerColumns, 51 | readerExtensions, 52 | runIOorExplode, 53 | writeLaTeX, 54 | writerTopLevelDivision, 55 | ) 56 | import Utilities (ensureDirectory, ifNewer, isNewer) 57 | 58 | data Mode = Once | Cycle 59 | 60 | data Copy = InstallPdf | NoCopyPdf 61 | 62 | program :: Program Env () 63 | program = do 64 | (mode, copy) <- extractMode 65 | 66 | info "Identify .book file" 67 | bookfile <- extractBookFile 68 | 69 | case mode of 70 | Once -> do 71 | -- normal operation, single pass 72 | void (renderDocument (mode, copy) bookfile) 73 | Cycle -> do 74 | -- use inotify to rebuild on changes 75 | forever (renderDocument (mode, copy) bookfile >>= waitForChange >> resetTimer) 76 | 77 | renderDocument :: (Mode, Copy) -> FilePath -> Program Env [FilePath] 78 | renderDocument (mode, copy) file = do 79 | setServiceName "render" 80 | beginTrace $ do 81 | encloseSpan "Render document" $ do 82 | telemetry 83 | [ metric "bookfile" file 84 | ] 85 | 86 | book <- encloseSpan "Setup" $ do 87 | info "Read .book file" 88 | book <- processBookFile file 89 | 90 | info "Setup temporary directory" 91 | setupTargetFile file 92 | setupPreambleFile 93 | validatePreamble book 94 | 95 | pure book 96 | 97 | let preambles = preamblesFrom book 98 | let fragments = fragmentsFrom book 99 | let trailers = trailersFrom book 100 | 101 | encloseSpan "Convert fragments" $ do 102 | info "Convert preamble fragments and begin marker to LaTeX" 103 | mapM_ processFragment preambles 104 | setupBeginningFile 105 | 106 | info "Convert document fragments to LaTeX" 107 | mapM_ processFragment fragments 108 | 109 | info "Convert end marker and trailing fragments to LaTeX" 110 | setupEndingFile 111 | mapM_ processFragment trailers 112 | 113 | info "Write intermediate LaTeX file" 114 | produceResult 115 | 116 | encloseSpan "Render LaTeX to PDF" $ do 117 | info "Render document to PDF" 118 | catch 119 | ( do 120 | renderPDF 121 | case copy of 122 | InstallPdf -> copyHere 123 | NoCopyPdf -> return () 124 | ) 125 | ( \(e :: ExitCode) -> case mode of 126 | Once -> throw e 127 | Cycle -> return () 128 | ) 129 | 130 | pure (uniqueList file preambles fragments trailers) 131 | 132 | -- 133 | -- Quickly reduce the fragment names to a unique list so we don't waste 134 | -- inotify watches. 135 | -- 136 | uniqueList :: FilePath -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] 137 | uniqueList file preambles fragments trailers = 138 | let files = insertElement file (intoSet trailers <> (intoSet preambles <> intoSet fragments)) 139 | in fromSet files 140 | 141 | extractMode :: Program Env (Mode, Copy) 142 | extractMode = do 143 | mode <- 144 | queryOptionFlag "watch" >>= \case 145 | True -> pure Cycle 146 | False -> pure Once 147 | 148 | copy <- 149 | queryOptionFlag "no-copy" >>= \case 150 | True -> pure NoCopyPdf 151 | False -> pure InstallPdf 152 | 153 | pure (mode, copy) 154 | 155 | {- 156 | For the situation where the .book file is in a location other than '.' 157 | then chdir there first, so any relative paths within _it_ are handled 158 | properly, as are inotify watches later if they are employed. 159 | -} 160 | extractBookFile :: Program Env FilePath 161 | extractBookFile = do 162 | file <- queryArgument "bookfile" 163 | let (relative, bookfile) = splitFileName (fromRope file) 164 | 165 | debugS "relative" relative 166 | debugS "bookfile" bookfile 167 | probe <- liftIO $ do 168 | changeWorkingDirectory relative 169 | doesFileExist bookfile 170 | case probe of 171 | True -> return bookfile 172 | False -> do 173 | write ("error: specified .book file \"" <> intoRope bookfile <> "\" not found.") 174 | throw (userError "no such file") 175 | 176 | setupTargetFile :: FilePath -> Program Env () 177 | setupTargetFile file = do 178 | env <- getApplicationState 179 | let start = startingDirectoryFrom env 180 | let dotfile = start ++ "/.target" 181 | 182 | tmpdir <- 183 | queryOptionValue "temp" >>= \case 184 | Just dir -> do 185 | -- Append a slash so that /tmp/booga is taken as a directory. 186 | -- Otherwise, you end up ensuring /tmp exists. 187 | ensureDirectory (fromRope dir ++ "/") 188 | return (fromRope dir) 189 | Nothing -> 190 | liftIO $ 191 | Safe.catch 192 | ( do 193 | dir' <- readFile dotfile 194 | let dir = trim dir' 195 | probe <- doesDirectoryExist dir 196 | if probe 197 | then return dir 198 | else Safe.throw boom 199 | ) 200 | ( \(_ :: IOError) -> do 201 | dir <- mkdtemp "/tmp/publish-" 202 | writeFile dotfile (dir ++ "\n") 203 | return dir 204 | ) 205 | debugS "tmpdir" tmpdir 206 | 207 | let master = tmpdir ++ "/" ++ base ++ ".tex" 208 | result = tmpdir ++ "/" ++ base ++ ".pdf" 209 | 210 | let env' = 211 | env 212 | { intermediateFilenamesFrom = [] 213 | , masterFilenameFrom = master 214 | , resultFilenameFrom = result 215 | , tempDirectoryFrom = tmpdir 216 | } 217 | setApplicationState env' 218 | where 219 | base = takeBaseName file -- "/directory/file.ext" -> "file" 220 | boom = userError "Temp dir no longer present" 221 | trim :: String -> String 222 | trim = List.dropWhileEnd isSpace 223 | 224 | setupPreambleFile :: Program Env () 225 | setupPreambleFile = do 226 | env <- getApplicationState 227 | let tmpdir = tempDirectoryFrom env 228 | 229 | first <- 230 | queryOptionFlag "builtin-preamble" >>= \case 231 | False -> return [] 232 | True -> do 233 | let name = "00_Preamble.latex" 234 | let target = tmpdir ++ "/" ++ name 235 | liftIO $ 236 | withFile target WriteMode $ \handle -> do 237 | hWrite handle preamble 238 | return [name] 239 | 240 | let env' = env{intermediateFilenamesFrom = first} 241 | setApplicationState env' 242 | 243 | {- 244 | This could do a lot more; checking to see if \documentclass is present, for 245 | example. At present this covers the (likely common) failure mode of 246 | specifying neither -p nor a preamble in the bookfile. 247 | -} 248 | validatePreamble :: Bookfile -> Program Env () 249 | validatePreamble book = do 250 | let preambles = preamblesFrom book 251 | 252 | builtin <- queryOptionFlag "builtin-preamble" 253 | 254 | if List.null preambles && not builtin 255 | then do 256 | write "error: no preamble\n" 257 | let msg :: Rope = 258 | [quote| 259 | You need to either a) put the name of the file including the LaTeX 260 | preamble for your document in the .book file between the "% publish" 261 | and "% begin" lines, or b) specify the --builtin-preamble option on 262 | the command-line when running this program. 263 | |] 264 | writeR msg 265 | terminate 2 266 | else return () 267 | 268 | setupBeginningFile :: Program Env () 269 | setupBeginningFile = do 270 | env <- getApplicationState 271 | let tmpdir = tempDirectoryFrom env 272 | files = intermediateFilenamesFrom env 273 | 274 | file <- do 275 | let name = "99_Beginning.latex" 276 | let target = tmpdir ++ "/" ++ name 277 | liftIO $ 278 | withFile target WriteMode $ \handle -> do 279 | hWrite handle beginning 280 | return name 281 | 282 | let env' = env{intermediateFilenamesFrom = file : files} 283 | setApplicationState env' 284 | 285 | setupEndingFile :: Program Env () 286 | setupEndingFile = do 287 | env <- getApplicationState 288 | let tmpdir = tempDirectoryFrom env 289 | files = intermediateFilenamesFrom env 290 | 291 | file <- do 292 | let name = "ZZ_Ending.latex" 293 | let target = tmpdir ++ "/" ++ name 294 | liftIO $ 295 | withFile target WriteMode $ \handle -> do 296 | hWrite handle ending 297 | return name 298 | 299 | let env' = env{intermediateFilenamesFrom = file : files} 300 | setApplicationState env' 301 | 302 | processBookFile :: FilePath -> Program Env Bookfile 303 | processBookFile file = do 304 | contents <- liftIO (readFile file) 305 | 306 | let result = runParser parseBookfile file contents 307 | bookfile <- case result of 308 | Left err -> do 309 | write (intoRope (errorBundlePretty err)) 310 | terminate 1 311 | Right value -> return value 312 | 313 | list1 <- filterM skipNotFound (preamblesFrom bookfile) 314 | debugS "preambles" (length list1) 315 | 316 | list2 <- filterM skipNotFound (fragmentsFrom bookfile) 317 | debugS "fragments" (length list2) 318 | 319 | list3 <- filterM skipNotFound (trailersFrom bookfile) 320 | debugS "trailers" (length list3) 321 | 322 | return bookfile{preamblesFrom = list1, fragmentsFrom = list2, trailersFrom = list3} 323 | where 324 | skipNotFound :: FilePath -> Program t Bool 325 | skipNotFound fragment = do 326 | probe <- liftIO (doesFileExist fragment) 327 | case probe of 328 | True -> return True 329 | False -> do 330 | warn "Fragment not found" 331 | write ("warning: Fragment \"" <> intoRope fragment <> "\" not found, skipping") 332 | return False 333 | 334 | {- 335 | Which kind of file is it? Dispatch to the appropriate reader switching on 336 | filename extension. 337 | -} 338 | processFragment :: FilePath -> Program Env () 339 | processFragment file = do 340 | debugS "source" file 341 | 342 | -- Read the fragment, process it if Markdown then run it out to LaTeX. 343 | case takeExtension file of 344 | ".markdown" -> convertMarkdown file 345 | ".md" -> convertMarkdown file 346 | ".latex" -> passthroughLaTeX file 347 | ".tex" -> passthroughLaTeX file 348 | ".svg" -> convertImage file 349 | _ -> passthroughImage file 350 | 351 | {- 352 | Convert Markdown to LaTeX. This is where we "call" Pandoc. 353 | 354 | Default behaviour from the command line is to activate all (?) of Pandoc's 355 | Markdown extensions, but invoking via the `readMarkdown` function with 356 | default ReaderOptions doesn't turn any on. Using `pandocExtensions` here 357 | appears to represent the whole set. 358 | 359 | When output format is LaTeX, the command-line _pandoc_ tool does some 360 | somewhat convoluted heuristics to decide whether top-level headings (ie 361 |

, ====, #) are to be considered \part, \chapter, or \section. The fact 362 | that is not deterministic is annoying. Force the issue. 363 | 364 | Finally, for some reason, the Markdown -> LaTeX pair strips trailing 365 | whitespace from the block, resulting in a no paragraph boundary between 366 | files. So gratuitously add a break. 367 | -} 368 | convertMarkdown :: FilePath -> Program Env () 369 | convertMarkdown file = 370 | let readingOptions = 371 | def 372 | { readerExtensions = pandocExtensions 373 | , readerColumns = 75 374 | } 375 | writingOptions = 376 | def 377 | { writerTopLevelDivision = TopLevelSection 378 | } 379 | in do 380 | encloseSpan "convertMarkdown" $ do 381 | env <- getApplicationState 382 | let tmpdir = tempDirectoryFrom env 383 | file' = replaceExtension file ".latex" 384 | target = tmpdir ++ "/" ++ file' 385 | files = intermediateFilenamesFrom env 386 | 387 | ensureDirectory target 388 | ifNewer file target $ do 389 | debugS "target" target 390 | liftIO $ do 391 | contents <- T.readFile file 392 | 393 | latex <- runIOorExplode $ do 394 | parsed <- readMarkdown readingOptions contents 395 | writeLaTeX writingOptions parsed 396 | 397 | withFile target WriteMode $ \handle -> do 398 | T.hPutStrLn handle latex 399 | T.hPutStr handle "\n" 400 | 401 | let env' = env{intermediateFilenamesFrom = file' : files} 402 | setApplicationState env' 403 | 404 | telemetry 405 | [ metric "file" file 406 | ] 407 | 408 | {- 409 | If a source fragment is already LaTeX, simply copy it through to 410 | the target file. 411 | -} 412 | passthroughLaTeX :: FilePath -> Program Env () 413 | passthroughLaTeX file = do 414 | encloseSpan "passthroughLaTeX" $ do 415 | env <- getApplicationState 416 | let tmpdir = tempDirectoryFrom env 417 | target = tmpdir ++ "/" ++ file 418 | files = intermediateFilenamesFrom env 419 | 420 | ensureDirectory target 421 | ifNewer file target $ do 422 | debugS "target" target 423 | liftIO $ do 424 | copyFileWithMetadata file target 425 | 426 | let env' = env{intermediateFilenamesFrom = file : files} 427 | setApplicationState env' 428 | telemetry 429 | [ metric "file" file 430 | ] 431 | 432 | {- 433 | Images in SVG format need to be converted to PDF to be able to be 434 | included in the output as LaTeX doesn't understand SVG natively, which 435 | is slightly shocking. 436 | -} 437 | convertImage :: FilePath -> Program Env () 438 | convertImage file = do 439 | encloseSpan "convertImage" $ do 440 | telemetry 441 | [ metric "file" file 442 | ] 443 | env <- getApplicationState 444 | let tmpdir = tempDirectoryFrom env 445 | basepath = dropExtension file 446 | target = tmpdir ++ "/" ++ basepath ++ ".pdf" 447 | buffer = tmpdir ++ "/" ++ basepath ++ "~tmp.pdf" 448 | convert = 449 | [ "rsvg-convert" 450 | , "--format" 451 | , "pdf" 452 | , "--output" 453 | , buffer 454 | , file 455 | ] 456 | 457 | ifNewer file target $ do 458 | debugS "target" target 459 | (exit, out, err) <- do 460 | ensureDirectory target 461 | readProcess (fmap intoRope convert) 462 | 463 | case exit of 464 | ExitFailure _ -> do 465 | info "Image processing failed" 466 | debug "stderr" (intoRope err) 467 | debug "stdout" (intoRope out) 468 | write ("error: Unable to convert " <> intoRope file <> " from SVG to PDF") 469 | throw exit 470 | ExitSuccess -> liftIO $ do 471 | renameFile buffer target 472 | 473 | passthroughImage :: FilePath -> Program Env () 474 | passthroughImage file = do 475 | encloseSpan "passthroughImage" $ do 476 | telemetry 477 | [ metric "file" file 478 | ] 479 | env <- getApplicationState 480 | let tmpdir = tempDirectoryFrom env 481 | target = tmpdir ++ "/" ++ file 482 | 483 | ensureDirectory target 484 | ifNewer file target $ do 485 | debugS "target" target 486 | liftIO $ do 487 | copyFileWithMetadata file target 488 | 489 | {- 490 | Finish up by writing the intermediate "master" file. 491 | -} 492 | produceResult :: Program Env () 493 | produceResult = do 494 | env <- getApplicationState 495 | let master = masterFilenameFrom env 496 | files = intermediateFilenamesFrom env 497 | 498 | debugS "master" master 499 | liftIO $ 500 | withFile master WriteMode $ \handle -> do 501 | hPutStrLn handle ("\\RequirePackage{import}") 502 | forM_ (reverse files) $ \file -> do 503 | let (path, name) = splitFileName file 504 | hPutStrLn handle ("\\subimport{" ++ path ++ "}{" ++ name ++ "}") 505 | 506 | getUserID :: Program a Rope 507 | getUserID = liftIO $ do 508 | uid <- getEffectiveUserID 509 | gid <- getEffectiveGroupID 510 | return (intoRope (show uid ++ ":" ++ show gid)) 511 | 512 | renderPDF :: Program Env () 513 | renderPDF = do 514 | env <- getApplicationState 515 | 516 | let master = intoRope (masterFilenameFrom env) 517 | tmpdir = intoRope (tempDirectoryFrom env) 518 | 519 | user <- getUserID 520 | 521 | command <- 522 | queryOptionValue "docker" >>= \case 523 | Just image -> 524 | pure 525 | [ "docker" 526 | , "run" 527 | , "--rm=true" 528 | , "--volume=" <> tmpdir <> ":" <> tmpdir 529 | , "--user=" <> user 530 | , intoRope image 531 | , "latexmk" 532 | ] 533 | Nothing -> 534 | pure 535 | [ "latexmk" 536 | ] 537 | let options = 538 | [ "-lualatex" 539 | , "-output-directory=" <> tmpdir 540 | , "-interaction=nonstopmode" 541 | , "-halt-on-error" 542 | , "-file-line-error" 543 | , "-cd" 544 | , master 545 | ] 546 | latexmk = command ++ options 547 | 548 | (exit, out, err) <- readProcess latexmk 549 | case exit of 550 | ExitFailure _ -> do 551 | info "Render failed" 552 | debug "stderr" err 553 | debug "stdout" out 554 | write (parseOutputForError (fromRope tmpdir) out) 555 | throw exit 556 | ExitSuccess -> return () 557 | 558 | copyHere :: Program Env () 559 | copyHere = do 560 | env <- getApplicationState 561 | let result = resultFilenameFrom env 562 | start = startingDirectoryFrom env 563 | final = replaceDirectory result start -- ie ./Book.pdf 564 | changed <- isNewer result final 565 | case changed of 566 | True -> do 567 | info "Copy resultant PDF to starting directory" 568 | debugS "result" result 569 | debugS "final" final 570 | liftIO $ do 571 | copyFileWithMetadata result final 572 | info "Complete" 573 | False -> do 574 | info "Result unchanged" 575 | 576 | telemetry 577 | [ metric "changed" changed 578 | ] 579 | --------------------------------------------------------------------------------