Data.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifdef EMBED_DATA_FILES
{-# LANGUAGE TemplateHaskell #-}
#endif
{- |
Module      : Text.Pandoc.Data
Copyright   : Copyright (C) 2013-2024 John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : John MacFarlane <jgm@berkeley@edu>
Stability   : alpha
Portability : portable

Access to pandoc's data files.
-}
module Text.Pandoc.Data ( readDefaultDataFile
                        , readDataFile
                        , getDataFileNames
                        , defaultUserDataDir
                        ) where
import Text.Pandoc.Class (PandocMonad(..), getDataDirs, getTimestamp,
                          getPOSIXTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B
import Codec.Archive.Zip
import Data.List (sort)
import qualified Data.Text as T
import Control.Monad.Except (throwError)
import Text.Pandoc.Error (PandocError(..))
import System.FilePath
import System.Directory
import qualified Control.Exception as E
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data.BakedIn (dataFiles)
import Text.Pandoc.Shared (makeCanonical)
#else
import Paths_pandoc (getDataDir)
#endif

-- | Read file from the default data files, ignoring the user data
-- directory and @PANDOC_DATA_DIRS@.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile fname =
  case buildReferenceDoc readDefaultDataFile fname of
    Just getArchive -> archiveToByteString <$> getArchive
    Nothing -> readDefaultDataFile' fname

-- | If the file is a reference document, returns an action that builds
-- it from its component files, which are read using the supplied function.
buildReferenceDoc :: PandocMonad m
                  => (FilePath -> m B.ByteString) -> FilePath
                  -> Maybe (m Archive)
buildReferenceDoc readComponent fname =
  case fname of
    "reference.docx" -> Just $ getDefaultReferenceDocx readComponent
    "reference.pptx" -> Just $ getDefaultReferencePptx readComponent
    "reference.odt"  -> Just $ getDefaultReferenceODT readComponent
    _                -> Nothing

archiveToByteString :: Archive -> B.ByteString
archiveToByteString = B.concat . BL.toChunks . fromArchive

readDefaultDataFile' :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile' fname =
#ifdef EMBED_DATA_FILES
  case lookup (makeCanonical fname) dataFiles of
    Nothing       -> throwError $ PandocCouldNotFindDataFileError $ T.pack fname
    Just contents -> return contents
#else
  getDataFileName fname' >>= checkExistence >>= readFileStrict
    where fname' = if fname == "MANUAL.txt" then fname else "data" </> fname

-- | Returns the input filename unchanged if the file exits, and throws
-- a `PandocCouldNotFindDataFileError` if it doesn't.
checkExistence :: PandocMonad m => FilePath -> m FilePath
checkExistence fn = do
  exists <- fileExists fn
  if exists
     then return fn
     else throwError $ PandocCouldNotFindDataFileError $ T.pack fn
#endif

--- | Read file from user data directory or, if not found there,
--- from one of the directories listed in @PANDOC_DATA_DIRS@,
--- or, if not found there, from the default
--- data files.  If a reference document (e.g. @reference.docx@)
--- is not found, it is built from component files (e.g.
--- @docx/word/styles.xml@), which are looked up in the same way.
readDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDataFile fname = getDataDirs fname >>= go
 where
  go [] = case buildReferenceDoc readDataFile fname of
            Just getArchive -> archiveToByteString <$> getArchive
            Nothing -> readDefaultDataFile' fname
  go (d:ds) = do
    exists <- fileExists (d </> fname)
    if exists
       then readFileStrict (d </> fname)
       else go ds

-- | Retrieve default reference.docx.
getDefaultReferenceDocx :: PandocMonad m
                        => (FilePath -> m B.ByteString) -> m Archive
getDefaultReferenceDocx readComponent = do
  let paths = ["[Content_Types].xml",
               "_rels/.rels",
               "docProps/app.xml",
               "docProps/core.xml",
               "docProps/custom.xml",
               "word/document.xml",
               "word/fontTable.xml",
               "word/footnotes.xml",
               "word/comments.xml",
               "word/numbering.xml",
               "word/settings.xml",
               "word/webSettings.xml",
               "word/styles.xml",
               "word/_rels/document.xml.rels",
               "word/_rels/footnotes.xml.rels",
               "word/theme/theme1.xml"]
  let toLazy = BL.fromChunks . (:[])
  let pathToEntry path = do
        epochtime <- floor . utcTimeToPOSIXSeconds <$> getTimestamp
        contents <- toLazy <$> readComponent ("docx/" ++ path)
        return $ toEntry path epochtime contents
  foldr addEntryToArchive emptyArchive <$> mapM pathToEntry paths

-- | Retrieve default reference.odt.
getDefaultReferenceODT :: PandocMonad m
                        => (FilePath -> m B.ByteString) -> m Archive
getDefaultReferenceODT readComponent = do
  let paths = ["mimetype",
               "manifest.rdf",
               "styles.xml",
               "content.xml",
               "meta.xml",
               "META-INF/manifest.xml"]
  let pathToEntry path = do epochtime <- floor `fmap` getPOSIXTime
                            contents <- (BL.fromChunks . (:[])) `fmap`
                                          readComponent ("odt/" ++ path)
                            return $ toEntry path epochtime contents
  foldr addEntryToArchive emptyArchive <$> mapM pathToEntry paths

-- | Retrieve default reference.pptx.
getDefaultReferencePptx :: PandocMonad m
                        => (FilePath -> m B.ByteString) -> m Archive
getDefaultReferencePptx readComponent = do
  -- We're going to narrow this down substantially once we get it
  -- working.
  let paths = [ "[Content_Types].xml"
              , "_rels/.rels"
              , "docProps/app.xml"
              , "docProps/core.xml"
              , "ppt/_rels/presentation.xml.rels"
              , "ppt/presProps.xml"
              , "ppt/presentation.xml"
              , "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout2.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout3.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout4.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout5.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout6.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout7.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout8.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout9.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout10.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout11.xml.rels"
              , "ppt/slideLayouts/slideLayout1.xml"
              , "ppt/slideLayouts/slideLayout10.xml"
              , "ppt/slideLayouts/slideLayout11.xml"
              , "ppt/slideLayouts/slideLayout2.xml"
              , "ppt/slideLayouts/slideLayout3.xml"
              , "ppt/slideLayouts/slideLayout4.xml"
              , "ppt/slideLayouts/slideLayout5.xml"
              , "ppt/slideLayouts/slideLayout6.xml"
              , "ppt/slideLayouts/slideLayout7.xml"
              , "ppt/slideLayouts/slideLayout8.xml"
              , "ppt/slideLayouts/slideLayout9.xml"
              , "ppt/slideMasters/_rels/slideMaster1.xml.rels"
              , "ppt/slideMasters/slideMaster1.xml"
              , "ppt/slides/_rels/slide1.xml.rels"
              , "ppt/slides/slide1.xml"
              , "ppt/slides/_rels/slide2.xml.rels"
              , "ppt/slides/slide2.xml"
              , "ppt/slides/_rels/slide3.xml.rels"
              , "ppt/slides/slide3.xml"
              , "ppt/slides/_rels/slide4.xml.rels"
              , "ppt/slides/slide4.xml"
              , "ppt/tableStyles.xml"
              , "ppt/theme/theme1.xml"
              , "ppt/viewProps.xml"
              -- These relate to notes slides.
              , "ppt/notesMasters/notesMaster1.xml"
              , "ppt/notesMasters/_rels/notesMaster1.xml.rels"
              , "ppt/notesSlides/notesSlide1.xml"
              , "ppt/notesSlides/_rels/notesSlide1.xml.rels"
              , "ppt/notesSlides/notesSlide2.xml"
              , "ppt/notesSlides/_rels/notesSlide2.xml.rels"
              , "ppt/theme/theme2.xml"
              ]
  let toLazy = BL.fromChunks . (:[])
  let pathToEntry path = do
        epochtime <- floor <$> getPOSIXTime
        contents <- toLazy <$> readComponent ("pptx/" ++ path)
        return $ toEntry path epochtime contents
  foldr addEntryToArchive emptyArchive <$> mapM pathToEntry paths

getDataFileNames :: IO [FilePath]
getDataFileNames = do
#ifdef EMBED_DATA_FILES
  let allDataFiles = map fst dataFiles
#else
  let listDirectoryRecursive d = do
        xs <- listDirectory d
        concat <$>
           mapM (\f -> do
                      isdir <- doesDirectoryExist (d </> f)
                      if isdir
                         then map (f </>) <$> listDirectoryRecursive (d </> f)
                         else pure [f]) xs
  ddir <- getDataDir
  allDataFiles <- ("MANUAL.txt" :) <$>
                     listDirectoryRecursive (ddir </> "data")
#endif
  return $ sort $
    "reference.docx" : "reference.odt" : "reference.pptx" : allDataFiles

-- | Return appropriate user data directory for platform.  We use
-- XDG_DATA_HOME (or its default value), but for backwards compatibility,
-- we fall back to the legacy user data directory ($HOME/.pandoc on *nix)
-- if the XDG_DATA_HOME is missing and this exists.  If neither directory
-- is present, we return the XDG data directory.  If the XDG data directory
-- is not defined (e.g. because we are in an environment where $HOME is
-- not defined), we return the empty string.
defaultUserDataDir :: IO FilePath
defaultUserDataDir = do
  xdgDir <- E.catch (getXdgDirectory XdgData "pandoc")
               (\(_ :: E.SomeException) -> return mempty)
  xdgExists <- doesDirectoryExist xdgDir
  legacyDir <- E.catch (getAppUserDataDirectory "pandoc")
                (\(_ :: E.SomeException) -> return mempty)
  legacyDirExists <- doesDirectoryExist legacyDir
  if not xdgExists && legacyDirExists
     then return legacyDir
     else return xdgDir