2016-11-24 09:54:18 -05:00
|
|
|
{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, TypeSynonymInstances,
|
|
|
|
FlexibleInstances, GeneralizedNewtypeDeriving, FlexibleContexts #-}
|
2016-11-21 09:30:08 -05:00
|
|
|
|
|
|
|
{-
|
|
|
|
Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
along with this program; if not, write to the Free Software
|
|
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
-}
|
|
|
|
|
|
|
|
{- |
|
|
|
|
Module : Text.Pandoc.Class
|
|
|
|
Copyright : Copyright (C) 2016 Jesse Rosenthal
|
|
|
|
License : GNU GPL, version 2 or above
|
|
|
|
|
|
|
|
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
|
|
Stability : alpha
|
|
|
|
Portability : portable
|
|
|
|
|
|
|
|
Typeclass for pandoc readers and writers, allowing both IO and pure instances.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Text.Pandoc.Class ( PandocMonad(..)
|
2016-11-27 15:31:17 -05:00
|
|
|
, PureState(..)
|
|
|
|
, PureEnv(..)
|
2016-11-21 09:30:08 -05:00
|
|
|
, getPOSIXTime
|
2016-11-30 09:46:08 -05:00
|
|
|
, getZonedTime
|
2016-11-28 17:13:46 -05:00
|
|
|
, addWarningWithPos
|
2016-11-24 09:54:18 -05:00
|
|
|
, PandocIO(..)
|
|
|
|
, PandocPure(..)
|
|
|
|
, PandocExecutionError(..)
|
2016-11-30 09:21:21 -05:00
|
|
|
, FileInfo(..)
|
2016-11-24 09:54:18 -05:00
|
|
|
, runIO
|
|
|
|
, runIOorExplode
|
2016-11-24 11:52:06 -05:00
|
|
|
, runPure
|
2016-12-01 10:00:21 -05:00
|
|
|
, withMediaBag
|
2016-11-21 09:30:08 -05:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Prelude hiding (readFile, fail)
|
|
|
|
import qualified Control.Monad as M (fail)
|
2016-11-24 11:52:06 -05:00
|
|
|
import System.Random (StdGen, next, mkStdGen)
|
2016-11-21 09:30:08 -05:00
|
|
|
import qualified System.Random as IO (newStdGen)
|
2016-11-24 11:52:06 -05:00
|
|
|
import Codec.Archive.Zip (Archive, fromArchive, emptyArchive)
|
2016-11-21 09:30:08 -05:00
|
|
|
import Data.Unique (hashUnique)
|
|
|
|
import qualified Data.Unique as IO (newUnique)
|
|
|
|
import qualified Text.Pandoc.Shared as IO ( fetchItem
|
|
|
|
, fetchItem'
|
|
|
|
, getDefaultReferenceDocx
|
|
|
|
, getDefaultReferenceODT
|
|
|
|
, warn
|
|
|
|
, readDataFile)
|
|
|
|
import Text.Pandoc.Compat.Time (UTCTime)
|
2016-11-28 17:13:46 -05:00
|
|
|
import Text.Pandoc.Parsing (ParserT, ParserState, SourcePos)
|
2016-11-21 09:30:08 -05:00
|
|
|
import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
|
2016-11-24 11:52:06 -05:00
|
|
|
import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
|
|
|
|
, posixSecondsToUTCTime
|
|
|
|
, POSIXTime )
|
2016-11-30 09:46:08 -05:00
|
|
|
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime, utc)
|
|
|
|
import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)
|
2016-11-21 09:30:08 -05:00
|
|
|
import Text.Pandoc.MIME (MimeType, getMimeType)
|
2016-11-27 15:29:46 -05:00
|
|
|
import Text.Pandoc.MediaBag (MediaBag)
|
|
|
|
import qualified Text.Pandoc.MediaBag as MB
|
2016-11-21 09:30:08 -05:00
|
|
|
import qualified Data.ByteString as B
|
|
|
|
import qualified Data.ByteString.Lazy as BL
|
|
|
|
import qualified Control.Exception as E
|
|
|
|
import qualified System.Environment as IO (lookupEnv)
|
|
|
|
import System.FilePath.Glob (match, compile)
|
|
|
|
import System.FilePath ((</>))
|
|
|
|
import qualified System.FilePath.Glob as IO (glob)
|
2016-11-30 09:21:21 -05:00
|
|
|
import qualified System.Directory as IO (getModificationTime)
|
2016-11-21 09:30:08 -05:00
|
|
|
import Control.Monad.State hiding (fail)
|
|
|
|
import Control.Monad.Reader hiding (fail)
|
2016-11-24 09:54:18 -05:00
|
|
|
import Control.Monad.Except hiding (fail)
|
2016-11-21 09:30:08 -05:00
|
|
|
import Data.Word (Word8)
|
|
|
|
import Data.Typeable
|
2016-11-24 09:54:18 -05:00
|
|
|
import Data.Default
|
|
|
|
import System.IO.Error
|
2016-11-30 09:21:21 -05:00
|
|
|
import qualified Data.Map as M
|
2016-11-21 09:30:08 -05:00
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) => PandocMonad m where
|
2016-11-21 09:30:08 -05:00
|
|
|
lookupEnv :: String -> m (Maybe String)
|
|
|
|
getCurrentTime :: m UTCTime
|
2016-11-30 09:46:08 -05:00
|
|
|
getCurrentTimeZone :: m TimeZone
|
2016-11-21 09:30:08 -05:00
|
|
|
getDefaultReferenceDocx :: Maybe FilePath -> m Archive
|
|
|
|
getDefaultReferenceODT :: Maybe FilePath -> m Archive
|
|
|
|
newStdGen :: m StdGen
|
|
|
|
newUniqueHash :: m Int
|
|
|
|
readFileLazy :: FilePath -> m BL.ByteString
|
2016-11-24 09:54:18 -05:00
|
|
|
readDataFile :: Maybe FilePath
|
|
|
|
-> FilePath
|
|
|
|
-> m B.ByteString
|
|
|
|
fetchItem :: Maybe String
|
|
|
|
-> String
|
|
|
|
-> m (Either E.SomeException (B.ByteString, Maybe MimeType))
|
|
|
|
fetchItem' :: MediaBag
|
|
|
|
-> Maybe String
|
|
|
|
-> String
|
|
|
|
-> m (Either E.SomeException (B.ByteString, Maybe MimeType))
|
2016-11-21 09:30:08 -05:00
|
|
|
warn :: String -> m ()
|
2016-11-27 13:17:00 -05:00
|
|
|
getWarnings :: m [String]
|
2016-11-21 09:30:08 -05:00
|
|
|
fail :: String -> m b
|
|
|
|
glob :: String -> m [FilePath]
|
2016-11-30 12:55:30 -05:00
|
|
|
getModificationTime :: FilePath -> m UTCTime
|
|
|
|
-- The following are common to all instantiations of the monad, up
|
|
|
|
-- to the record names, so I'd like to work out a better way to deal
|
|
|
|
-- with it.
|
2016-11-29 10:42:48 -05:00
|
|
|
setMediaBag :: MediaBag -> m ()
|
2016-12-01 10:00:21 -05:00
|
|
|
getMediaBag :: m MediaBag
|
2016-11-27 15:29:46 -05:00
|
|
|
insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m ()
|
2016-11-30 12:55:30 -05:00
|
|
|
getInputFiles :: m (Maybe [FilePath])
|
|
|
|
getOutputFile :: m (Maybe FilePath)
|
|
|
|
|
2016-11-30 09:21:21 -05:00
|
|
|
|
2016-11-21 09:30:08 -05:00
|
|
|
|
|
|
|
--Some functions derived from Primitives:
|
|
|
|
|
|
|
|
getPOSIXTime :: (PandocMonad m) => m POSIXTime
|
|
|
|
getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
|
|
|
|
|
2016-11-30 09:46:08 -05:00
|
|
|
getZonedTime :: (PandocMonad m) => m ZonedTime
|
|
|
|
getZonedTime = do
|
|
|
|
t <- getCurrentTime
|
|
|
|
tz <- getCurrentTimeZone
|
|
|
|
return $ utcToZonedTime tz t
|
|
|
|
|
2016-11-28 17:13:46 -05:00
|
|
|
addWarningWithPos :: PandocMonad m
|
|
|
|
=> Maybe SourcePos
|
|
|
|
-> String
|
|
|
|
-> ParserT [Char] ParserState m ()
|
|
|
|
addWarningWithPos mbpos msg =
|
|
|
|
lift $
|
|
|
|
warn $
|
|
|
|
msg ++ maybe "" (\pos -> " " ++ show pos) mbpos
|
2016-11-21 09:30:08 -05:00
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
-- We can add to this as we go
|
2016-11-26 23:43:54 -05:00
|
|
|
data PandocExecutionError = PandocFileReadError FilePath
|
|
|
|
| PandocShouldNeverHappenError String
|
2016-11-28 16:54:00 -05:00
|
|
|
| PandocParseError String
|
2016-11-26 23:43:54 -05:00
|
|
|
| PandocSomeError String
|
|
|
|
deriving (Show, Typeable)
|
2016-11-24 09:54:18 -05:00
|
|
|
|
|
|
|
-- Nothing in this for now, but let's put it there anyway.
|
2016-11-27 15:29:46 -05:00
|
|
|
data PandocStateIO = PandocStateIO { ioStWarnings :: [String]
|
|
|
|
, ioStMediaBag :: MediaBag
|
|
|
|
} deriving Show
|
2016-11-24 09:54:18 -05:00
|
|
|
|
|
|
|
instance Default PandocStateIO where
|
2016-11-27 15:29:46 -05:00
|
|
|
def = PandocStateIO { ioStWarnings = []
|
|
|
|
, ioStMediaBag = mempty
|
|
|
|
}
|
2016-11-24 09:54:18 -05:00
|
|
|
|
2016-11-30 12:55:30 -05:00
|
|
|
data PandocEnvIO = PandocEnvIO { ioEnvInputFiles :: Maybe [FilePath]
|
|
|
|
, ioEnvOutputFile :: Maybe FilePath
|
|
|
|
}
|
|
|
|
instance Default PandocEnvIO where
|
|
|
|
def = PandocEnvIO { ioEnvInputFiles = Nothing -- stdin
|
|
|
|
, ioEnvOutputFile = Nothing -- stdout
|
|
|
|
}
|
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
runIO :: PandocIO a -> IO (Either PandocExecutionError a)
|
2016-11-30 12:55:30 -05:00
|
|
|
runIO ma = flip evalStateT def $ flip runReaderT def $ runExceptT $ unPandocIO ma
|
2016-11-24 09:54:18 -05:00
|
|
|
|
2016-12-01 10:00:21 -05:00
|
|
|
withMediaBag :: PandocMonad m => m a -> m (a, MediaBag)
|
|
|
|
withMediaBag ma = ((,)) <$> ma <*> getMediaBag
|
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
runIOorExplode :: PandocIO a -> IO a
|
|
|
|
runIOorExplode ma = do
|
|
|
|
eitherVal <- runIO ma
|
|
|
|
case eitherVal of
|
|
|
|
Right x -> return x
|
2016-11-28 16:54:00 -05:00
|
|
|
Left (PandocFileReadError fp) -> error $ "problem reading " ++ fp
|
2016-11-26 23:43:54 -05:00
|
|
|
Left (PandocShouldNeverHappenError s) -> error s
|
2016-11-28 16:54:00 -05:00
|
|
|
Left (PandocParseError s) -> error $ "parse error" ++ s
|
2016-11-26 23:43:54 -05:00
|
|
|
Left (PandocSomeError s) -> error s
|
2016-11-24 09:54:18 -05:00
|
|
|
|
2016-12-01 10:00:21 -05:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
newtype PandocIO a = PandocIO {
|
2016-11-30 12:55:30 -05:00
|
|
|
unPandocIO :: ExceptT PandocExecutionError (ReaderT PandocEnvIO (StateT PandocStateIO IO)) a
|
2016-11-27 15:32:28 -05:00
|
|
|
} deriving ( MonadIO
|
|
|
|
, Functor
|
|
|
|
, Applicative
|
|
|
|
, Monad
|
2016-11-30 12:55:30 -05:00
|
|
|
, MonadReader PandocEnvIO
|
2016-11-27 15:32:28 -05:00
|
|
|
, MonadState PandocStateIO
|
|
|
|
, MonadError PandocExecutionError
|
|
|
|
)
|
2016-11-24 09:54:18 -05:00
|
|
|
|
2016-11-27 15:45:08 +01:00
|
|
|
instance PandocMonad PandocIO where
|
2016-11-24 09:54:18 -05:00
|
|
|
lookupEnv = liftIO . IO.lookupEnv
|
|
|
|
getCurrentTime = liftIO IO.getCurrentTime
|
2016-11-30 09:46:08 -05:00
|
|
|
getCurrentTimeZone = liftIO IO.getCurrentTimeZone
|
2016-11-24 09:54:18 -05:00
|
|
|
getDefaultReferenceDocx = liftIO . IO.getDefaultReferenceDocx
|
|
|
|
getDefaultReferenceODT = liftIO . IO.getDefaultReferenceODT
|
|
|
|
newStdGen = liftIO IO.newStdGen
|
|
|
|
newUniqueHash = hashUnique <$> (liftIO IO.newUnique)
|
|
|
|
readFileLazy s = do
|
|
|
|
eitherBS <- liftIO (tryIOError $ BL.readFile s)
|
|
|
|
case eitherBS of
|
|
|
|
Right bs -> return bs
|
2016-11-26 23:43:54 -05:00
|
|
|
Left _ -> throwError $ PandocFileReadError s
|
2016-11-24 09:54:18 -05:00
|
|
|
-- TODO: Make this more sensitive to the different sorts of failure
|
|
|
|
readDataFile mfp fname = do
|
|
|
|
eitherBS <- liftIO (tryIOError $ IO.readDataFile mfp fname)
|
|
|
|
case eitherBS of
|
|
|
|
Right bs -> return bs
|
2016-11-26 23:43:54 -05:00
|
|
|
Left _ -> throwError $ PandocFileReadError fname
|
2016-11-24 09:54:18 -05:00
|
|
|
fail = M.fail
|
|
|
|
fetchItem ms s = liftIO $ IO.fetchItem ms s
|
|
|
|
fetchItem' mb ms s = liftIO $ IO.fetchItem' mb ms s
|
2016-11-27 13:17:00 -05:00
|
|
|
warn msg = do
|
|
|
|
modify $ \st -> st{ioStWarnings = msg : ioStWarnings st}
|
|
|
|
liftIO $ IO.warn msg
|
|
|
|
getWarnings = gets ioStWarnings
|
2016-11-24 09:54:18 -05:00
|
|
|
glob = liftIO . IO.glob
|
2016-11-30 09:21:21 -05:00
|
|
|
getModificationTime fp = do
|
|
|
|
eitherMtime <- liftIO (tryIOError $ IO.getModificationTime fp)
|
|
|
|
case eitherMtime of
|
|
|
|
Right mtime -> return mtime
|
|
|
|
Left _ -> throwError $ PandocFileReadError fp
|
2016-11-30 12:55:30 -05:00
|
|
|
-- Common functions
|
|
|
|
setMediaBag mb =
|
|
|
|
modify $ \st -> st{ioStMediaBag = mb}
|
2016-12-01 10:00:21 -05:00
|
|
|
getMediaBag = gets ioStMediaBag
|
2016-11-30 12:55:30 -05:00
|
|
|
insertMedia fp mime bs =
|
|
|
|
modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
|
|
|
|
getInputFiles = asks ioEnvInputFiles
|
|
|
|
getOutputFile = asks ioEnvOutputFile
|
|
|
|
|
|
|
|
|
2016-11-21 09:30:08 -05:00
|
|
|
|
2016-11-27 15:31:17 -05:00
|
|
|
data PureState = PureState { stStdGen :: StdGen
|
2016-11-21 09:30:08 -05:00
|
|
|
, stWord8Store :: [Word8] -- should be
|
|
|
|
-- inifinite,
|
|
|
|
-- i.e. [1..]
|
|
|
|
, stWarnings :: [String]
|
|
|
|
, stUniqStore :: [Int] -- should be
|
|
|
|
-- inifinite and
|
|
|
|
-- contain every
|
|
|
|
-- element at most
|
|
|
|
-- once, e.g. [1..]
|
2016-11-27 15:29:46 -05:00
|
|
|
, stMediaBag :: MediaBag
|
2016-11-21 09:30:08 -05:00
|
|
|
}
|
|
|
|
|
2016-11-27 15:31:17 -05:00
|
|
|
instance Default PureState where
|
|
|
|
def = PureState { stStdGen = mkStdGen 1848
|
2016-11-24 11:52:06 -05:00
|
|
|
, stWord8Store = [1..]
|
|
|
|
, stWarnings = []
|
|
|
|
, stUniqStore = [1..]
|
2016-11-27 15:29:46 -05:00
|
|
|
, stMediaBag = mempty
|
2016-11-30 09:21:21 -05:00
|
|
|
|
|
|
|
|
2016-11-24 11:52:06 -05:00
|
|
|
}
|
2016-11-30 09:21:21 -05:00
|
|
|
data FileInfo = FileInfo { infoFileMTime :: UTCTime
|
|
|
|
, infoFileContents :: B.ByteString
|
|
|
|
}
|
|
|
|
|
|
|
|
newtype FileTree = FileTree {unFileTree :: M.Map FilePath FileInfo}
|
|
|
|
deriving (Monoid)
|
|
|
|
|
|
|
|
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
|
|
|
|
getFileInfo fp tree = M.lookup fp $ unFileTree tree
|
2016-11-24 11:52:06 -05:00
|
|
|
|
2016-11-27 15:31:17 -05:00
|
|
|
data PureEnv = PureEnv { envEnv :: [(String, String)]
|
2016-11-21 09:30:08 -05:00
|
|
|
, envTime :: UTCTime
|
2016-11-30 09:46:08 -05:00
|
|
|
, envTimeZone :: TimeZone
|
2016-11-21 09:30:08 -05:00
|
|
|
, envReferenceDocx :: Archive
|
|
|
|
, envReferenceODT :: Archive
|
2016-11-30 09:21:21 -05:00
|
|
|
, envFiles :: FileTree
|
|
|
|
, envUserDataDir :: FileTree
|
|
|
|
, envCabalDataDir :: FileTree
|
2016-11-21 09:30:08 -05:00
|
|
|
, envFontFiles :: [FilePath]
|
2016-11-30 12:55:30 -05:00
|
|
|
, envInputFiles :: Maybe [FilePath]
|
|
|
|
, envOutputFile :: Maybe FilePath
|
2016-11-21 09:30:08 -05:00
|
|
|
}
|
|
|
|
|
2016-11-24 11:52:06 -05:00
|
|
|
-- We have to figure this out a bit more. But let's put some empty
|
|
|
|
-- values in for the time being.
|
2016-11-27 15:31:17 -05:00
|
|
|
instance Default PureEnv where
|
|
|
|
def = PureEnv { envEnv = [("USER", "pandoc-user")]
|
2016-11-24 11:52:06 -05:00
|
|
|
, envTime = posixSecondsToUTCTime 0
|
2016-11-30 09:46:08 -05:00
|
|
|
, envTimeZone = utc
|
2016-11-24 11:52:06 -05:00
|
|
|
, envReferenceDocx = emptyArchive
|
|
|
|
, envReferenceODT = emptyArchive
|
2016-11-30 09:21:21 -05:00
|
|
|
, envFiles = mempty
|
|
|
|
, envUserDataDir = mempty
|
|
|
|
, envCabalDataDir = mempty
|
2016-11-24 11:52:06 -05:00
|
|
|
, envFontFiles = []
|
2016-11-30 12:55:30 -05:00
|
|
|
, envInputFiles = Nothing
|
|
|
|
, envOutputFile = Nothing
|
2016-11-24 11:52:06 -05:00
|
|
|
}
|
|
|
|
|
2016-11-24 11:39:09 -05:00
|
|
|
instance E.Exception PandocExecutionError
|
2016-11-21 09:30:08 -05:00
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
newtype PandocPure a = PandocPure {
|
|
|
|
unPandocPure :: ExceptT PandocExecutionError
|
2016-11-27 15:31:17 -05:00
|
|
|
(ReaderT PureEnv (State PureState)) a
|
2016-11-27 15:32:28 -05:00
|
|
|
} deriving ( Functor
|
|
|
|
, Applicative
|
|
|
|
, Monad
|
|
|
|
, MonadReader PureEnv
|
|
|
|
, MonadState PureState
|
|
|
|
, MonadError PandocExecutionError
|
|
|
|
)
|
2016-11-21 09:30:08 -05:00
|
|
|
|
2016-11-24 11:52:06 -05:00
|
|
|
runPure :: PandocPure a -> Either PandocExecutionError a
|
|
|
|
runPure x = flip evalState def $ flip runReaderT def $ runExceptT $ unPandocPure x
|
|
|
|
|
2016-11-24 09:54:18 -05:00
|
|
|
instance PandocMonad PandocPure where
|
2016-11-21 09:30:08 -05:00
|
|
|
lookupEnv s = do
|
|
|
|
env <- asks envEnv
|
|
|
|
return (lookup s env)
|
|
|
|
|
|
|
|
getCurrentTime = asks envTime
|
|
|
|
|
2016-11-30 09:46:08 -05:00
|
|
|
getCurrentTimeZone = asks envTimeZone
|
|
|
|
|
2016-11-21 09:30:08 -05:00
|
|
|
getDefaultReferenceDocx _ = asks envReferenceDocx
|
|
|
|
|
|
|
|
getDefaultReferenceODT _ = asks envReferenceODT
|
|
|
|
|
|
|
|
newStdGen = do
|
|
|
|
g <- gets stStdGen
|
|
|
|
let (_, nxtGen) = next g
|
|
|
|
modify $ \st -> st { stStdGen = nxtGen }
|
|
|
|
return g
|
|
|
|
|
|
|
|
newUniqueHash = do
|
|
|
|
uniqs <- gets stUniqStore
|
|
|
|
case uniqs of
|
|
|
|
u : us -> do
|
|
|
|
modify $ \st -> st { stUniqStore = us }
|
|
|
|
return u
|
|
|
|
_ -> M.fail "uniq store ran out of elements"
|
|
|
|
readFileLazy fp = do
|
|
|
|
fps <- asks envFiles
|
2016-11-30 09:21:21 -05:00
|
|
|
case infoFileContents <$> getFileInfo fp fps of
|
2016-11-21 09:30:08 -05:00
|
|
|
Just bs -> return (BL.fromStrict bs)
|
2016-11-26 23:43:54 -05:00
|
|
|
Nothing -> throwError $ PandocFileReadError fp
|
2016-11-21 09:30:08 -05:00
|
|
|
readDataFile Nothing "reference.docx" = do
|
|
|
|
(B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceDocx Nothing)
|
|
|
|
readDataFile Nothing "reference.odt" = do
|
|
|
|
(B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceODT Nothing)
|
|
|
|
readDataFile Nothing fname = do
|
|
|
|
let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
|
|
|
|
BL.toStrict <$> (readFileLazy fname')
|
|
|
|
readDataFile (Just userDir) fname = do
|
|
|
|
userDirFiles <- asks envUserDataDir
|
2016-11-30 09:21:21 -05:00
|
|
|
case infoFileContents <$> (getFileInfo (userDir </> fname) userDirFiles) of
|
2016-11-21 09:30:08 -05:00
|
|
|
Just bs -> return bs
|
|
|
|
Nothing -> readDataFile Nothing fname
|
|
|
|
fail = M.fail
|
|
|
|
fetchItem _ fp = do
|
|
|
|
fps <- asks envFiles
|
2016-11-30 09:21:21 -05:00
|
|
|
case infoFileContents <$> (getFileInfo fp fps) of
|
2016-11-21 09:30:08 -05:00
|
|
|
Just bs -> return (Right (bs, getMimeType fp))
|
2016-11-26 23:43:54 -05:00
|
|
|
Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
|
2016-11-21 09:30:08 -05:00
|
|
|
|
|
|
|
fetchItem' media sourceUrl nm = do
|
2016-11-27 15:29:46 -05:00
|
|
|
case MB.lookupMedia nm media of
|
2016-11-21 09:30:08 -05:00
|
|
|
Nothing -> fetchItem sourceUrl nm
|
|
|
|
Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
|
|
|
|
|
|
|
|
warn s = modify $ \st -> st { stWarnings = s : stWarnings st }
|
|
|
|
|
2016-11-27 13:17:00 -05:00
|
|
|
getWarnings = gets stWarnings
|
|
|
|
|
2016-11-21 09:30:08 -05:00
|
|
|
glob s = do
|
|
|
|
fontFiles <- asks envFontFiles
|
|
|
|
return (filter (match (compile s)) fontFiles)
|
2016-11-27 15:29:46 -05:00
|
|
|
|
2016-11-30 12:55:30 -05:00
|
|
|
getModificationTime fp = do
|
|
|
|
fps <- asks envFiles
|
|
|
|
case infoFileMTime <$> (getFileInfo fp fps) of
|
|
|
|
Just tm -> return tm
|
|
|
|
Nothing -> throwError $ PandocFileReadError fp
|
|
|
|
|
|
|
|
-- Common files
|
|
|
|
|
2016-11-29 10:42:48 -05:00
|
|
|
setMediaBag mb =
|
|
|
|
modify $ \st -> st{stMediaBag = mb}
|
|
|
|
|
2016-12-01 10:00:21 -05:00
|
|
|
getMediaBag = gets stMediaBag
|
|
|
|
|
2016-11-27 15:29:46 -05:00
|
|
|
insertMedia fp mime bs =
|
|
|
|
modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
|
2016-11-30 09:21:21 -05:00
|
|
|
|
2016-11-30 12:55:30 -05:00
|
|
|
getInputFiles = asks envInputFiles
|
|
|
|
|
|
|
|
getOutputFile = asks envOutputFile
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|