document-build-0.1.0.0: src/Document/Build/Rules.hs
{-# OPTIONS_GHC -Wall #-}
{- | Rules: named build steps, made from the commands of
"Document.Build.Operations", that say which files are made from which.
Each rule takes its settings as arguments: the directories, extensions,
formats, sizes and names of its files. None has a default, so a build file
says what it builds:
@
'Document.Build.Context.onPaths' (isWithin "src") ('prepareRules' ["md"] 'Document.Build.Project.filePlaceholders' "src")
\<> 'markdownRules' (flip replaceExtension) [("pdf", pure ["--standalone"])]
\<> 'pageCountRules' (\<> ".pages")
@
The rules in this module define no actions of their own: each wraps a
command of "Document.Build.Operations" in a named step with
'Document.Build.Context.buildStep', and says which files it applies to. A
rule excludes the files that it makes itself, by their trail (see
'Document.Build.Context.afterStep' and
'Document.Build.Context.unlessAfterStep'), so that it never runs on its own
outputs. A rule that would, by mistake, is stopped with a
'System.FilePather.Trail.Cycle' before it runs again.
The step names that rules use, such as @prepare@ and @pdf page 1@, are given
in their documentation, so that a build file can choose files by the step
that made them.
-}
module Document.Build.Rules (
-- * Preparing
prepareRules,
assetRules,
fontRules,
-- * Converting
libreofficeRules,
libreofficeCounterpartRules,
pandocHtmlRules,
markdownRules,
-- * Joining
bookRules,
imageJoinRules,
mergePdf,
-- * Pages
pageCountRules,
pageOneRules,
pdfPageImageRules,
splitPdf,
-- * Images
imageRules,
-- * Checking
requirePlaceholders,
-- * Completing
archiveRules,
outputTreeRules,
) where
import Control.Lens (preview, (^.))
import Control.Monad (void)
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Class (lift)
import Data.Bool (bool)
import Data.Char (isDigit)
import Data.List (isPrefixOf, sort, stripPrefix)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Document.Build.Build (Build', Command', io)
import Document.Build.Context
import Document.Build.File (copyTo, filesIn, tarGz, writeUtf8)
import Document.Build.Image (imageAppend, imageConvert, imageConvertFirstFrame)
import Document.Build.LibreOffice (flatExtension, libreoffice, libreofficeOutput, zippedExtension)
import Document.Build.Output (describeForest, edgeForest, outputForestHtml, writeOutputForest)
import Document.Build.Pandoc (pandoc)
import Document.Build.Pdf (pdfConcatenate, pdfFirstPage, pdfPageCountFile, pdfSplit, pdfToImages, pdftk)
import Document.Build.Project (Placeholders, prepareFile)
import Document.Build.Replace (requireStrings)
import System.Directory (doesFileExist, listDirectory)
import System.FilePath (equalFilePath, makeRelative, normalise, takeDirectory, takeExtension, takeFileName, (</>))
import System.FilePather.Combinators (hasExtension, isFile, isWithin, onFile)
import System.FilePather.Tracked (Tracked, askTrail, onPath, whenPath)
import System.FilePather.Trail (Step (..), lastStep)
{- | Prepare the files of a directory at the same path relative to the output
directory (step @prepare@): replace placeholders in the files with one of the
text extensions, and copy the others. The placeholders are a command, run on
each text file, such as 'Document.Build.Project.filePlaceholders'.
@since 0.1.0.0
-}
prepareRules :: [String] -> Command' Placeholders -> FilePath -> Rules
prepareRules =
prepareWith "prepare"
{-# INLINE prepareRules #-}
{- | Prepare the files of a directory of assets, which are not converted, as
'prepareRules' does (step @prepare asset@).
@since 0.1.0.0
-}
assetRules :: [String] -> Command' Placeholders -> FilePath -> Rules
assetRules =
prepareWith "prepare asset"
{-# INLINE assetRules #-}
prepareWith :: String -> [String] -> Command' Placeholders -> FilePath -> Rules
prepareWith n text placeholders d =
onFiles . onSources $ \c ->
let out = c ^. contextDirectories . outputDirectory
in whenPath (isWithin d) . buildStep n (\p -> [out </> makeRelative d p]) $
ask >>= void . prepareFile text placeholders . (out </>) . makeRelative d
{- | Copy the files of a directory, such as a directory of fonts, to the
output directory, keeping the directory: @fonts/a.ttf@ is copied to
@public/fonts/a.ttf@ (step @copy font@).
@since 0.1.0.0
-}
fontRules :: FilePath -> Rules
fontRules d =
onFiles . onSources $ \c ->
let out = c ^. contextDirectories . outputDirectory
in whenPath (isWithin d) . buildStep "copy font" (\p -> [out </> p]) $
ask >>= void . copyTo . (out </>)
{- | Convert each prepared LibreOffice file with one of a set of extensions to
each of its formats, next to the file (steps such as @libreoffice pdf@). For
example:
@
libreofficeRules [(["fodt", "odt"], ["pdf", "docx"]), (["fods", "ods"], ["pdf", "xlsx"])]
@
@since 0.1.0.0
-}
libreofficeRules :: [([String], [String])] -> Rules
libreofficeRules conversions =
onFiles . onOutputs . afterStep (== "prepare") . fromTracked $
foldMap
(\(exts, fmts) -> whenPath (hasExtension exts) (foldMap (\fmt -> libreofficeStep ("libreoffice " <> fmt) fmt) fmts))
conversions
{- | Convert each prepared flat LibreOffice file, such as @.fodt@, to its
zipped form, such as @.odt@ (step @libreoffice zipped@), and each zipped file
to its flat form (step @libreoffice flat@).
@since 0.1.0.0
-}
libreofficeCounterpartRules :: Rules
libreofficeCounterpartRules =
onFiles . onOutputs . afterStep (== "prepare") . fromTracked $
do
p <- ask
let ext = drop 1 (takeExtension p)
foldMap (libreofficeStep "libreoffice zipped") (zippedExtension ext)
<> foldMap (libreofficeStep "libreoffice flat") (flatExtension ext)
-- | A step that converts a file with LibreOffice, next to the file.
libreofficeStep :: String -> String -> Tracked Build' ()
libreofficeStep n fmt =
buildStep n (\p -> [libreofficeOutput fmt (takeDirectory p) p]) $
ask >>= void . libreoffice fmt . takeDirectory
{- | Convert each LibreOffice text document with one of the extensions to
standalone HTML with pandoc (step @pandoc html@), named by a function of the
document, with more pandoc options, such as styles. The options are a
command, run on the document. pandoc reads zipped OpenDocument text, so it
reads a prepared @.odt@ file, or the @.odt@ file made from a prepared @.fodt@
file by 'libreofficeCounterpartRules'.
@since 0.1.0.0
-}
pandocHtmlRules :: [String] -> (FilePath -> FilePath) -> Command' [String] -> Rules
pandocHtmlRules exts name opts =
onFiles . onOutputs . onPaths (hasExtension ["odt"]) . fromTracked $
do
t <- askTrail
p <- ask
let source =
case preview lastStep t of
Just (Step "prepare" _) -> Just p
Just (Step "libreoffice zipped" i) -> Just i
_ -> Nothing
foldMap
( \s ->
bool
mempty
( buildStep "pandoc html" (const [name s]) $
do
o <- opts
void (pandoc (["-f", "odt", "-t", "html5", "--standalone", "--embed-resources", "--strip-comments", "-M", "pagetitle=" <> takeFileName s] <> o) (name s))
)
(hasExtension exts s)
)
source
{- | Convert each prepared markdown file to each format, named by a function
of the format and the file, with pandoc options (steps such as
@pandoc pdf@). The options are a command, run on the markdown file. For
example:
@
markdownRules (flip replaceExtension) [("pdf", pure ("--standalone" : 'Document.Build.Pandoc.xelatex')), ("html", pure ["--standalone"])]
@
@since 0.1.0.0
-}
markdownRules :: (String -> FilePath -> FilePath) -> [(String, Command' [String])] -> Rules
markdownRules name conversions =
onFiles . onOutputs . afterStep (== "prepare") . onPaths (hasExtension ["md"]) . fromTracked $
foldMap
( \(ext, opts) ->
buildStep ("pandoc " <> ext) (\p -> [name ext p]) $
do
p <- ask
o <- opts
void (pandoc o (name ext p))
)
conversions
{- | Concatenate the parts of each book in a directory of the output directory
(step @book@): @name-part.pdf@, for each part in order, into @name.pdf@, once
every part exists. The book is made from its first part. For example, with
the parts @["front", "body", "back"]@, @report-front.pdf@,
@report-body.pdf@ and @report-back.pdf@ are concatenated into @report.pdf@.
@since 0.1.0.0
-}
bookRules :: [String] -> Rules
bookRules parts =
onDirectories . onOutputs . fromTracked $
case parts of
[] -> mempty
first : _ ->
do
d <- ask
names <- lift (namesIn d)
foldMap
( \name ->
let files = fmap (\part -> name <> "-" <> part <> ".pdf") parts
o = d </> name <> ".pdf"
in whenReady (fmap (d </>) files) o $
onPath (d </> name <> "-" <> first <> ".pdf") (buildStep "book" (const [o]) (void (onFile d (pdfConcatenate files o))))
)
(mapMaybe (stripSuffix ("-" <> first <> ".pdf")) names)
{- | Join images in a directory of the output directory side by side (step
@join images@): for each name, @name-N.png@, for each digit @N@ in order, into
@name.png@. The joined image is made from the first.
@since 0.1.0.0
-}
imageJoinRules :: [String] -> Rules
imageJoinRules prefixes =
onDirectories . onOutputs . fromTracked $
do
d <- ask
names <- lift (namesIn d)
foldMap
( \prefix ->
let isPart n =
case stripPrefix (prefix <> "-") n of
Just [x, '.', 'p', 'n', 'g'] -> isDigit x
_ -> False
o = d </> prefix <> ".png"
in case filter isPart names of
[] -> mempty
files@(first : _) ->
whenReady (fmap (d </>) files) o $
onPath (d </> first) (buildStep "join images" (const [o]) (void (onFile d (imageAppend files o))))
)
prefixes
{- | Merge pages from several PDF files into one, with @pdftk@ (step
@pdf merge@), once every input file exists: the input files, each with a
@pdftk@ handle such as @"A"@; the page ranges, such as
@["A1-16", "B1", "A18-end"]@; and the output file. The file paths are
relative to the output directory. The output is made from the first input
file.
@since 0.1.0.0
-}
mergePdf :: [(String, FilePath)] -> [String] -> FilePath -> Rules
mergePdf inputs ranges o =
onDirectories $ \c ->
let out = c ^. contextDirectories . outputDirectory
in case inputs of
[] -> mempty
(_, first) : _ ->
whenPath (isFile out) . whenReady (fmap ((out </>) . snd) inputs) (out </> o) $
onPath (out </> first) $
buildStep "pdf merge" (const [out </> o]) (void (onFile out (pdftk (fmap (\(h, f) -> h <> "=" <> f) inputs <> ["cat"]) ranges (out </> o))))
{- | Write the page count of every PDF file to a file named by a function of
the PDF file (step @page count@).
@since 0.1.0.0
-}
pageCountRules :: (FilePath -> FilePath) -> Rules
pageCountRules name =
onFiles . onOutputs . onPaths (hasExtension ["pdf"]) . fromTracked $
buildStep "page count" (pure . name) (ask >>= void . pdfPageCountFile . name)
{- | Extract the first page of every PDF file to a PDF file named by a function
of the PDF file (step @pdf page 1@), and convert that to an image named by a
function of it, in the format of its extension (step @page 1 image@).
@since 0.1.0.0
-}
pageOneRules :: (FilePath -> FilePath) -> (FilePath -> FilePath) -> Rules
pageOneRules page1 image =
onFiles . onOutputs . onPaths (hasExtension ["pdf"]) $
unlessAfterStep (== "pdf page 1") (fromTracked (buildStep "pdf page 1" (pure . page1) (ask >>= void . pdfFirstPage . page1)))
<> afterStep (== "pdf page 1") (fromTracked (buildStep "page 1 image" (pure . image) (ask >>= void . imageConvert . image)))
{- | Convert each page of every PDF file to an image (step @pdf page images@),
with @convert@ options, named by a function of the PDF file before the images
are numbered (see 'Document.Build.Pdf.pdfToImages'). For example, for the
PDF files of one project:
@
'Document.Build.Context.onProject' "group/project" (pdfPageImageRules ["-density", "180"] (\`replaceExtension\` "png"))
@
@since 0.1.0.0
-}
pdfPageImageRules :: [String] -> (FilePath -> FilePath) -> Rules
pdfPageImageRules opts name =
onFiles . onOutputs . onPaths (hasExtension ["pdf"]) . fromTracked $
buildStep' "pdf page images" (ask >>= pdfToImages opts . name)
{- | Split a PDF file into several files (step @pdf split@), given by a
@pdftk@ page range and a file for each. The file paths are relative to the
output directory. For example:
@
splitPdf "report.pdf" [("1", "report_cover.pdf"), ("2-end", "report_body.pdf")]
@
@since 0.1.0.0
-}
splitPdf :: FilePath -> [(String, FilePath)] -> Rules
splitPdf pdf sections =
onFiles $ \c ->
let out = c ^. contextDirectories . outputDirectory
sections' = fmap (fmap (out </>)) sections
in whenPath (isFile (out </> pdf)) (buildStep "pdf split" (const (fmap snd sections')) (void (pdfSplit sections')))
{- | Convert every image with one of the extensions to each of the formats,
named by a function of the format and the image (steps such as
@image jpg@), and resize it to fit squares of each of the sizes, named by a
function of the size and the converted image (steps such as
@image png 250@): in its own format if that is one of the formats, and
otherwise the first of them. Images made by these steps are not converted
again. For example:
@
imageRules ["png", "jpg", "svg"] ["png", "jpg"] [800, 250] (flip replaceExtension) (\\n p -> dropExtension p <> "-" <> show n <> takeExtension p)
@
@since 0.1.0.0
-}
imageRules :: [String] -> [String] -> [Int] -> (String -> FilePath -> FilePath) -> (Int -> FilePath -> FilePath) -> Rules
imageRules exts formats sizes converted resized =
onFiles . onOutputs . unlessAfterStep (isPrefixOf "image ") . onPaths (hasExtension exts) . fromTracked $
do
p <- ask
let ext = (\e -> bool e "jpg" (e == "jpeg")) (drop 1 (takeExtension p))
sized = bool (take 1 formats) [ext] (ext `elem` formats)
convertedTo f = converted f p
resizedTo n f = resized n (convertedTo f)
foldMap
(\f -> buildStep ("image " <> f) (const [convertedTo f]) (void (imageConvertFirstFrame [] (convertedTo f))))
(filter (/= ext) formats)
<> foldMap
(\(n, f) -> buildStep ("image " <> f <> " " <> show n) (const [resizedTo n f]) (void (imageConvertFirstFrame ["-resize", show n <> "x" <> show n] (resizedTo n f))))
[(n, f) | f <- sized, n <- sizes]
{- | Fail unless every file of the input directories that these rules apply
to contains each of the placeholders, by name without @${@ and @}@ (step
@require placeholders@). Choose the files with
'Document.Build.Context.onPaths'.
@since 0.1.0.0
-}
requirePlaceholders :: [String] -> Rules
requirePlaceholders names =
onFiles . onSources . fromTracked $
buildStep "require placeholders" (const []) (requireStrings (fmap (\n -> "${" <> n <> "}") names))
{- | When the build is complete, archive the files the build made in the output
directory that satisfy a predicate, in a @.tar.gz@ file, relative to the
output directory (step @archive@).
@since 0.1.0.0
-}
archiveRules :: (FilePath -> Bool) -> FilePath -> Rules
archiveRules select name =
onComplete $ \known c ->
let out = c ^. contextDirectories . outputDirectory
files = ["." </> makeRelative out p | p <- Map.keys known, isWithin out p, select p]
in buildStep "archive" (const [out </> name]) (void (tarGz files (out </> name)))
{- | When the build is complete, write the tree of output files to a JSON file
and an HTML page, relative to the output directory, with a title (step
@output tree@): each file of the input directories is a root, and each file
is a child of the input file of the step that made it. A file made from a
directory, and a file in the output directory that no step made, such as one
made by rules before these when the build is complete, is a root. The title
is a command, run on the output directory.
@since 0.1.0.0
-}
outputTreeRules :: FilePath -> FilePath -> Command' String -> Rules
outputTreeRules json html title =
onComplete $ \known c ->
let out = c ^. contextDirectories . outputDirectory
json' = out </> json
html' = out </> html
edges =
[ (i, [o])
| (o, t) <- Map.toList known
, Step _ i <- maybe [] pure (preview lastStep t)
, Map.member (normalise i) known
]
in buildStep "output tree" (const [json', html']) $
do
t <- title
lift $
do
untracked <- filter (\f -> not (any (equalFilePath f) [json', html'])) <$> filesIn out
forest <- describeForest (edgeForest edges (Map.keys known <> untracked))
_ <- writeOutputForest json' forest
void (writeUtf8 html' (outputForestHtml out t forest))
{- | Run when every input file exists and the output file does not, and
otherwise make nothing. A step that makes a file from several files runs
once, when they all exist.
-}
whenReady :: [FilePath] -> FilePath -> Tracked Build' () -> Tracked Build' ()
whenReady inputs o x =
lift (io (((&&) . and <$> traverse doesFileExist inputs) <*> (not <$> doesFileExist o)))
>>= bool mempty x
-- | The names of the entries of a directory, in sorted order.
namesIn :: FilePath -> Build' [FilePath]
namesIn d =
io (sort <$> listDirectory d)
-- | Remove a suffix from a list, if it ends with it.
stripSuffix :: String -> String -> Maybe String
stripSuffix s x =
reverse <$> stripPrefix (reverse s) (reverse x)