4e97efe · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Class: Changes around logging.

4e97efeJohn MacFarlane10 years ago

src/Text/Pandoc/Class.hs+45−27

compare with master

unifiedsplit

@@ -43,6 +43,8 @@ module Text.Pandoc.Class ( PandocMonad(..)

43 , warning

44 , warningWithPos

45 , getWarnings

46+ , getLog

47+ , setVerbosity

46 , getMediaBag

48 , getMediaBag

47 , setMediaBag

49 , setMediaBag

48 , insertMedia

50 , insertMedia

@@ -70,6 +72,7 @@ import qualified Text.Pandoc.Shared as IO ( readDataFile

70 , warn

72 , warn

71 , openURL )

73 , openURL )

72import Text.Pandoc.Compat.Time (UTCTime)

74import Text.Pandoc.Compat.Time (UTCTime)

75+import Text.Pandoc.Options (Verbosity(..))

73import Text.Pandoc.Parsing (ParserT, SourcePos)

76import Text.Pandoc.Parsing (ParserT, SourcePos)

74import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

77import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

75import Text.Pandoc.MIME (MimeType, getMimeType)

78import Text.Pandoc.MIME (MimeType, getMimeType)

@@ -128,20 +131,55 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)

128 modifyCommonState :: (CommonState -> CommonState) -> m ()

131 modifyCommonState :: (CommonState -> CommonState) -> m ()

129 modifyCommonState f = getCommonState >>= putCommonState . f

132 modifyCommonState f = getCommonState >>= putCommonState . f

130

133

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+

131-- Functions defined for all PandocMonad instances

142-- Functions defined for all PandocMonad instances

132

143

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+

133warning :: PandocMonad m => String -> m ()

151warning :: PandocMonad m => String -> m ()

134−warning msg = modifyCommonState $ \st -> st{stWarnings = msg : stWarnings st}

152+warning msg = report WARNING msg

135

153

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?

136getWarnings :: PandocMonad m => m [String]

161getWarnings :: PandocMonad m => m [String]

137−getWarnings = getsCommonState stWarnings

162+getWarnings = do

163+ logs <- getLog

164+ return [s | (WARNING, s) <- logs]

138

165

139setMediaBag :: PandocMonad m => MediaBag -> m ()

166setMediaBag :: PandocMonad m => MediaBag -> m ()

140setMediaBag mb = modifyCommonState $

167setMediaBag mb = modifyCommonState $

141 \st -> st{stDeferredMediaBag = DeferredMediaBag mb mempty}

168 \st -> st{stDeferredMediaBag = DeferredMediaBag mb mempty}

142

169

143getMediaBag :: PandocMonad m => m MediaBag

170getMediaBag :: 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

145

183

146insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()

184insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()

147insertMedia fp mime bs = do

185insertMedia fp mime bs = do

@@ -170,12 +208,6 @@ getZonedTime = do

170 tz <- getCurrentTimeZone

208 tz <- getCurrentTimeZone

171 return $ utcToZonedTime tz t

209 return $ utcToZonedTime tz t

172

210

173−warningWithPos :: PandocMonad m

174− => SourcePos

175− -> String

176− -> ParserT s st m ()

177−warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos

178−

179--

211--

180

212

181newtype DeferredMediaPath = DeferredMediaPath {unDefer :: String}

213newtype DeferredMediaPath = DeferredMediaPath {unDefer :: String}

@@ -189,7 +221,6 @@ instance Monoid DeferredMediaBag where

189 mappend (DeferredMediaBag mb lst) (DeferredMediaBag mb' lst') =

221 mappend (DeferredMediaBag mb lst) (DeferredMediaBag mb' lst') =

190 DeferredMediaBag (mb <> mb') (lst <> lst')

222 DeferredMediaBag (mb <> mb') (lst <> lst')

191

223

192−

193-- the internal function for downloading individual items. We want to

224-- the internal function for downloading individual items. We want to

194-- catch errors and return a Nothing with a warning, so we can

225-- catch errors and return a Nothing with a warning, so we can

195-- continue without erroring out.

226-- continue without erroring out.

@@ -203,32 +234,19 @@ fetchMediaItem dfp =

203 (const $ do warning ("Couldn't access media at " ++ unDefer dfp)

234 (const $ do warning ("Couldn't access media at " ++ unDefer dfp)

204 return Nothing)

235 return Nothing)

205

236

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)]

222 , stDeferredMediaBag :: DeferredMediaBag

238 , stDeferredMediaBag :: DeferredMediaBag

223 , stInputFiles :: Maybe [FilePath]

239 , stInputFiles :: Maybe [FilePath]

224 , stOutputFile :: Maybe FilePath

240 , stOutputFile :: Maybe FilePath

241+ , stVerbosity :: Verbosity

225 }

242 }

226

243

227instance Default CommonState where

244instance Default CommonState where

228− def = CommonState { stWarnings = []

245+ def = CommonState { stLog = []

229 , stDeferredMediaBag = mempty

246 , stDeferredMediaBag = mempty

230 , stInputFiles = Nothing

247 , stInputFiles = Nothing

231 , stOutputFile = Nothing

248 , stOutputFile = Nothing

249+ , stVerbosity = WARNING

232 }

250 }

233

251

234runIO :: PandocIO a -> IO (Either PandocError a)

252runIO :: PandocIO a -> IO (Either PandocError a)