@@ -43,6 +43,8 @@ module Text.Pandoc.Class ( PandocMonad(..)
4343 , warning
4444 , warningWithPos
4545 , getWarnings
46+ , getLog
47+ , setVerbosity
4648 , getMediaBag
4749 , setMediaBag
4850 , insertMedia
@@ -70,6 +72,7 @@ import qualified Text.Pandoc.Shared as IO ( readDataFile
7072 , warn
7173 , openURL )
7274import Text.Pandoc.Compat.Time (UTCTime)
75+import Text.Pandoc.Options (Verbosity(..))
7376import Text.Pandoc.Parsing (ParserT, SourcePos)
7477import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
7578import Text.Pandoc.MIME (MimeType, getMimeType)
@@ -128,20 +131,55 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
128131 modifyCommonState :: (CommonState -> CommonState) -> m ()
129132 modifyCommonState f = getCommonState >>= putCommonState . f
130133
134+ -- Can be overridden when you want log to be written to
135+ -- stderr in a streaming fashion
136+ report :: Verbosity -> String -> m ()
137+ report level msg = do
138+ verbosity <- getsCommonState stVerbosity
139+ when (level >= verbosity) $
140+ modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st }
141+
131142-- Functions defined for all PandocMonad instances
132143
144+setVerbosity :: PandocMonad m => Verbosity -> m ()
145+setVerbosity verbosity =
146+ modifyCommonState $ \st -> st{ stVerbosity = verbosity }
147+
148+getLog :: PandocMonad m => m [(Verbosity, String)]
149+getLog = getsCommonState stLog
150+
133151warning :: PandocMonad m => String -> m ()
134−warning msg = modifyCommonState $ \st -> st{stWarnings = msg : stWarnings st}
152+warning msg = report WARNING msg
135153
154+warningWithPos :: PandocMonad m
155+ => SourcePos
156+ -> String
157+ -> ParserT s st m ()
158+warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos
159+
160+-- TODO get rid of this?
136161getWarnings :: PandocMonad m => m [String]
137−getWarnings = getsCommonState stWarnings
162+getWarnings = do
163+ logs <- getLog
164+ return [s | (WARNING, s) <- logs]
138165
139166setMediaBag :: PandocMonad m => MediaBag -> m ()
140167setMediaBag mb = modifyCommonState $
141168 \st -> st{stDeferredMediaBag = DeferredMediaBag mb mempty}
142169
143170getMediaBag :: PandocMonad m => m MediaBag
144−getMediaBag = fetchDeferredMedia >> (dropDeferredMedia <$> getsCommonState stDeferredMediaBag)
171+getMediaBag = do
172+ fetchDeferredMedia
173+ DeferredMediaBag mb' _ <- getsCommonState stDeferredMediaBag
174+ return mb'
175+
176+fetchDeferredMedia :: PandocMonad m => m ()
177+fetchDeferredMedia = do
178+ (DeferredMediaBag mb defMedia) <- getsCommonState stDeferredMediaBag
179+ fetchedMedia <- catMaybes <$> mapM fetchMediaItem defMedia
180+ setMediaBag $ foldr
181+ (\(fp, bs, mbMime) mb' -> MB.insertMedia fp mbMime (BL.fromStrict bs) mb')
182+ mb fetchedMedia
145183
146184insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
147185insertMedia fp mime bs = do
@@ -170,12 +208,6 @@ getZonedTime = do
170208 tz <- getCurrentTimeZone
171209 return $ utcToZonedTime tz t
172210
173−warningWithPos :: PandocMonad m
174− => SourcePos
175− -> String
176− -> ParserT s st m ()
177−warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos
178−
179211--
180212
181213newtype DeferredMediaPath = DeferredMediaPath {unDefer :: String}
@@ -189,7 +221,6 @@ instance Monoid DeferredMediaBag where
189221 mappend (DeferredMediaBag mb lst) (DeferredMediaBag mb' lst') =
190222 DeferredMediaBag (mb <> mb') (lst <> lst')
191223
192−
193224-- the internal function for downloading individual items. We want to
194225-- catch errors and return a Nothing with a warning, so we can
195226-- continue without erroring out.
@@ -203,32 +234,19 @@ fetchMediaItem dfp =
203234 (const $ do warning ("Couldn't access media at " ++ unDefer dfp)
204235 return Nothing)
205236
206−fetchDeferredMedia' :: PandocMonad m => m MediaBag
207−fetchDeferredMedia' = do
208− (DeferredMediaBag mb defMedia) <- getsCommonState stDeferredMediaBag
209− fetchedMedia <- catMaybes <$> mapM fetchMediaItem defMedia
210− return $ foldr
211− (\(fp, bs, mbMime) mb' -> MB.insertMedia fp mbMime (BL.fromStrict bs) mb')
212− mb fetchedMedia
213−
214−fetchDeferredMedia :: PandocMonad m => m ()
215−fetchDeferredMedia = fetchDeferredMedia' >>= setMediaBag
216−
217−dropDeferredMedia :: DeferredMediaBag -> MediaBag
218−dropDeferredMedia (DeferredMediaBag mb _) = mb
219−
220−
221−data CommonState = CommonState { stWarnings :: [String]
237+data CommonState = CommonState { stLog :: [(Verbosity, String)]
222238 , stDeferredMediaBag :: DeferredMediaBag
223239 , stInputFiles :: Maybe [FilePath]
224240 , stOutputFile :: Maybe FilePath
241+ , stVerbosity :: Verbosity
225242 }
226243
227244instance Default CommonState where
228− def = CommonState { stWarnings = []
245+ def = CommonState { stLog = []
229246 , stDeferredMediaBag = mempty
230247 , stInputFiles = Nothing
231248 , stOutputFile = Nothing
249+ , stVerbosity = WARNING
232250 }
233251
234252runIO :: PandocIO a -> IO (Either PandocError a)