@@ -36,6 +36,13 @@ module Text.Pandoc.Class ( PandocMonad(..)
3636 , PureEnv(..)
3737 , getPOSIXTime
3838 , getZonedTime
39+ , warn
40+ , getWarnings
41+ , getMediaBag
42+ , setMediaBag
43+ , insertMedia
44+ , getInputFiles
45+ , getOutputFile
3946 , addWarningWithPos
4047 , PandocIO(..)
4148 , PandocPure(..)
@@ -57,7 +64,6 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem
5764 , fetchItem'
5865 , getDefaultReferenceDocx
5966 , getDefaultReferenceODT
60− , warn
6167 , readDataFile)
6268import Text.Pandoc.Compat.Time (UTCTime)
6369import Text.Pandoc.Parsing (ParserT, ParserState, SourcePos)
@@ -87,7 +93,7 @@ import System.IO.Error
8793import qualified Data.Map as M
8894import Text.Pandoc.Error
8995
90−class (Functor m, Applicative m, Monad m, MonadError PandocError m) => PandocMonad m where
96+class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState CommonState m) => PandocMonad m where
9197 lookupEnv :: String -> m (Maybe String)
9298 getCurrentTime :: m UTCTime
9399 getCurrentTimeZone :: m TimeZone
@@ -106,24 +112,44 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m) => PandocMon
106112 -> Maybe String
107113 -> String
108114 -> m (Either E.SomeException (B.ByteString, Maybe MimeType))
109− warn :: String -> m ()
110− getWarnings :: m [String]
111115 fail :: String -> m b
112116 glob :: String -> m [FilePath]
113117 getModificationTime :: FilePath -> m UTCTime
114118 -- The following are common to all instantiations of the monad, up
115119 -- to the record names, so I'd like to work out a better way to deal
116120 -- with it.
117− setMediaBag :: MediaBag -> m ()
118− getMediaBag :: m MediaBag
119− insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m ()
120− getInputFiles :: m (Maybe [FilePath])
121− getOutputFile :: m (Maybe FilePath)
122121
123122
124123
125124--Some functions derived from Primitives:
126125
126+warn :: PandocMonad m => String -> m ()
127+warn msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
128+
129+getWarnings :: PandocMonad m => m [String]
130+getWarnings = gets stWarnings
131+
132+setMediaBag :: PandocMonad m => MediaBag -> m ()
133+setMediaBag mb = modify $ \st -> st{stMediaBag = mb}
134+
135+getMediaBag :: PandocMonad m => m MediaBag
136+getMediaBag = gets stMediaBag
137+
138+insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
139+insertMedia fp mime bs =
140+ modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
141+
142+getInputFiles :: PandocMonad m => m (Maybe [FilePath])
143+getInputFiles = gets stInputFiles
144+
145+getOutputFile :: PandocMonad m => m (Maybe FilePath)
146+getOutputFile = gets stOutputFile
147+
148+
149+
150+
151+
152+
127153getPOSIXTime :: (PandocMonad m) => m POSIXTime
128154getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
129155
@@ -142,27 +168,23 @@ addWarningWithPos mbpos msg =
142168 warn $
143169 msg ++ maybe "" (\pos -> " " ++ show pos) mbpos
144170
145−
146−-- Nothing in this for now, but let's put it there anyway.
147−data PandocStateIO = PandocStateIO { ioStWarnings :: [String]
148− , ioStMediaBag :: MediaBag
149− } deriving Show
150−
151−instance Default PandocStateIO where
152− def = PandocStateIO { ioStWarnings = []
153− , ioStMediaBag = mempty
154− }
155−
156−data PandocEnvIO = PandocEnvIO { ioEnvInputFiles :: Maybe [FilePath]
157− , ioEnvOutputFile :: Maybe FilePath
171+data CommonState = CommonState { stWarnings :: [String]
172+ , stMediaBag :: MediaBag
173+ , stInputFiles :: Maybe [FilePath]
174+ , stOutputFile :: Maybe FilePath
158175 }
159−instance Default PandocEnvIO where
160− def = PandocEnvIO { ioEnvInputFiles = Nothing -- stdin
161− , ioEnvOutputFile = Nothing -- stdout
176+
177+instance Default CommonState where
178+ def = CommonState { stWarnings = []
179+ , stMediaBag = mempty
180+ , stInputFiles = Nothing
181+ , stOutputFile = Nothing
162182 }
163183
184+-- Nothing in this for now, but let's put it there anyway.
185+
164186runIO :: PandocIO a -> IO (Either PandocError a)
165−runIO ma = flip evalStateT def $ flip runReaderT def $ runExceptT $ unPandocIO ma
187+runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
166188
167189withMediaBag :: PandocMonad m => m a -> m (a, MediaBag)
168190withMediaBag ma = ((,)) <$> ma <*> getMediaBag
@@ -177,18 +199,14 @@ runIOorExplode ma = handleError <$> runIO ma
177199 -- Left (PandocParseError s) -> error $ "parse error" ++ s
178200 -- Left (PandocSomeError s) -> error s
179201
180−
181−
182−
183202
184203newtype PandocIO a = PandocIO {
185− unPandocIO :: ExceptT PandocError (ReaderT PandocEnvIO (StateT PandocStateIO IO)) a
204+ unPandocIO :: ExceptT PandocError (StateT CommonState IO) a
186205 } deriving ( MonadIO
187206 , Functor
188207 , Applicative
189208 , Monad
190− , MonadReader PandocEnvIO
191− , MonadState PandocStateIO
209+ , MonadState CommonState
192210 , MonadError PandocError
193211 )
194212
@@ -214,48 +232,29 @@ instance PandocMonad PandocIO where
214232 fail = M.fail
215233 fetchItem ms s = liftIO $ IO.fetchItem ms s
216234 fetchItem' mb ms s = liftIO $ IO.fetchItem' mb ms s
217− warn msg = do
218− modify $ \st -> st{ioStWarnings = msg : ioStWarnings st}
219− liftIO $ IO.warn msg
220− getWarnings = gets ioStWarnings
221235 glob = liftIO . IO.glob
222236 getModificationTime fp = do
223237 eitherMtime <- liftIO (tryIOError $ IO.getModificationTime fp)
224238 case eitherMtime of
225239 Right mtime -> return mtime
226240 Left _ -> throwError $ PandocFileReadError fp
227− -- Common functions
228− setMediaBag mb =
229− modify $ \st -> st{ioStMediaBag = mb}
230− getMediaBag = gets ioStMediaBag
231− insertMedia fp mime bs =
232− modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
233− getInputFiles = asks ioEnvInputFiles
234− getOutputFile = asks ioEnvOutputFile
235−
236241
237242
238243data PureState = PureState { stStdGen :: StdGen
239244 , stWord8Store :: [Word8] -- should be
240245 -- inifinite,
241246 -- i.e. [1..]
242− , stWarnings :: [String]
243247 , stUniqStore :: [Int] -- should be
244248 -- inifinite and
245249 -- contain every
246250 -- element at most
247251 -- once, e.g. [1..]
248− , stMediaBag :: MediaBag
249252 }
250253
251254instance Default PureState where
252255 def = PureState { stStdGen = mkStdGen 1848
253256 , stWord8Store = [1..]
254− , stWarnings = []
255257 , stUniqStore = [1..]
256− , stMediaBag = mempty
257−
258−
259258 }
260259data FileInfo = FileInfo { infoFileMTime :: UTCTime
261260 , infoFileContents :: B.ByteString
@@ -276,8 +275,6 @@ data PureEnv = PureEnv { envEnv :: [(String, String)]
276275 , envUserDataDir :: FileTree
277276 , envCabalDataDir :: FileTree
278277 , envFontFiles :: [FilePath]
279− , envInputFiles :: Maybe [FilePath]
280− , envOutputFile :: Maybe FilePath
281278 }
282279
283280-- We have to figure this out a bit more. But let's put some empty
@@ -292,23 +289,25 @@ instance Default PureEnv where
292289 , envUserDataDir = mempty
293290 , envCabalDataDir = mempty
294291 , envFontFiles = []
295− , envInputFiles = Nothing
296− , envOutputFile = Nothing
297292 }
298293
299294newtype PandocPure a = PandocPure {
300295 unPandocPure :: ExceptT PandocError
301− (ReaderT PureEnv (State PureState)) a
296+ (ReaderT PureEnv (StateT CommonState (State PureState))) a
302297 } deriving ( Functor
303298 , Applicative
304299 , Monad
305300 , MonadReader PureEnv
306− , MonadState PureState
301+ , MonadState CommonState
307302 , MonadError PandocError
308303 )
309304
310305runPure :: PandocPure a -> Either PandocError a
311−runPure x = flip evalState def $ flip runReaderT def $ runExceptT $ unPandocPure x
306+runPure x = flip evalState def $
307+ flip evalStateT def $
308+ flip runReaderT def $
309+ runExceptT $
310+ unPandocPure x
312311
313312instance PandocMonad PandocPure where
314313 lookupEnv s = do
@@ -323,17 +322,17 @@ instance PandocMonad PandocPure where
323322
324323 getDefaultReferenceODT _ = asks envReferenceODT
325324
326− newStdGen = do
327− g <- gets stStdGen
325+ newStdGen = PandocPure $ do
326+ g <- lift $ lift $ lift $ gets stStdGen
328327 let (_, nxtGen) = next g
329− modify $ \st -> st { stStdGen = nxtGen }
328+ lift $ lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
330329 return g
331330
332− newUniqueHash = do
333− uniqs <- gets stUniqStore
331+ newUniqueHash = PandocPure $ do
332+ uniqs <- lift $ lift $ lift $ gets stUniqStore
334333 case uniqs of
335334 u : us -> do
336− modify $ \st -> st { stUniqStore = us }
335+ lift $ lift $ lift $ modify $ \st -> st { stUniqStore = us }
337336 return u
338337 _ -> M.fail "uniq store ran out of elements"
339338 readFileLazy fp = do
@@ -365,10 +364,6 @@ instance PandocMonad PandocPure where
365364 Nothing -> fetchItem sourceUrl nm
366365 Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
367366
368− warn s = modify $ \st -> st { stWarnings = s : stWarnings st }
369−
370− getWarnings = gets stWarnings
371−
372367 glob s = do
373368 fontFiles <- asks envFontFiles
374369 return (filter (match (compile s)) fontFiles)
@@ -379,19 +374,6 @@ instance PandocMonad PandocPure where
379374 Just tm -> return tm
380375 Nothing -> throwError $ PandocFileReadError fp
381376
382− -- Common files
383−
384− setMediaBag mb =
385− modify $ \st -> st{stMediaBag = mb}
386−
387− getMediaBag = gets stMediaBag
388−
389− insertMedia fp mime bs =
390− modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
391−
392− getInputFiles = asks envInputFiles
393−
394− getOutputFile = asks envOutputFile
395377
396378
397379