publish 2.2.3 → 2.5.3
raw patch · 7 files changed
+257/−243 lines, 7 filesdep +core-telemetrydep +safe-exceptionsdep ~core-program
Dependencies added: core-telemetry, safe-exceptions
Dependency ranges changed: core-program
Files
- publish.cabal +14/−10
- src/FormatDocument.hs +7/−12
- src/PandocToMarkdown.hs +4/−3
- src/RenderDocument.hs +222/−185
- src/RenderMain.hs +4/−1
- src/Utilities.hs +0/−27
- tests/TestSuite.hs +6/−5
publish.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack------ hash: bdc6778c7664e65e93e74b73702eef01ef70d5f056eaeca667c9ff73a6e095bd name: publish-version: 2.2.3+version: 2.5.3 synopsis: Publishing tools for papers, books, and presentations description: Tools for rendering markdown-centric documents into PDFs. There are two programs:@@ -26,12 +24,12 @@ bug-reports: https://github.com/aesiniath/publish/issues author: Andrew Cowie <istathar@gmail.com> maintainer: Andrew Cowie <istathar@gmail.com>-copyright: © 2016-2021 Athae Eredh Siniath and Others+copyright: © 2016-2023 Athae Eredh Siniath and Others license: MIT license-file: LICENSE-tested-with:- GHC == 8.10.7 build-type: Simple+tested-with:+ GHC == 9.2.5 source-repository head type: git@@ -50,7 +48,8 @@ , bytestring , chronologique , core-data- , core-program >=0.2.12+ , core-program >=0.6.5+ , core-telemetry >=0.2.7 , core-text >=0.3.4 , deepseq , directory@@ -58,6 +57,7 @@ , megaparsec , pandoc >=2.11 , pandoc-types >=1.22+ , safe-exceptions , template-haskell , text , typed-process@@ -83,7 +83,8 @@ , bytestring , chronologique , core-data- , core-program >=0.2.12+ , core-program >=0.6.5+ , core-telemetry >=0.2.7 , core-text >=0.3.4 , deepseq , directory@@ -91,6 +92,7 @@ , megaparsec , pandoc >=2.11 , pandoc-types >=1.22+ , safe-exceptions , template-haskell , text , typed-process@@ -118,7 +120,8 @@ , bytestring , chronologique , core-data- , core-program >=0.2.12+ , core-program >=0.6.5+ , core-telemetry >=0.2.7 , core-text >=0.3.4 , deepseq , directory@@ -127,6 +130,7 @@ , megaparsec , pandoc >=2.11 , pandoc-types >=1.22+ , safe-exceptions , template-haskell , text , typed-process
src/FormatDocument.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -41,12 +42,8 @@ getFragmentName :: Program None FilePath getFragmentName = do- params <- getCommandLine-- let fragment = case lookupArgument "document" params of- Nothing -> error "invalid"- Just file -> file- return fragment+ fragment <- queryArgument "document"+ pure (fromRope fragment) loadFragment :: FilePath -> Program None Pandoc loadFragment file =@@ -83,12 +80,10 @@ let contents' = pandocToMarkdown doc result = file ++ "~tmp" in do- params <- getCommandLine-- let mode = case lookupOptionFlag "inplace" params of- Just False -> error "Invalid State"- Just True -> Inplace- Nothing -> Console+ mode <-+ queryOptionFlag "inplace" >>= \case+ True -> pure Inplace+ False -> pure Console case mode of Inplace -> liftIO $ do
src/PandocToMarkdown.hs view
@@ -9,6 +9,7 @@ tableToMarkdown, ) where +import qualified Control.Exception.Safe as Safe (impureThrow) import Core.System.Base import Core.Text import Data.Foldable (foldl')@@ -275,7 +276,7 @@ headerToMarkdown :: TableHead -> Rope headerToMarkdown (TableHead _ [row]) = rowToMarkdown row- headerToMarkdown _ = impureThrow (NotSafe "What do we do with this TableHead?")+ headerToMarkdown _ = Safe.impureThrow (NotSafe "What do we do with this TableHead?") columnToMarkdown :: (Alignment, ColWidth) -> Rope columnToMarkdown (align, col) =@@ -317,13 +318,13 @@ cellToMarkdown (Cell _ _ (RowSpan 1) (ColSpan 1) [block]) = convert block cellToMarkdown _ =- impureThrow (NotSafe "Multiple Blocks encountered")+ Safe.impureThrow (NotSafe "Multiple Blocks encountered") convert :: Block -> Rope convert (Plain inlines) = plaintextToMarkdown 100000 inlines convert _ =- impureThrow (NotSafe "Incorrect Block type encountered")+ Safe.impureThrow (NotSafe "Incorrect Block type encountered") data NotSafe = NotSafe String deriving (Show)
src/RenderDocument.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -6,15 +8,16 @@ program, ) where +import Control.Exception.Safe qualified as Safe import Control.Monad (filterM, forM_, forever, void) import Core.Data import Core.Program import Core.System+import Core.Telemetry import Core.Text import Data.Char (isSpace)-import qualified Data.List as List (dropWhileEnd, null)-import Data.Maybe (isJust)-import qualified Data.Text.IO as T+import Data.List qualified as List (dropWhileEnd, null)+import Data.Text.IO qualified as T import Environment (Bookfile (..), Env (..)) import LatexOutputReader (parseOutputForError) import LatexPreamble (beginning, ending, preamble)@@ -50,7 +53,7 @@ writeLaTeX, writerTopLevelDivision, )-import Utilities (ensureDirectory, execProcess, ifNewer, isNewer)+import Utilities (ensureDirectory, ifNewer, isNewer) data Mode = Once | Cycle @@ -58,11 +61,10 @@ program :: Program Env () program = do- params <- getCommandLine- (mode, copy) <- extractMode params+ (mode, copy) <- extractMode info "Identify .book file"- bookfile <- extractBookFile params+ bookfile <- extractBookFile case mode of Once -> do@@ -74,47 +76,59 @@ renderDocument :: (Mode, Copy) -> FilePath -> Program Env [FilePath] renderDocument (mode, copy) file = do- info "Read .book file"- book <- processBookFile file+ setServiceName "render"+ beginTrace $ do+ encloseSpan "Render document" $ do+ telemetry+ [ metric "bookfile" file+ ] - info "Setup temporary directory"- setupTargetFile file- setupPreambleFile- validatePreamble book+ book <- encloseSpan "Setup" $ do+ info "Read .book file"+ book <- processBookFile file - let preambles = preamblesFrom book- let fragments = fragmentsFrom book- let trailers = trailersFrom book+ info "Setup temporary directory"+ setupTargetFile file+ setupPreambleFile+ validatePreamble book - info "Convert preamble fragments and begin marker to LaTeX"- mapM_ processFragment preambles- setupBeginningFile+ pure book - info "Convert document fragments to LaTeX"- mapM_ processFragment fragments+ let preambles = preamblesFrom book+ let fragments = fragmentsFrom book+ let trailers = trailersFrom book - info "Convert end marker and trailing fragments to LaTeX"- setupEndingFile- mapM_ processFragment trailers+ encloseSpan "Convert fragments" $ do+ info "Convert preamble fragments and begin marker to LaTeX"+ mapM_ processFragment preambles+ setupBeginningFile - info "Write intermediate LaTeX file"- produceResult+ info "Convert document fragments to LaTeX"+ mapM_ processFragment fragments - info "Render document to PDF"- catch- ( do- renderPDF- case copy of- InstallPdf -> copyHere- NoCopyPdf -> return ()- )- ( \(e :: ExitCode) -> case mode of- Once -> throw e- Cycle -> return ()- )+ info "Convert end marker and trailing fragments to LaTeX"+ setupEndingFile+ mapM_ processFragment trailers - return (uniqueList file preambles fragments trailers)+ info "Write intermediate LaTeX file"+ produceResult + encloseSpan "Render LaTeX to PDF" $ do+ info "Render document to PDF"+ catch+ ( do+ renderPDF+ case copy of+ InstallPdf -> copyHere+ NoCopyPdf -> return ()+ )+ ( \(e :: ExitCode) -> case mode of+ Once -> throw e+ Cycle -> return ()+ )++ pure (uniqueList file preambles fragments trailers)+ -- -- Quickly reduce the fragment names to a unique list so we don't waste -- inotify watches.@@ -124,69 +138,70 @@ let files = insertElement file (intoSet trailers <> (intoSet preambles <> intoSet fragments)) in fromSet files -extractMode :: Parameters -> Program Env (Mode, Copy)-extractMode params =- let mode = case lookupOptionFlag "watch" params of- Just False -> error "Invalid State"- Just True -> Cycle- Nothing -> Once- copy = case lookupOptionFlag "no-copy" params of- Just False -> error "Invalid State"- Just True -> NoCopyPdf- Nothing -> InstallPdf- in return (mode, copy)+extractMode :: Program Env (Mode, Copy)+extractMode = do+ mode <-+ queryOptionFlag "watch" >>= \case+ True -> pure Cycle+ False -> pure Once + copy <-+ queryOptionFlag "no-copy" >>= \case+ True -> pure NoCopyPdf+ False -> pure InstallPdf++ pure (mode, copy)+ {- 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")+extractBookFile :: Program Env FilePath+extractBookFile = do+ file <- queryArgument "bookfile"+ let (relative, bookfile) = splitFileName (fromRope file) + 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 file = do env <- getApplicationState let start = startingDirectoryFrom env let dotfile = start ++ "/.target" - params <- getCommandLine- tmpdir <- case lookupOptionValue "temp" params of- Just dir -> do- -- Append a slash so that /tmp/booga is taken as a directory.- -- Otherwise, you end up ensuring /tmp exists.- ensureDirectory (dir ++ "/")- return dir- Nothing ->- 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- )+ tmpdir <-+ queryOptionValue "temp" >>= \case+ Just dir -> do+ -- Append a slash so that /tmp/booga is taken as a directory.+ -- Otherwise, you end up ensuring /tmp exists.+ ensureDirectory (fromRope dir ++ "/")+ return (fromRope dir)+ Nothing ->+ liftIO $+ Safe.catch+ ( do+ dir' <- readFile dotfile+ let dir = trim dir'+ probe <- doesDirectoryExist dir+ if probe+ then return dir+ else Safe.throw boom+ )+ ( \(_ :: IOError) -> do+ dir <- mkdtemp "/tmp/publish-"+ writeFile dotfile (dir ++ "\n")+ return dir+ ) debugS "tmpdir" tmpdir let master = tmpdir ++ "/" ++ base ++ ".tex"@@ -211,17 +226,16 @@ env <- getApplicationState let tmpdir = tempDirectoryFrom env - params <- getCommandLine- first <- case lookupOptionFlag "builtin-preamble" params of- Nothing -> return []- Just True -> do- let name = "00_Preamble.latex"- let target = tmpdir ++ "/" ++ name- liftIO $- withFile target WriteMode $ \handle -> do- hWrite handle preamble- return [name]- Just _ -> invalid+ first <-+ queryOptionFlag "builtin-preamble" >>= \case+ False -> return []+ True -> do+ let name = "00_Preamble.latex"+ let target = tmpdir ++ "/" ++ name+ liftIO $+ withFile target WriteMode $ \handle -> do+ hWrite handle preamble+ return [name] let env' = env{intermediateFilenamesFrom = first} setApplicationState env'@@ -233,10 +247,10 @@ -} validatePreamble :: Bookfile -> Program Env () validatePreamble book = do- params <- getCommandLine let preambles = preamblesFrom book- let builtin = isJust (lookupOptionFlag "builtin-preamble" params) + builtin <- queryOptionFlag "builtin-preamble"+ if List.null preambles && not builtin then do write "error: no preamble\n"@@ -363,48 +377,57 @@ { writerTopLevelDivision = TopLevelSection } in do- env <- getApplicationState- let tmpdir = tempDirectoryFrom env- file' = replaceExtension file ".latex"- target = tmpdir ++ "/" ++ file'- files = intermediateFilenamesFrom env+ encloseSpan "convertMarkdown" $ 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+ 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+ latex <- runIOorExplode $ do+ parsed <- readMarkdown readingOptions contents+ writeLaTeX writingOptions parsed - withFile target WriteMode $ \handle -> do- T.hPutStrLn handle latex- T.hPutStr handle "\n"+ withFile target WriteMode $ \handle -> do+ T.hPutStrLn handle latex+ T.hPutStr handle "\n" - let env' = env{intermediateFilenamesFrom = file' : files}- setApplicationState env'+ let env' = env{intermediateFilenamesFrom = file' : files}+ setApplicationState env' + telemetry+ [ metric "file" file+ ]+ {- 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+ encloseSpan "passthroughLaTeX" $ 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+ ensureDirectory target+ ifNewer file target $ do+ debugS "target" target+ liftIO $ do+ copyFileWithMetadata file target - let env' = env{intermediateFilenamesFrom = file : files}- setApplicationState env'+ let env' = env{intermediateFilenamesFrom = file : files}+ setApplicationState env'+ telemetry+ [ metric "file" file+ ] {- Images in SVG format need to be converted to PDF to be able to be@@ -413,45 +436,53 @@ -} convertImage :: FilePath -> Program Env () convertImage file = do- env <- getApplicationState- let tmpdir = tempDirectoryFrom env- basepath = dropExtension file- target = tmpdir ++ "/" ++ basepath ++ ".pdf"- buffer = tmpdir ++ "/" ++ basepath ++ "~tmp.pdf"- inkscape =- [ "inkscape"- , "--export-type=pdf"- , "--export-filename=" ++ buffer- , file+ encloseSpan "convertImage" $ do+ telemetry+ [ metric "file" file ]+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ basepath = dropExtension file+ target = tmpdir ++ "/" ++ basepath ++ ".pdf"+ buffer = tmpdir ++ "/" ++ basepath ++ "~tmp.pdf"+ inkscape =+ [ "inkscape"+ , "--export-type=pdf"+ , "--export-filename=" ++ buffer+ , file+ ] - ifNewer file target $ do- debugS "target" target- (exit, out, err) <- do- ensureDirectory target- execProcess inkscape+ ifNewer file target $ do+ debugS "target" target+ (exit, out, err) <- do+ ensureDirectory target+ readProcess (fmap intoRope inkscape) - case exit of- ExitFailure _ -> do- info "Image processing failed"- debug "stderr" (intoRope err)- debug "stdout" (intoRope out)- write ("error: Unable to convert " <> intoRope file <> " from SVG to PDF")- throw exit- ExitSuccess -> liftIO $ do- renameFile buffer target+ case exit of+ ExitFailure _ -> do+ info "Image processing failed"+ debug "stderr" (intoRope err)+ debug "stdout" (intoRope out)+ write ("error: Unable to convert " <> intoRope file <> " from SVG to PDF")+ throw exit+ ExitSuccess -> liftIO $ do+ renameFile buffer target passthroughImage :: FilePath -> Program Env () passthroughImage file = do- env <- getApplicationState- let tmpdir = tempDirectoryFrom env- target = tmpdir ++ "/" ++ file+ encloseSpan "passthroughImage" $ do+ telemetry+ [ metric "file" file+ ]+ env <- getApplicationState+ let tmpdir = tempDirectoryFrom env+ target = tmpdir ++ "/" ++ file - ensureDirectory target- ifNewer file target $ do- debugS "target" target- liftIO $ do- copyFileWithMetadata file target+ ensureDirectory target+ ifNewer file target $ do+ debugS "target" target+ liftIO $ do+ copyFileWithMetadata file target {- Finish up by writing the intermediate "master" file.@@ -470,38 +501,40 @@ let (path, name) = splitFileName file hPutStrLn handle ("\\subimport{" ++ path ++ "}{" ++ name ++ "}") -getUserID :: Program a String+getUserID :: Program a Rope getUserID = liftIO $ do uid <- getEffectiveUserID gid <- getEffectiveGroupID- return (show uid ++ ":" ++ show gid)+ return (intoRope (show uid ++ ":" ++ show gid)) renderPDF :: Program Env () renderPDF = do env <- getApplicationState - let master = masterFilenameFrom env- tmpdir = tempDirectoryFrom env+ let master = intoRope (masterFilenameFrom env)+ tmpdir = intoRope (tempDirectoryFrom env) user <- getUserID - params <- getCommandLine- let command = case lookupOptionValue "docker" params of+ command <-+ queryOptionValue "docker" >>= \case Just image ->- [ "docker"- , "run"- , "--rm=true"- , "--volume=" ++ tmpdir ++ ":" ++ tmpdir- , "--user=" ++ user- , image- , "latexmk"- ]+ pure+ [ "docker"+ , "run"+ , "--rm=true"+ , "--volume=" <> tmpdir <> ":" <> tmpdir+ , "--user=" <> user+ , intoRope image+ , "latexmk"+ ] Nothing ->- [ "latexmk"- ]- options =+ pure+ [ "latexmk"+ ]+ let options = [ "-lualatex"- , "-output-directory=" ++ tmpdir+ , "-output-directory=" <> tmpdir , "-interaction=nonstopmode" , "-halt-on-error" , "-file-line-error"@@ -510,13 +543,13 @@ ] latexmk = command ++ options - (exit, out, err) <- execProcess latexmk+ (exit, out, err) <- readProcess latexmk case exit of ExitFailure _ -> do info "Render failed"- debug "stderr" (intoRope err)- debug "stdout" (intoRope out)- write (parseOutputForError tmpdir out)+ debug "stderr" err+ debug "stdout" out+ write (parseOutputForError (fromRope tmpdir) out) throw exit ExitSuccess -> return () @@ -537,3 +570,7 @@ info "Complete" False -> do info "Result unchanged"++ telemetry+ [ metric "changed" changed+ ]
src/RenderMain.hs view
@@ -6,6 +6,7 @@ module Main where import Core.Program+import Core.Telemetry import Core.Text import Environment (initial) import RenderDocument (program)@@ -83,4 +84,6 @@ ] ) - executeWith context program+ context' <- initializeTelemetry [consoleExporter, structuredExporter, honeycombExporter] context++ executeWith context' program
src/Utilities.hs view
@@ -4,7 +4,6 @@ module Utilities ( ensureDirectory,- execProcess, ifNewer, isNewer, ) where@@ -13,17 +12,13 @@ import Control.Monad (when) import Core.Program import Core.System-import Core.Text-import qualified Data.List as List (intercalate) import System.Directory ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getModificationTime, )-import System.Exit (ExitCode (..)) import System.FilePath.Posix (takeDirectory)-import System.Process.Typed (closed, proc, readProcess, setStdin) {- Some source files live in subdirectories. Replicate that directory@@ -36,28 +31,6 @@ probe <- doesDirectoryExist subdir when (not probe) $ do createDirectoryIfMissing True 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
tests/TestSuite.hs view
@@ -1,17 +1,18 @@+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} import CheckBookfileParser import CheckTableProperties import CompareFragments-import Core.System+import Control.Exception.Safe qualified as Safe import Test.Hspec main :: IO () main = do- finally (hspec suite) (putStrLn ".")+ Safe.finally (hspec suite) (putStrLn ".") suite :: Spec suite = do- checkTableProperties- checkByComparingFragments- checkBookfileParser+ checkTableProperties+ checkByComparingFragments+ checkBookfileParser