LibreOffice.hs

{-# OPTIONS_GHC -Wall #-}

{- | Commands that operate on LibreOffice files, and other files that
LibreOffice can open, such as @.docx@.

These run @soffice@ with a LibreOffice profile of their own, in the temporary
directory. Without it, a conversion does nothing when LibreOffice is already
open.
-}
module Document.Build.LibreOffice (
  -- * Conversion
  libreoffice,
  libreofficeOutput,
  libreofficeToPdf,
  libreofficeToHtml,
  libreofficeToDocx,
  libreofficeToOdt,
  libreofficeFlat,
  libreofficeZipped,
  flatExtension,
  zippedExtension,

  -- * Information
  libreofficePages,
  docxPages,
) where

import Control.Lens (view, _Wrapped)
import Control.Monad.Trans.Class (lift)
import Data.Bool (bool)
import Document.Build.Build (Build, Command, expectOutput, failBuild, io, process, requireInput, withTempDirectory)
import Document.Build.Error (BuildError (..), CommandLine (..), ReviewBuildError)
import Document.Build.Pdf (pdfPages)
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, makeAbsolute, removePathForcibly)
import System.FilePath (equalFilePath, takeBaseName, takeExtension, (<.>), (</>))
import System.FilePather.Combinators ((~>))

{- | Convert the file being operated on with @soffice --convert-to@, into a
directory, and return the file path of the result.

The format is any that @--convert-to@ accepts, such as @"pdf"@, @"html"@,
@"docx"@, @"png"@ or @"txt:Text"@. The output file is named after the input
file, with the extension before any @:@ in the format. LibreOffice exits
successfully even when a conversion fails, so the build fails with
'OutputFileMissing' if the output file is not produced.

@since 0.1.0.0
-}
libreoffice :: (ReviewBuildError e) => String -> FilePath -> Command e FilePath
libreoffice fmt d =
  do
    i <- requireInput
    lift $
      do
        p <- libreofficeProfile
        let o = libreofficeOutput fmt d i
            c = CommandLine "soffice" ["-env:UserInstallation=" <> p, "--invisible", "--headless", "--convert-to", fmt, "--outdir", d, i]
        io (createDirectoryIfMissing True d)
        -- Remove the output of an earlier build, so that a conversion that
        -- fails is not mistaken for one that succeeds.
        io (bool (removePathForcibly o) (pure ()) (equalFilePath i o))
        _ <- process c
        expectOutput c o

{- | The file that 'libreoffice' converts a file to, given the format, the
output directory and the input file.

>>> libreofficeOutput "txt:Text" "public" "src/report.fodt"
"public/report.txt"

@since 0.1.0.0
-}
libreofficeOutput :: String -> FilePath -> FilePath -> FilePath
libreofficeOutput fmt d i =
  d </> takeBaseName i <.> takeWhile (/= ':') fmt

-- | The URL of the LibreOffice profile that 'libreoffice' uses.
libreofficeProfile :: Build e String
libreofficeProfile =
  io (fmap ("file://" <>) (getTemporaryDirectory >>= makeAbsolute . (</> "document-build-libreoffice")))

{- | Convert the file being operated on to PDF, into a directory. See
'libreoffice'.

@since 0.1.0.0
-}
libreofficeToPdf :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeToPdf =
  libreoffice "pdf"
{-# INLINE libreofficeToPdf #-}

{- | Convert the file being operated on to HTML, into a directory. See
'libreoffice'.

@since 0.1.0.0
-}
libreofficeToHtml :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeToHtml =
  libreoffice "html"
{-# INLINE libreofficeToHtml #-}

{- | Convert the file being operated on to Word, into a directory. See
'libreoffice'.

@since 0.1.0.0
-}
libreofficeToDocx :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeToDocx =
  libreoffice "docx"
{-# INLINE libreofficeToDocx #-}

{- | Convert the file being operated on to OpenDocument text, into a
directory. See 'libreoffice'.

@since 0.1.0.0
-}
libreofficeToOdt :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeToOdt =
  libreoffice "odt"
{-# INLINE libreofficeToOdt #-}

{- | The extension of the flat (XML) form of a zipped OpenDocument extension.

>>> flatExtension "odt"
Just "fodt"

>>> flatExtension "docx"
Nothing

@since 0.1.0.0
-}
flatExtension :: String -> Maybe String
flatExtension =
  flip lookup [("odt", "fodt"), ("ods", "fods"), ("odp", "fodp"), ("odg", "fodg")]

{- | The extension of the zipped form of a flat (XML) OpenDocument extension.

>>> zippedExtension "fods"
Just "ods"

@since 0.1.0.0
-}
zippedExtension :: String -> Maybe String
zippedExtension =
  flip lookup [("fodt", "odt"), ("fods", "ods"), ("fodp", "odp"), ("fodg", "odg")]

convertExtension :: (ReviewBuildError e) => (String -> Maybe String) -> [String] -> FilePath -> Command e FilePath
convertExtension f supported d =
  do
    i <- requireInput
    maybe
      (lift (failBuild (FileTypeUnsupported i supported)))
      (`libreoffice` d)
      (f (drop 1 (takeExtension i)))

{- | Convert the zipped OpenDocument file being operated on (@.odt@, @.ods@,
@.odp@ or @.odg@) to its flat form (@.fodt@, @.fods@, @.fodp@ or @.fodg@),
into a directory. Fails with 'FileTypeUnsupported' for other files.

@since 0.1.0.0
-}
libreofficeFlat :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeFlat =
  convertExtension flatExtension ["odt", "ods", "odp", "odg"]
{-# INLINE libreofficeFlat #-}

{- | Convert the flat OpenDocument file being operated on (@.fodt@, @.fods@,
@.fodp@ or @.fodg@) to its zipped form (@.odt@, @.ods@, @.odp@ or @.odg@),
into a directory. Fails with 'FileTypeUnsupported' for other files.

@since 0.1.0.0
-}
libreofficeZipped :: (ReviewBuildError e) => FilePath -> Command e FilePath
libreofficeZipped =
  convertExtension zippedExtension ["fodt", "fods", "fodp", "fodg"]
{-# INLINE libreofficeZipped #-}

{- | The number of pages in the file being operated on, as laid out by
LibreOffice. The file is converted to PDF in a temporary directory.

@since 0.1.0.0
-}
libreofficePages :: (ReviewBuildError e) => Command e Int
libreofficePages =
  do
    i <- requireInput
    lift (withTempDirectory "libreoffice-pages" (\d -> view _Wrapped (libreofficeToPdf d ~> pdfPages) i))

{- | The number of pages in the Word file being operated on. See
'libreofficePages'.

@since 0.1.0.0
-}
docxPages :: (ReviewBuildError e) => Command e Int
docxPages =
  libreofficePages
{-# INLINE docxPages #-}