publish (empty) → 0.3.2
raw patch · 11 files changed
+990/−0 lines, 11 filesdep +basedep +bytestringdep +chronologique
Dependencies added: base, bytestring, chronologique, directory, filepath, hinotify, pandoc, pandoc-types, template-haskell, text, typed-process, unbeliever, unix, unordered-containers
Files
- LICENCE +32/−0
- publish.cabal +83/−0
- src/Environment.hs +22/−0
- src/FormatDocument.hs +64/−0
- src/FormatMain.hs +23/−0
- src/LatexPreamble.hs +99/−0
- src/NotifyChanges.hs +73/−0
- src/OutputParser.hs +41/−0
- src/RenderDocument.hs +416/−0
- src/RenderMain.hs +47/−0
- src/Utilities.hs +90/−0
+ LICENCE view
@@ -0,0 +1,32 @@+Publishing tools for papers, books, and presentations++Copyright © 2016-2018 Operational Dynamics Consulting, Pty Ltd and Others+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ 1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ 2. Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.+ + 3. Neither the name of the project nor the names of its contributors+ may be used to endorse or promote products derived from this + software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ publish.cabal view
@@ -0,0 +1,83 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 41c25ce1051d93b85743e4f7cc0fd8b69bae4d522b04c60eea9cb5624fd5ae98++name: publish+version: 0.3.2+synopsis: Publishing tools for papers, books, and presentations+description: Tools for rendering markdown-centric documents into PDFs.+ .+ A description of this package, a list of features, and some background+ to its design is contained in the+ <https://github.com/oprdyn/publish/blob/master/README.markdown README>+ on GitHub.+ .+ The main program, @render@, is available via a Docker image at+ <https://cloud.docker.com/u/oprdyn/repository/docker/oprdyn/publish-render/general docker.io/oprdyn/publish-render:latest>+category: Text+stability: experimental+author: Andrew Cowie <andrew@operationaldynamics.com>+maintainer: Andrew Cowie <andrew@operationaldynamics.com>+copyright: © 2016-2019 Operational Dynamics Consulting Pty Ltd, and Others+license: BSD3+license-file: LICENCE+tested-with: GHC == 8.4+build-type: Simple++executable format+ main-is: FormatMain.hs+ other-modules:+ FormatDocument+ hs-source-dirs:+ src+ ghc-options: -threaded -Wall -Wwarn -fwarn-tabs+ build-depends:+ base >=4.11 && <5+ , bytestring+ , chronologique+ , directory+ , filepath+ , hinotify+ , pandoc+ , pandoc-types+ , template-haskell+ , text+ , typed-process+ , unbeliever >=0.8.0+ , unix+ , unordered-containers+ default-language: Haskell2010++executable render+ main-is: RenderMain.hs+ other-modules:+ RenderDocument+ Environment+ LatexPreamble+ NotifyChanges+ OutputParser+ Paths_publish+ Utilities+ hs-source-dirs:+ src+ ghc-options: -threaded -Wall -Wwarn -fwarn-tabs+ build-depends:+ base >=4.11 && <5+ , bytestring+ , chronologique+ , directory+ , filepath+ , hinotify+ , pandoc+ , pandoc-types+ , template-haskell+ , text+ , typed-process+ , unbeliever >=0.8.0+ , unix+ , unordered-containers+ default-language: Haskell2010
+ src/Environment.hs view
@@ -0,0 +1,22 @@+module Environment+(+ Env(..)+ , initial+)+where++import System.Posix.Directory (getWorkingDirectory)++data Env = Env+ { startingDirectoryFrom :: FilePath+ , intermediateFilenamesFrom :: [FilePath]+ , masterFilenameFrom :: FilePath+ , resultFilenameFrom :: FilePath+ , tempDirectoryFrom :: FilePath+ }++initial :: IO Env+initial = do+ cwd <- getWorkingDirectory+ return (Env cwd [] "/dev/null" "/dev/null" "/dev/null")+
+ src/FormatDocument.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module FormatDocument+ ( program+ )+where++import Core.Program+import Core.System+import qualified Data.Text.IO as T+import Text.Pandoc (runIOorExplode, readMarkdown, writeMarkdown, def+ , readerExtensions, pandocExtensions, writerExtensions, writerColumns+ , writerSetextHeaders, writerWrapText, WrapOption(WrapAuto), Pandoc)++program :: Program None ()+program = do+ event "Identify document fragment"+ file <- getFragmentName++ event "Load to Pandoc internal representation"+ parsed <- loadFragment file++ event "Write to Markdown format"+ writeResult file parsed++ event "Complete"++getFragmentName :: Program None FilePath+getFragmentName = do+ params <- getCommandLine+ let fragment = case lookupArgument "document" params of+ Nothing -> error "invalid"+ Just file -> file+ return fragment++loadFragment :: FilePath -> Program None Pandoc+loadFragment file =+ let+ readingOptions = def+ { readerExtensions = pandocExtensions+ }+ in+ liftIO $ do+ contents <- T.readFile file+ runIOorExplode $ do+ readMarkdown readingOptions contents++writeResult :: FilePath -> Pandoc -> Program None ()+writeResult file doc =+ let+ result = file ++ "-tmp"+ writingOptions = def+ { writerExtensions = pandocExtensions+ , writerWrapText = WrapAuto+ , writerColumns = 75+ , writerSetextHeaders = True+ }+ in+ liftIO $ do+ contents' <- runIOorExplode $ do+ writeMarkdown writingOptions doc+ T.writeFile result contents'+
+ src/FormatMain.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Core.Program+import Core.Text++import FormatDocument (program)++version :: Version+version = $(fromPackage)++main :: IO ()+main = do+ context <- configure version None (simple+ [ Argument "document" [quote|+ The file containing the markdown to be reformatted+ |]+ ])++ executeWith context program
+ src/LatexPreamble.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module LatexPreamble+ ( preamble+ , ending+ )+where++import Core.Text++preamble :: Rope+preamble = [quote|+\documentclass[12pt,a4paper,oneside,openany]{memoir}++%+% Load the TeX Gyre project's "Heros" font, which is an upgrade of URW's+% lovely "Nimbus Sans L" sans-serif font.+%++\usepackage{fontspec}+\setmainfont{Linux Libertine O}+\setsansfont{TeX Gyre Heros}[Scale=MatchLowercase]+\setmonofont{Inconsolata}[Scale=MatchLowercase]++%\usepackage[showframe, pass]{geometry}++% use upquote for straight quotes in verbatim environments+\usepackage{upquote}++% use microtype+\usepackage{microtype}+\UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts++%+% Customize paper size. Or not: A4 paper is 597pt x 845pt. 4:3 aka 768x1024+% screen is 597pt x 796pt, but 16:9 aka 2560x1440 screen is 597pt x 1062pt. A4+% in landscape is a fair way narrower.+%++\setlrmarginsandblock{2cm}{2.5cm}{*}+\setulmarginsandblock{2cm}{2cm}{*}++%+% Setting the \footskip parameter is how you control the bottom margin width,+% not "setting the bottom margin" since the typeblock will be set to be an+% integer multiple of \baselineskip.+%++\setheadfoot{0pt}{25pt}+\setheaderspaces{1cm}{*}{*}++\checkandfixthelayout[classic]++\usepackage{graphicx,grffile}++\usepackage{longtable}++\setlength{\emergencystretch}{3em} % prevent overfull lines++\usepackage[hidelinks]{hyperref}++%+% Get rid of default headers and put page number in footer.+%++\makeoddfoot{plain}{}{}{\tiny\textsf{\thepage/\thelastpage}}+\makeevenfoot{plain}{\tiny\textsf{\thepage/\thelastpage}}{}{}++\makeoddhead{plain}{}{}{}+\makeevenhead{plain}{}{}{}++\pagestyle{plain}++\SingleSpacing+\nonzeroparskip+\setlength{\parindent}{0em}++%+% Customize the section heading fonts to use this accordingly.+%++\chapterstyle{article}+\setsecnumdepth{none}++% FIXME Why isn't the \Huge font size command working?+\renewcommand{\chaptitlefont}{\Large\sffamily\bfseries}++\setsecheadstyle{\large\sffamily}+\setsubsecheadstyle{\normalsize\sffamily\bfseries}+\setsubsubsecheadstyle{\normalsize\rmfamily\itshape}++\begin{document}+|]++ending :: Rope+ending = [quote|+\end{document}+|]
+ src/NotifyChanges.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++module NotifyChanges+(+ waitForChange+)+where++import Core.Program+import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)+import qualified Data.ByteString.Char8 as C (ByteString, pack)+import Data.Foldable (foldr, foldrM)+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet (empty, insert, member)+import System.FilePath.Posix (dropFileName)+import System.INotify (EventVariety(..), Event(..), withINotify+ , addWatch, removeWatch)++{-+Ideally we'd just set up inotifies on individual files we have manifested+from the .book file, but that doesn't work when programs like vim move the+original file, save a new one, then delete the renamed original. From+previous work we know that CLOSE_WRITE is emitted reliably through these+sequences, so we can just check to see if a that happens on a filename we+care about (rather then the original inodes those files were stored in).++Insert a 100ms pause before rebuilding to allow whatever the editor+was to finish its write and switcheroo sequence.+-}+waitForChange :: [FilePath] -> Program t ()+waitForChange files =+ let+ f :: FilePath -> HashSet C.ByteString -> HashSet C.ByteString+ f path acc = HashSet.insert (C.pack path) acc++ g :: FilePath -> HashSet C.ByteString -> HashSet C.ByteString+ g path acc = HashSet.insert (C.pack (dropFileName path)) acc+ in do+ event "Watching for changes"++ let paths = foldr f HashSet.empty files+ let dirs = foldr g HashSet.empty files++ withContext $ \runProgram -> do+ block <- newEmptyMVar+ withINotify $ \notify -> do+ -- setup inotifies+ watches <- foldrM (\dir acc -> do+ runProgram (debugS "watching" dir)+ watch <- addWatch notify [CloseWrite] dir (\trigger ->+ case trigger of+ Closed _ (Just file) _ -> do+ let path = if dir == "./"+ then file+ else dir <> file+ runProgram (debugS "changed" path)+ if HashSet.member path paths+ then do+ runProgram (debugS "trigger" path)+ putMVar block False+ else+ return ()+ _ -> return ())+ return (watch:acc)) [] dirs++ -- wait+ _ <- readMVar block++ -- cleanup+ mapM_ removeWatch watches++ sleep 0.1+
+ src/OutputParser.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module OutputParser+ ( parseOutputForError+ )+where++import Core.Text+import qualified Data.ByteString.Lazy.Char8 as L++{-+The build command returned a non-zero exit code, so there is a+reasonable assumption that there is indeed an error to be extracted.+-}+-- Originally written in lazy ByteString as that is output from readProcess+parseOutputForError :: FilePath -> Rope -> Rope+parseOutputForError tmpdir =+ let+ needle = L.pack tmpdir++ stripBeginning [] = []+ stripBeginning (b:bs) = if L.isPrefixOf needle b+ then b : bs+ else stripBeginning bs++ dropEnding [] = []+ dropEnding (b:bs) = if L.isPrefixOf "Output written on" b || "No pages of output." == b+ then []+ else b : dropEnding bs+ in+ intoRope . L.intercalate "\n" . dropEnding . stripBeginning . L.lines . fromRope+++-- Error stream from xelatex looks like this:+{-+/tmp/publish-Km3eN1/Junk.tex:8: Undefined control sequence.+l.8 \broken+ +No pages of output.+Transcript written on /tmp/publish-Km3eN1/Junk.log+-}
+ src/RenderDocument.hs view
@@ -0,0 +1,416 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module RenderDocument+ ( program+ )+where++import Control.Monad (filterM, forM_, forever, void)+import Core.Program+import Core.System+import Core.Text+import Data.Char (isSpace)+import qualified Data.List as List (dropWhileEnd)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Directory (doesFileExist, doesDirectoryExist+ , copyFileWithMetadata)+import System.Exit (ExitCode(..))+import System.FilePath.Posix (takeBaseName, takeExtension+ , replaceExtension, splitFileName, replaceDirectory)+import System.IO (withFile, IOMode(WriteMode), hPutStrLn)+import System.IO.Error (userError, IOError)+import System.Posix.Directory (changeWorkingDirectory)+import System.Posix.Temp (mkdtemp)+import System.Posix.User (getEffectiveUserID, getEffectiveGroupID)+import Text.Pandoc (runIOorExplode, readMarkdown, writeLaTeX, def+ , readerExtensions, pandocExtensions, writerTopLevelDivision+ , TopLevelDivision(TopLevelChapter))++import Environment (Env(..))+import NotifyChanges (waitForChange)+import LatexPreamble (preamble, ending)+import OutputParser (parseOutputForError)+import Utilities (ensureDirectory, execProcess, ifNewer, isNewer)++data Mode = Once | Cycle++program :: Program Env ()+program = do+ params <- getCommandLine+ mode <- extractMode params++ event "Identify .book file"+ bookfile <- extractBookFile params++ case mode of+ Once -> do+ -- normal operation, single pass+ void (renderDocument mode bookfile)+ Cycle -> do+ -- use inotify to rebuild on changes+ forever (renderDocument mode bookfile >>= waitForChange)+++renderDocument :: Mode -> FilePath -> Program Env [FilePath]+renderDocument mode bookfile = do+ event "Read .book file"+ files <- processBookFile bookfile++ event "Setup temporary directory"+ setupTargetFile bookfile++ event "Convert document fragments to LaTeX"+ mapM_ processFragment files++ event "Write intermediate LaTeX file"+ produceResult++ event "Render document to PDF"+ catch+ (do+ renderPDF+ copyHere+ )+ (\(e :: ExitCode) -> case mode of+ Once -> throw e+ Cycle -> return ()+ )++ return (bookfile:files)+++extractMode :: Parameters -> Program Env Mode+extractMode params =+ let+ mode = case lookupOptionFlag "watch" params of+ Just False -> error "Invalid State"+ Just True -> Cycle+ Nothing -> Once+ in+ return mode++{-+For the situation where the .book file is in a location other than '.'+then chdir there first, so any relative paths within _it_ are handled+properly, as are inotify watches later if they are employed.+-}+extractBookFile :: Parameters -> Program Env FilePath+extractBookFile params =+ let+ (relative,bookfile) = case lookupArgument "bookfile" params of+ Nothing -> error "invalid"+ Just file -> splitFileName file+ in do+ debugS "relative" relative+ debugS "bookfile" bookfile+ probe <- liftIO $ do+ changeWorkingDirectory relative+ doesFileExist bookfile+ case probe of+ True -> return bookfile+ False -> do+ write ("error: specified .book file \"" <> intoRope bookfile <> "\" not found.")+ throw (userError "no such file")+++setupTargetFile :: FilePath -> Program Env ()+setupTargetFile book = do+ env <- getApplicationState+ let start = startingDirectoryFrom env+ let dotfile = start ++ "/.target"++ tmpdir <- liftIO $ catch+ (do+ dir' <- readFile dotfile+ let dir = trim dir'+ probe <- doesDirectoryExist dir+ if probe+ then return dir+ else throw boom+ )+ (\(_ :: IOError) -> do+ dir <- mkdtemp "/tmp/publish-"+ writeFile dotfile (dir ++ "\n")+ return dir+ )+ debugS "tmpdir" tmpdir++ let master = tmpdir ++ "/" ++ base ++ ".tex"+ result = tmpdir ++ "/" ++ base ++ ".pdf"++ params <- getCommandLine+ first <- case lookupOptionFlag "builtin-preamble" params of+ Nothing -> return []+ Just True -> do+ let name = "00_Beginning.latex"+ let target = tmpdir ++ "/" ++ name+ liftIO $ withFile target WriteMode $ \handle -> do+ hWrite handle preamble+ return [name]+ Just _ -> invalid++ let env' = env+ { intermediateFilenamesFrom = first+ , masterFilenameFrom = master+ , resultFilenameFrom = result+ , tempDirectoryFrom = tmpdir+ }+ setApplicationState env'+ where+ base = takeBaseName book -- "/directory/file.ext" -> "file"++ boom = userError "Temp dir no longer present"++ trim :: String -> String+ trim = List.dropWhileEnd isSpace+++processBookFile :: FilePath -> Program Env [FilePath]+processBookFile file = do+ contents <- liftIO (T.readFile file)+ list <- filterM skipNotFound (possibilities contents)+ debugS "fragments" (length list)+ return list+ where+ -- filter out blank lines and lines commented out+ possibilities :: Text -> [FilePath]+ possibilities = map T.unpack . filter (not . T.null)+ . filter (not . T.isPrefixOf "#") . T.lines++ skipNotFound :: FilePath -> Program t Bool+ skipNotFound fragment = do+ probe <- liftIO (doesFileExist fragment)+ case probe of+ True -> return True+ False -> do+ write ("warning: Fragment \"" <> intoRope fragment <> "\" not found, skipping")+ return False++{-+Which kind of file is it? Dispatch to the appropriate reader switching on+filename extension.+-}+processFragment :: FilePath -> Program Env ()+processFragment file = do+ debugS "source" file++ -- Read the fragment, process it if Markdown then run it out to LaTeX.+ case takeExtension file of+ ".markdown" -> convertMarkdown file+ ".latex" -> passthroughLaTeX file+ ".svg" -> convertImage file+ _ -> passthroughImage file++{-+Convert Markdown to LaTeX. This is where we "call" Pandoc.++Default behaviour from the command line is to activate all (?) of Pandoc's+Markdown extensions, but invoking via the `readMarkdown` function with+default ReaderOptions doesn't turn any on. Using `pandocExtensions` here+appears to represent the whole set.++When output format is LaTeX, the command-line _pandoc_ tool does some+somewhat convoluted heuristics to decide whether top-level headings (ie+<H1>, ====, #) are to be considered \part, \chapter, or \section. The fact+that is not deterministic is annoying. Force the issue.++Finally, for some reason, the Markdown -> LaTeX pair strips trailing+whitespace from the block, resulting in a no paragraph boundary between+files. So gratuitously add a break.+-}+convertMarkdown :: FilePath -> Program Env ()+convertMarkdown file =+ let+ readingOptions = def { readerExtensions = pandocExtensions }++ writingOptions = def { writerTopLevelDivision = TopLevelChapter }++ in do+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ file' = replaceExtension file ".latex"+ target = tmpdir ++ "/" ++ file'+ files = intermediateFilenamesFrom env++ ensureDirectory target+ ifNewer file target $ do+ debugS "target" target+ liftIO $ do+ contents <- T.readFile file++ latex <- runIOorExplode $ do+ parsed <- readMarkdown readingOptions contents+ writeLaTeX writingOptions parsed++ withFile target WriteMode $ \handle -> do+ T.hPutStrLn handle latex+ T.hPutStr handle "\n"++ let env' = env { intermediateFilenamesFrom = file':files }+ setApplicationState env'++{-+If a source fragment is already LaTeX, simply copy it through to+the target file.+-}+passthroughLaTeX :: FilePath -> Program Env ()+passthroughLaTeX file = do+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ target = tmpdir ++ "/" ++ file+ files = intermediateFilenamesFrom env++ ensureDirectory target+ ifNewer file target $ do+ debugS "target" target+ liftIO $ do+ copyFileWithMetadata file target++ let env' = env { intermediateFilenamesFrom = file:files }+ setApplicationState env'++{-+Images in SVG format need to be converted to PDF to be able to be+included in the output as LaTeX doesn't understand SVG natively, which+is slightly shocking.+-}+convertImage :: FilePath -> Program Env ()+convertImage file = do+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ target = tmpdir ++ "/" ++ replaceExtension file ".pdf"++ rsvgConvert =+ [ "rsvg-convert"+ , "--format=pdf"+ , "--output=" ++ target+ , file+ ]++ ifNewer file target $ do+ debugS "target" target+ (exit,out,err) <- do+ ensureDirectory target+ execProcess rsvgConvert++ case exit of+ ExitFailure _ -> do+ event "Image processing failed"+ debug "stderr" (intoRope err)+ debug "stdout" (intoRope out)+ throw exit+ ExitSuccess -> return ()++passthroughImage :: FilePath -> Program Env ()+passthroughImage file = do+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ target = tmpdir ++ "/" ++ file++ ensureDirectory target+ ifNewer file target $ do+ debugS "target" target+ liftIO $ do+ copyFileWithMetadata file target++{-+Finish up by writing the intermediate "master" file.+-}+produceResult :: Program Env ()+produceResult = do+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ master = masterFilenameFrom env+ files = intermediateFilenamesFrom env++ params <- getCommandLine+ files' <- case lookupOptionFlag "builtin-preamble" params of+ Nothing -> return files+ Just True -> do+ let name = "ZZ_Ending.latex"+ let target = tmpdir ++ "/" ++ name+ liftIO $ withFile target WriteMode $ \handle -> do+ hWrite handle ending+ return (name:files)+ Just _ -> invalid++ debugS "master" master+ liftIO $ withFile master WriteMode $ \handle -> do+ hPutStrLn handle ("\\RequirePackage{import}")+ forM_ (reverse files') $ \file -> do+ let (path,name) = splitFileName file+ hPutStrLn handle ("\\subimport{" ++ path ++ "}{" ++ name ++ "}")++getUserID :: Program a String+getUserID = liftIO $ do+ uid <- getEffectiveUserID+ gid <- getEffectiveGroupID+ return (show uid ++ ":" ++ show gid)++renderPDF :: Program Env ()+renderPDF = do+ env <- getApplicationState++ let master = masterFilenameFrom env+ tmpdir = tempDirectoryFrom env++ user <- getUserID++ params <- getCommandLine+ let command = case lookupOptionValue "docker" params of+ Just image ->+ [ "docker"+ , "run"+ , "--rm=true"+ , "--volume=" ++ tmpdir ++ ":" ++ tmpdir+ , "--user=" ++ user+ , image+ , "latexmk"+ ]+ Nothing ->+ [ "latexmk"+ ]++ options =+ [ "-xelatex"+ , "-output-directory=" ++ tmpdir+ , "-interaction=nonstopmode"+ , "-halt-on-error"+ , "-file-line-error"+ , "-cd"+ , master+ ]++ latexmk = command ++ options++ (exit,out,err) <- execProcess latexmk+ case exit of+ ExitFailure _ -> do+ event "Render failed"+ debug "stderr" (intoRope err)+ debug "stdout" (intoRope out)+ write (parseOutputForError tmpdir out)+ throw exit+ ExitSuccess -> return ()++copyHere :: Program Env ()+copyHere = do+ env <- getApplicationState+ let result = resultFilenameFrom env+ start = startingDirectoryFrom env+ final = replaceDirectory result start -- ie ./Book.pdf++ changed <- isNewer result final+ case changed of+ True -> do+ event "Copy resultant PDF to starting directory"+ debugS "result" result+ debugS "final" final+ liftIO $ do+ copyFileWithMetadata result final+ event "Complete"+ False -> do+ event "Result unchanged"
+ src/RenderMain.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Core.Program+import Core.Text++import RenderDocument (program)+import Environment (initial)++version :: Version+version = $(fromPackage)++main :: IO ()+main = do+ env <- initial+ context <- configure version env (simple+ [ Option "builtin-preamble" (Just 'p') Empty [quote|+ Wrap a built-in LaTeX preamble (and ending) around your+ supplied source fragments. Most documents will put their own+ custom preamble as the first fragment in the .book file, but+ for getting started a suitable default can be employed via this+ option.+ |]+ , Option "watch" Nothing Empty [quote|+ Watch all sources listed in the bookfile and re-run the+ rendering engine if changes are detected.+ |]+ , Option "docker" Nothing (Value "IMAGE") [quote|+ Run the specified Docker image in a container, mount the target+ directory into it as a volume, and do the build there. This allows+ you to have all of the LaTeX dependencies separate from the machine+ you are editing on.+ |]+ , Argument "bookfile" [quote|+ The file containing the list of fragments making up this book.+ If the argument is specified as "Hobbit.book" then "Hobbit"+ will be used as the basename for the intermediate .latex file+ and the final output .pdf file. The list file should contain+ filenames, one per line, of the fragments you wish to render+ into a complete document.+ |]+ ])++ executeWith context program
+ src/Utilities.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}++module Utilities+ ( ensureDirectory+ , execProcess+ , ifNewer+ , isNewer+ )+where++import Chrono.Compat (convertToUTC)+import Control.Monad (when)+import Core.Program+import Core.System+import Core.Text+import qualified Data.List as List (intercalate)+import System.Directory (doesDirectoryExist, doesFileExist, createDirectory+ , getModificationTime, copyFileWithMetadata)+import System.Exit (ExitCode(..))+import System.FilePath.Posix (takeDirectory)+import System.Process.Typed (proc, readProcess, setStdin, closed)++{-+Some source files live in subdirectories. Replicate that directory+structure in the temporary build space+-}+ensureDirectory :: FilePath -> Program t ()+ensureDirectory target =+ let+ subdir = takeDirectory target+ in liftIO $ do+ probe <- doesDirectoryExist subdir+ when (not probe) $ do+ createDirectory subdir++{-+Thin wrapper around **typed-process**'s `readProcess` so that the command+to be executed can be logged. Bit of an annoyance that the command and the+arguments have to be specified to `proc` separately, but that's _execvp(3)_+for you.++TODO this could potentially move to the **unbeliever** library+-}+execProcess :: [String] -> Program t (ExitCode, Rope, Rope)+execProcess [] = error "No command provided"+execProcess (cmd:args) =+ let+ task = proc cmd args+ task' = setStdin closed task+ command = List.intercalate " " (cmd:args)+ in do+ debugS "command" command++ (exit, out, err) <- liftIO $ do+ readProcess task'++ return (exit, intoRope out, intoRope err)++{-|+If the source file is newer than the target file, then run an action. For+example, if you want to install a file but only do so if the file has been+rebuilt, then you could do this:++@+copyFileIfNewer :: 'FilePath' -> 'FilePath' -> 'Program' τ ()+copyFileIfNewer source target = do+ 'ifNewer' source target $ do+ 'liftIO' ('copyFileWithMetadata' source target)+@++This is basically a build system in a box, although the usual caveats+about the brittleness of timestamps apply.++TODO this could potentially move to the **unbeliever** library+-}+ifNewer :: FilePath -> FilePath -> Program t () -> Program t ()+ifNewer source target program = do+ changed <- isNewer source target+ when changed $ do+ program++isNewer :: FilePath -> FilePath -> Program t Bool+isNewer source target = liftIO $ do+ time1 <- getModificationTime source+ time2 <- doesFileExist target >>= \case+ True -> getModificationTime target+ False -> return (convertToUTC 0) -- the epoch+ return (time1 > time2)