aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-05-25 10:08:30 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2021-05-25 10:08:30 -0700
commitf2c1b5746912db945be780961b6503e38c3c7e1e (patch)
tree170ed07619f9dfafab9dddff5e3af4968dde2eb1 /src
parentfb40c8109dc969dce74c8153ad1c0d4b33d54a6c (diff)
downloadpandoc-f2c1b5746912db945be780961b6503e38c3c7e1e.tar.gz
PandocMonad: add info message in `downloadOrRead`...
indicating what path local resources have been loaded from.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Class/PandocMonad.hs13
1 files changed, 8 insertions, 5 deletions
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index ae6917e06..b5f401619 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -409,9 +410,10 @@ downloadOrRead s = do
_ -> readLocalFile fp -- get from local file system
where readLocalFile f = do
resourcePath <- getResourcePath
- cont <- if isRelative f
- then withPaths resourcePath readFileStrict f
- else readFileStrict f
+ (fp', cont) <- if isRelative f
+ then withPaths resourcePath readFileStrict f
+ else (f,) <$> readFileStrict f
+ report $ LoadedResource f fp'
return (cont, mime)
httpcolon = URI{ uriScheme = "http:",
uriAuthority = Nothing,
@@ -621,10 +623,11 @@ makeCanonical = Posix.joinPath . transformPathParts . splitDirectories
-- that filepath. Returns the result of the first successful execution
-- of the action, or throws a @PandocResourceNotFound@ exception if the
-- action errors for all filepaths.
-withPaths :: PandocMonad m => [FilePath] -> (FilePath -> m a) -> FilePath -> m a
+withPaths :: PandocMonad m
+ => [FilePath] -> (FilePath -> m a) -> FilePath -> m (FilePath, a)
withPaths [] _ fp = throwError $ PandocResourceNotFound $ T.pack fp
withPaths (p:ps) action fp =
- catchError (action (p </> fp))
+ catchError ((p </> fp,) <$> action (p </> fp))
(\_ -> withPaths ps action fp)
-- | Traverse tree, filling media bag for any images that