diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -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. diff --git a/publish.cabal b/publish.cabal new file mode 100644 --- /dev/null +++ b/publish.cabal @@ -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 + + on GitHub. + . + The main program, @render@, is available via a Docker image at + +category: Text +stability: experimental +author: Andrew Cowie +maintainer: Andrew Cowie +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 diff --git a/src/Environment.hs b/src/Environment.hs new file mode 100644 --- /dev/null +++ b/src/Environment.hs @@ -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") + diff --git a/src/FormatDocument.hs b/src/FormatDocument.hs new file mode 100644 --- /dev/null +++ b/src/FormatDocument.hs @@ -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' + diff --git a/src/FormatMain.hs b/src/FormatMain.hs new file mode 100644 --- /dev/null +++ b/src/FormatMain.hs @@ -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 diff --git a/src/LatexPreamble.hs b/src/LatexPreamble.hs new file mode 100644 --- /dev/null +++ b/src/LatexPreamble.hs @@ -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} +|] diff --git a/src/NotifyChanges.hs b/src/NotifyChanges.hs new file mode 100644 --- /dev/null +++ b/src/NotifyChanges.hs @@ -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 + diff --git a/src/OutputParser.hs b/src/OutputParser.hs new file mode 100644 --- /dev/null +++ b/src/OutputParser.hs @@ -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 +-} diff --git a/src/RenderDocument.hs b/src/RenderDocument.hs new file mode 100644 --- /dev/null +++ b/src/RenderDocument.hs @@ -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 +

, ====, #) 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" diff --git a/src/RenderMain.hs b/src/RenderMain.hs new file mode 100644 --- /dev/null +++ b/src/RenderMain.hs @@ -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 diff --git a/src/Utilities.hs b/src/Utilities.hs new file mode 100644 --- /dev/null +++ b/src/Utilities.hs @@ -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)