Class: Add stResourcePath to CommonState, getResourcePath, setResourcePath.

To be used in implementing `\graphicspath` in LaTeX, and possibly
in things like PDF production via context.

Use resource path in fetchItem.

Issue an info message if we get a resource from somewhere other
than ".".

Added UsingResourceFrom to log message.
This commit is contained in:
John MacFarlane 2017-02-24 13:48:07 +01:00
parent 6936747794
commit 1c84855aab
2 changed files with 40 additions and 8 deletions

View file

@ -1,5 +1,6 @@
{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, TypeSynonymInstances,
FlexibleInstances, GeneralizedNewtypeDeriving, FlexibleContexts #-}
FlexibleInstances, GeneralizedNewtypeDeriving, FlexibleContexts,
StandaloneDeriving #-}
{-
Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
@ -50,6 +51,8 @@ module Text.Pandoc.Class ( PandocMonad(..)
, fetchItem
, getInputFiles
, getOutputFile
, setResourcePath
, getResourcePath
, PandocIO(..)
, PandocPure(..)
, FileTree(..)
@ -88,7 +91,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified System.Environment as IO (lookupEnv)
import System.FilePath.Glob (match, compile)
import System.FilePath ((</>), takeExtension, dropExtension)
import System.FilePath ((</>), takeExtension, dropExtension, isRelative)
import qualified System.FilePath.Glob as IO (glob)
import qualified System.Directory as IO (getModificationTime)
import Control.Monad as M (fail)
@ -165,6 +168,12 @@ getInputFiles = getsCommonState stInputFiles
getOutputFile :: PandocMonad m => m (Maybe FilePath)
getOutputFile = getsCommonState stOutputFile
setResourcePath :: PandocMonad m => [FilePath] -> m ()
setResourcePath ps = modifyCommonState $ \st -> st{stResourcePath = ps}
getResourcePath :: PandocMonad m => m [FilePath]
getResourcePath = getsCommonState stResourcePath
getPOSIXTime :: (PandocMonad m) => m POSIXTime
getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
@ -183,11 +192,12 @@ readFileFromDirs (d:ds) f = catchError
--
data CommonState = CommonState { stLog :: [LogMessage]
, stMediaBag :: MediaBag
, stInputFiles :: Maybe [FilePath]
, stOutputFile :: Maybe FilePath
, stVerbosity :: Verbosity
data CommonState = CommonState { stLog :: [LogMessage]
, stMediaBag :: MediaBag
, stInputFiles :: Maybe [FilePath]
, stOutputFile :: Maybe FilePath
, stResourcePath :: [FilePath]
, stVerbosity :: Verbosity
}
instance Default CommonState where
@ -195,6 +205,7 @@ instance Default CommonState where
, stMediaBag = mempty
, stInputFiles = Nothing
, stOutputFile = Nothing
, stResourcePath = ["."]
, stVerbosity = WARNING
}
@ -289,7 +300,10 @@ downloadOrRead sourceURL s = do
readLocalFile $ dropWhile (=='/') (uriPath u')
_ -> readLocalFile fp -- get from local file system
where readLocalFile f = do
cont <- readFileStrict f
resourcePath <- getResourcePath
cont <- if isRelative f
then withPaths resourcePath readFileStrict f
else readFileStrict f
return (cont, mime)
httpcolon = URI{ uriScheme = "http:",
uriAuthority = Nothing,
@ -306,6 +320,16 @@ downloadOrRead sourceURL s = do
convertSlash '\\' = '/'
convertSlash x = x
withPaths :: PandocMonad m => [FilePath] -> (FilePath -> m a) -> FilePath -> m a
withPaths [] _ fp = throwError $ PandocIOError fp
(userError "file not found in resource path")
withPaths (p:ps) action fp =
catchError (do res <- action (p </> fp)
when (p /= ".") $
report $ UsingResourceFrom fp p
return res)
(\_ -> withPaths ps action fp)
data PureState = PureState { stStdGen :: StdGen
, stWord8Store :: [Word8] -- should be
-- inifinite,

View file

@ -74,6 +74,7 @@ data LogMessage =
| CouldNotConvertTeXMath String String
| CouldNotParseCSS String
| Fetching String
| UsingResourceFrom FilePath FilePath
deriving (Show, Eq, Data, Ord, Typeable, Generic)
instance ToJSON LogMessage where
@ -163,6 +164,10 @@ instance ToJSON LogMessage where
Fetching fp ->
["type" .= String "CouldNotParseCSS",
"path" .= Text.pack fp]
UsingResourceFrom resource dir ->
["type" .= String "UsingResourceFrom",
"resource" .= Text.pack resource,
"path" .= Text.pack dir]
showPos :: SourcePos -> String
showPos pos = sn ++ "line " ++
@ -220,6 +225,8 @@ showLogMessage msg =
"Could not parse CSS" ++ if null m then "" else (':':'\n':m)
Fetching fp ->
"Fetching " ++ fp ++ "..."
UsingResourceFrom fp dir ->
"Using " ++ fp ++ " from " ++ dir
messageVerbosity:: LogMessage -> Verbosity
messageVerbosity msg =
@ -242,3 +249,4 @@ messageVerbosity msg =
CouldNotConvertTeXMath{} -> WARNING
CouldNotParseCSS{} -> WARNING
Fetching{} -> INFO
UsingResourceFrom{} -> INFO