{-# 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(..), checkUserDataDir, getTimestamp,
                          getUserDataDir, 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 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.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
"reference.docx" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> [ByteString]
BL.toChunks (LazyByteString -> [ByteString])
-> (Archive -> LazyByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> LazyByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceDocx
readDefaultDataFile [Char]
"reference.pptx" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> [ByteString]
BL.toChunks (LazyByteString -> [ByteString])
-> (Archive -> LazyByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> LazyByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferencePptx
readDefaultDataFile [Char]
"reference.odt" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> [ByteString]
BL.toChunks (LazyByteString -> [ByteString])
-> (Archive -> LazyByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> LazyByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT
readDefaultDataFile [Char]
fname =
#ifdef EMBED_DATA_FILES
  case lookup (makeCanonical fname) dataFiles of
    Nothing       -> throwError $ PandocCouldNotFindDataFileError $ T.pack fname
    Just contents -> return contents
#else
  [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName [Char]
fname' m [Char] -> ([Char] -> m [Char]) -> m [Char]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
checkExistence m [Char] -> ([Char] -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
    where fname' :: [Char]
fname' = if [Char]
fname [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"MANUAL.txt" then [Char]
fname else [Char]
"data" [Char] -> [Char] -> [Char]
</> [Char]
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 :: forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
checkExistence [Char]
fn = do
  exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists [Char]
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 the default data files.
readDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile [Char]
fname = do
  datadir <- [Char] -> m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => [Char] -> m (Maybe [Char])
checkUserDataDir [Char]
fname
  case datadir of
       Maybe [Char]
Nothing -> [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
fname
       Just [Char]
userDir -> do
         exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
userDir [Char] -> [Char] -> [Char]
</> [Char]
fname)
         if exists
            then readFileStrict (userDir </> fname)
            else readDefaultDataFile fname

-- | Retrieve default reference.docx.
getDefaultReferenceDocx :: PandocMonad m => m Archive
getDefaultReferenceDocx :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceDocx = do
  let paths :: [[Char]]
paths = [[Char]
"[Content_Types].xml",
               [Char]
"_rels/.rels",
               [Char]
"docProps/app.xml",
               [Char]
"docProps/core.xml",
               [Char]
"docProps/custom.xml",
               [Char]
"word/document.xml",
               [Char]
"word/fontTable.xml",
               [Char]
"word/footnotes.xml",
               [Char]
"word/comments.xml",
               [Char]
"word/numbering.xml",
               [Char]
"word/settings.xml",
               [Char]
"word/webSettings.xml",
               [Char]
"word/styles.xml",
               [Char]
"word/_rels/document.xml.rels",
               [Char]
"word/_rels/footnotes.xml.rels",
               [Char]
"word/theme/theme1.xml"]
  let toLazy :: ByteString -> LazyByteString
toLazy = [ByteString] -> LazyByteString
BL.fromChunks ([ByteString] -> LazyByteString)
-> (ByteString -> [ByteString]) -> ByteString -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
  let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do
        epochtime <- NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Integer)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds (UTCTime -> Integer) -> m UTCTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
        contents <- toLazy <$> readDataFile ("docx/" ++ path)
        return $ toEntry path epochtime contents
  datadir <- m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
  mbArchive <- case datadir of
                    Maybe [Char]
Nothing   -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                    Just [Char]
d    -> do
                       exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.docx")
                       if exists
                          then return (Just (d </> "reference.docx"))
                          else return Nothing
  case mbArchive of
     Just [Char]
arch -> LazyByteString -> Archive
toArchive (LazyByteString -> Archive) -> m LazyByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m LazyByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m LazyByteString
readFileLazy [Char]
arch
     Maybe [Char]
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     ([Char] -> m Entry) -> [[Char]] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> m Entry
forall {m :: * -> *}. PandocMonad m => [Char] -> m Entry
pathToEntry [[Char]]
paths

-- | Retrieve default reference.odt.
getDefaultReferenceODT :: PandocMonad m => m Archive
getDefaultReferenceODT :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT = do
  let paths :: [[Char]]
paths = [[Char]
"mimetype",
               [Char]
"manifest.rdf",
               [Char]
"styles.xml",
               [Char]
"content.xml",
               [Char]
"meta.xml",
               [Char]
"META-INF/manifest.xml"]
  let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do epochtime <- NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Integer) -> m NominalDiffTime -> m Integer
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m NominalDiffTime
forall (m :: * -> *). PandocMonad m => m NominalDiffTime
getPOSIXTime
                            contents <- (BL.fromChunks . (:[])) `fmap`
                                          readDataFile ("odt/" ++ path)
                            return $ toEntry path epochtime contents
  datadir <- m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
  mbArchive <- case datadir of
                    Maybe [Char]
Nothing   -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                    Just [Char]
d    -> do
                       exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.odt")
                       if exists
                          then return (Just (d </> "reference.odt"))
                          else return Nothing
  case mbArchive of
     Just [Char]
arch -> LazyByteString -> Archive
toArchive (LazyByteString -> Archive) -> m LazyByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m LazyByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m LazyByteString
readFileLazy [Char]
arch
     Maybe [Char]
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     ([Char] -> m Entry) -> [[Char]] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> m Entry
forall {m :: * -> *}. PandocMonad m => [Char] -> m Entry
pathToEntry [[Char]]
paths

-- | Retrieve default reference.pptx.
getDefaultReferencePptx :: PandocMonad m => m Archive
getDefaultReferencePptx :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferencePptx = do
  -- We're going to narrow this down substantially once we get it
  -- working.
  let paths :: [[Char]]
paths = [ [Char]
"[Content_Types].xml"
              , [Char]
"_rels/.rels"
              , [Char]
"docProps/app.xml"
              , [Char]
"docProps/core.xml"
              , [Char]
"ppt/_rels/presentation.xml.rels"
              , [Char]
"ppt/presProps.xml"
              , [Char]
"ppt/presentation.xml"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout1.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout2.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout3.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout4.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout5.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout6.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout7.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout8.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout9.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout10.xml.rels"
              , [Char]
"ppt/slideLayouts/_rels/slideLayout11.xml.rels"
              , [Char]
"ppt/slideLayouts/slideLayout1.xml"
              , [Char]
"ppt/slideLayouts/slideLayout10.xml"
              , [Char]
"ppt/slideLayouts/slideLayout11.xml"
              , [Char]
"ppt/slideLayouts/slideLayout2.xml"
              , [Char]
"ppt/slideLayouts/slideLayout3.xml"
              , [Char]
"ppt/slideLayouts/slideLayout4.xml"
              , [Char]
"ppt/slideLayouts/slideLayout5.xml"
              , [Char]
"ppt/slideLayouts/slideLayout6.xml"
              , [Char]
"ppt/slideLayouts/slideLayout7.xml"
              , [Char]
"ppt/slideLayouts/slideLayout8.xml"
              , [Char]
"ppt/slideLayouts/slideLayout9.xml"
              , [Char]
"ppt/slideMasters/_rels/slideMaster1.xml.rels"
              , [Char]
"ppt/slideMasters/slideMaster1.xml"
              , [Char]
"ppt/slides/_rels/slide1.xml.rels"
              , [Char]
"ppt/slides/slide1.xml"
              , [Char]
"ppt/slides/_rels/slide2.xml.rels"
              , [Char]
"ppt/slides/slide2.xml"
              , [Char]
"ppt/slides/_rels/slide3.xml.rels"
              , [Char]
"ppt/slides/slide3.xml"
              , [Char]
"ppt/slides/_rels/slide4.xml.rels"
              , [Char]
"ppt/slides/slide4.xml"
              , [Char]
"ppt/tableStyles.xml"
              , [Char]
"ppt/theme/theme1.xml"
              , [Char]
"ppt/viewProps.xml"
              -- These relate to notes slides.
              , [Char]
"ppt/notesMasters/notesMaster1.xml"
              , [Char]
"ppt/notesMasters/_rels/notesMaster1.xml.rels"
              , [Char]
"ppt/notesSlides/notesSlide1.xml"
              , [Char]
"ppt/notesSlides/_rels/notesSlide1.xml.rels"
              , [Char]
"ppt/notesSlides/notesSlide2.xml"
              , [Char]
"ppt/notesSlides/_rels/notesSlide2.xml.rels"
              , [Char]
"ppt/theme/theme2.xml"
              ]
  let toLazy :: ByteString -> LazyByteString
toLazy = [ByteString] -> LazyByteString
BL.fromChunks ([ByteString] -> LazyByteString)
-> (ByteString -> [ByteString]) -> ByteString -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
  let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do
        epochtime <- NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Integer) -> m NominalDiffTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NominalDiffTime
forall (m :: * -> *). PandocMonad m => m NominalDiffTime
getPOSIXTime
        contents <- toLazy <$> readDataFile ("pptx/" ++ path)
        return $ toEntry path epochtime contents
  datadir <- m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
  mbArchive <- case datadir of
                    Maybe [Char]
Nothing   -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                    Just [Char]
d    -> do
                       exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.pptx")
                       if exists
                          then return (Just (d </> "reference.pptx"))
                          else return Nothing
  case mbArchive of
     Just [Char]
arch -> LazyByteString -> Archive
toArchive (LazyByteString -> Archive) -> m LazyByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m LazyByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m LazyByteString
readFileLazy [Char]
arch
     Maybe [Char]
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     ([Char] -> m Entry) -> [[Char]] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> m Entry
forall {m :: * -> *}. PandocMonad m => [Char] -> m Entry
pathToEntry [[Char]]
paths

getDataFileNames :: IO [FilePath]
getDataFileNames :: IO [[Char]]
getDataFileNames = do
#ifdef EMBED_DATA_FILES
  let allDataFiles = map fst dataFiles
#else
  allDataFiles <- ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
x -> [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"." Bool -> Bool -> Bool
&& [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"..") ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      (IO [Char]
getDataDir IO [Char] -> ([Char] -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [[Char]]
getDirectoryContents)
#endif
  return $ "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 :: IO [Char]
defaultUserDataDir = do
  xdgDir <- IO [Char] -> (SomeException -> IO [Char]) -> IO [Char]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgData [Char]
"pandoc")
               (\(SomeException
_ :: E.SomeException) -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
forall a. Monoid a => a
mempty)
  xdgExists <- doesDirectoryExist xdgDir
  legacyDir <- E.catch (getAppUserDataDirectory "pandoc")
                (\(SomeException
_ :: E.SomeException) -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
forall a. Monoid a => a
mempty)
  legacyDirExists <- doesDirectoryExist legacyDir
  if not xdgExists && legacyDirExists
     then return legacyDir
     else return xdgDir