From cc7191b3b17ce7c7010a021bf685753ed2019aa6 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Sun, 27 Nov 2016 13:17:00 -0500
Subject: Class: Add stateful IO warnings, and function to get warndings.

Right now, the io warnings both print to stderr and write to the
state. That can be easily modified.

We also add a getWarnings function which pulls warnings out of the state
for instances of PandocMonad.
---
 src/Text/Pandoc/Class.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 279770e97..899e18776 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -97,6 +97,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) =>
              -> String
              -> m (Either E.SomeException (B.ByteString, Maybe MimeType))
   warn :: String -> m ()
+  getWarnings :: m [String]
   fail :: String -> m b
   glob :: String -> m [FilePath]
 
@@ -113,11 +114,11 @@ data PandocExecutionError = PandocFileReadError FilePath
                           deriving (Show, Typeable)
 
 -- Nothing in this for now, but let's put it there anyway.
-data PandocStateIO = PandocStateIO
+data PandocStateIO = PandocStateIO { ioStWarnings :: [String] }
   deriving Show
 
 instance Default PandocStateIO where
-  def = PandocStateIO
+  def = PandocStateIO { ioStWarnings = [] }
 
 runIO :: PandocIO a -> IO (Either PandocExecutionError a)
 runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
@@ -156,7 +157,10 @@ instance PandocMonad PandocIO where
   fail = M.fail
   fetchItem ms s = liftIO $ IO.fetchItem ms s
   fetchItem' mb ms s = liftIO $ IO.fetchItem' mb ms s
-  warn = liftIO . IO.warn
+  warn msg = do
+    modify $ \st -> st{ioStWarnings = msg : ioStWarnings st}
+    liftIO $ IO.warn msg
+  getWarnings = gets ioStWarnings
   glob = liftIO . IO.glob
 
 data TestState = TestState { stStdGen     :: StdGen
@@ -266,6 +270,8 @@ instance PandocMonad PandocPure where
 
   warn s =  modify $ \st -> st { stWarnings = s : stWarnings st }
 
+  getWarnings = gets stWarnings
+
   glob s = do
     fontFiles <- asks envFontFiles
     return (filter (match (compile s)) fontFiles)
-- 
cgit v1.2.3