git.iko.soy/typeable/pandoc
on master help sign in
Remove reader from PandocPure.
5a81c91Jesse Rosenthal
src/Text/Pandoc/Class.hs+43−50
compare with master
unifiedsplit
@@ -34,7 +34,6 @@ Typeclass for pandoc readers and writers, allowing both IO and pure instances.
34module Text.Pandoc.Class ( PandocMonad(..)
34module Text.Pandoc.Class ( PandocMonad(..)
35 , CommonState(..)
35 , CommonState(..)
36 , PureState(..)
36 , PureState(..)
37− , PureEnv(..)
38 , getPOSIXTime
37 , getPOSIXTime
39 , getZonedTime
38 , getZonedTime
40 , warn
39 , warn
@@ -86,7 +85,6 @@ import System.FilePath ((</>))
86import qualified System.FilePath.Glob as IO (glob)
85import qualified System.FilePath.Glob as IO (glob)
87import qualified System.Directory as IO (getModificationTime)
86import qualified System.Directory as IO (getModificationTime)
88import Control.Monad.State hiding (fail)
87import Control.Monad.State hiding (fail)
89−import Control.Monad.Reader hiding (fail)
90import Control.Monad.Except hiding (fail)
88import Control.Monad.Except hiding (fail)
91import Data.Word (Word8)
89import Data.Word (Word8)
92import Data.Default
90import Data.Default
@@ -250,12 +248,30 @@ data PureState = PureState { stStdGen :: StdGen
250 -- contain every
248 -- contain every
251 -- element at most
249 -- element at most
252 -- once, e.g. [1..]
250 -- once, e.g. [1..]
251+ , envEnv :: [(String, String)]
252+ , envTime :: UTCTime
253+ , envTimeZone :: TimeZone
254+ , envReferenceDocx :: Archive
255+ , envReferenceODT :: Archive
256+ , envFiles :: FileTree
257+ , envUserDataDir :: FileTree
258+ , envCabalDataDir :: FileTree
259+ , envFontFiles :: [FilePath]
253 }
260 }
254
261
255instance Default PureState where
262instance Default PureState where
256 def = PureState { stStdGen = mkStdGen 1848
263 def = PureState { stStdGen = mkStdGen 1848
257 , stWord8Store = [1..]
264 , stWord8Store = [1..]
258 , stUniqStore = [1..]
265 , stUniqStore = [1..]
266+ , envEnv = [("USER", "pandoc-user")]
267+ , envTime = posixSecondsToUTCTime 0
268+ , envTimeZone = utc
269+ , envReferenceDocx = emptyArchive
270+ , envReferenceODT = emptyArchive
271+ , envFiles = mempty
272+ , envUserDataDir = mempty
273+ , envCabalDataDir = mempty
274+ , envFontFiles = []
259 }
275 }
260data FileInfo = FileInfo { infoFileMTime :: UTCTime
276data FileInfo = FileInfo { infoFileMTime :: UTCTime
261 , infoFileContents :: B.ByteString
277 , infoFileContents :: B.ByteString
@@ -267,38 +283,13 @@ newtype FileTree = FileTree {unFileTree :: M.Map FilePath FileInfo}
267getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
283getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
268getFileInfo fp tree = M.lookup fp $ unFileTree tree
284getFileInfo fp tree = M.lookup fp $ unFileTree tree
269
285
270−data PureEnv = PureEnv { envEnv :: [(String, String)]
271− , envTime :: UTCTime
272− , envTimeZone :: TimeZone
273− , envReferenceDocx :: Archive
274− , envReferenceODT :: Archive
275− , envFiles :: FileTree
276− , envUserDataDir :: FileTree
277− , envCabalDataDir :: FileTree
278− , envFontFiles :: [FilePath]
279− }
280−
281−-- We have to figure this out a bit more. But let's put some empty
282−-- values in for the time being.
283−instance Default PureEnv where
284− def = PureEnv { envEnv = [("USER", "pandoc-user")]
285− , envTime = posixSecondsToUTCTime 0
286− , envTimeZone = utc
287− , envReferenceDocx = emptyArchive
288− , envReferenceODT = emptyArchive
289− , envFiles = mempty
290− , envUserDataDir = mempty
291− , envCabalDataDir = mempty
292− , envFontFiles = []
293− }
294
286
295newtype PandocPure a = PandocPure {
287newtype PandocPure a = PandocPure {
296 unPandocPure :: ExceptT PandocError
288 unPandocPure :: ExceptT PandocError
297− (ReaderT PureEnv (StateT CommonState (State PureState))) a
289+ (StateT CommonState (State PureState)) a
298 } deriving ( Functor
290 } deriving ( Functor
299 , Applicative
291 , Applicative
300 , Monad
292 , Monad
301− , MonadReader PureEnv
302 , MonadState CommonState
293 , MonadState CommonState
303 , MonadError PandocError
294 , MonadError PandocError
304 )
295 )
@@ -306,38 +297,40 @@ newtype PandocPure a = PandocPure {
306runPure :: PandocPure a -> Either PandocError a
297runPure :: PandocPure a -> Either PandocError a
307runPure x = flip evalState def $
298runPure x = flip evalState def $
308 flip evalStateT def $
299 flip evalStateT def $
309− flip runReaderT def $
310 runExceptT $
300 runExceptT $
311 unPandocPure x
301 unPandocPure x
312
302
303+-- setPureState :: PureState -> PandocPure ()
304+-- setPureState st = PandocPure $ lift $ lift $ lift $ put st
305+
313instance PandocMonad PandocPure where
306instance PandocMonad PandocPure where
314− lookupEnv s = do
307+ lookupEnv s = PandocPure $ do
315− env <- asks envEnv
308+ env <- lift $ lift $ gets envEnv
316 return (lookup s env)
309 return (lookup s env)
317
310
318− getCurrentTime = asks envTime
311+ getCurrentTime = PandocPure $ lift $ lift $ gets envTime
319
312
320− getCurrentTimeZone = asks envTimeZone
313+ getCurrentTimeZone = PandocPure $ lift $ lift $ gets envTimeZone
321
314
322− getDefaultReferenceDocx _ = asks envReferenceDocx
315+ getDefaultReferenceDocx _ = PandocPure $ lift $ lift $ gets envReferenceDocx
323
316
324− getDefaultReferenceODT _ = asks envReferenceODT
317+ getDefaultReferenceODT _ = PandocPure $ lift $ lift $ gets envReferenceODT
325
318
326 newStdGen = PandocPure $ do
319 newStdGen = PandocPure $ do
327− g <- lift $ lift $ lift $ gets stStdGen
320+ g <- lift $ lift $ gets stStdGen
328 let (_, nxtGen) = next g
321 let (_, nxtGen) = next g
329− lift $ lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
322+ lift $ lift $ modify $ \st -> st { stStdGen = nxtGen }
330 return g
323 return g
331
324
332 newUniqueHash = PandocPure $ do
325 newUniqueHash = PandocPure $ do
333− uniqs <- lift $ lift $ lift $ gets stUniqStore
326+ uniqs <- lift $ lift $ gets stUniqStore
334 case uniqs of
327 case uniqs of
335 u : us -> do
328 u : us -> do
336− lift $ lift $ lift $ modify $ \st -> st { stUniqStore = us }
329+ lift $ lift $ modify $ \st -> st { stUniqStore = us }
337 return u
330 return u
338 _ -> M.fail "uniq store ran out of elements"
331 _ -> M.fail "uniq store ran out of elements"
339− readFileLazy fp = do
332+ readFileLazy fp = PandocPure $ do
340− fps <- asks envFiles
333+ fps <- lift $ lift $ gets envFiles
341 case infoFileContents <$> getFileInfo fp fps of
334 case infoFileContents <$> getFileInfo fp fps of
342 Just bs -> return (BL.fromStrict bs)
335 Just bs -> return (BL.fromStrict bs)
343 Nothing -> throwError $ PandocFileReadError fp
336 Nothing -> throwError $ PandocFileReadError fp
@@ -348,14 +341,14 @@ instance PandocMonad PandocPure where
348 readDataFile Nothing fname = do
341 readDataFile Nothing fname = do
349 let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
342 let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
350 BL.toStrict <$> (readFileLazy fname')
343 BL.toStrict <$> (readFileLazy fname')
351− readDataFile (Just userDir) fname = do
344+ readDataFile (Just userDir) fname = PandocPure $ do
352− userDirFiles <- asks envUserDataDir
345+ userDirFiles <- lift $ lift $ gets envUserDataDir
353 case infoFileContents <$> (getFileInfo (userDir </> fname) userDirFiles) of
346 case infoFileContents <$> (getFileInfo (userDir </> fname) userDirFiles) of
354 Just bs -> return bs
347 Just bs -> return bs
355− Nothing -> readDataFile Nothing fname
348+ Nothing -> unPandocPure $ readDataFile Nothing fname
356 fail = M.fail
349 fail = M.fail
357− fetchItem _ fp = do
350+ fetchItem _ fp = PandocPure $ do
358− fps <- asks envFiles
351+ fps <- lift $ lift $ gets envFiles
359 case infoFileContents <$> (getFileInfo fp fps) of
352 case infoFileContents <$> (getFileInfo fp fps) of
360 Just bs -> return (Right (bs, getMimeType fp))
353 Just bs -> return (Right (bs, getMimeType fp))
361 Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
354 Nothing -> return (Left $ E.toException $ PandocFileReadError fp)
@@ -365,12 +358,12 @@ instance PandocMonad PandocPure where
365 Nothing -> fetchItem sourceUrl nm
358 Nothing -> fetchItem sourceUrl nm
366 Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
359 Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
367
360
368− glob s = do
361+ glob s = PandocPure $ do
369− fontFiles <- asks envFontFiles
362+ fontFiles <- lift $ lift $ gets envFontFiles
370 return (filter (match (compile s)) fontFiles)
363 return (filter (match (compile s)) fontFiles)
371
364
372− getModificationTime fp = do
365+ getModificationTime fp = PandocPure $ do
373− fps <- asks envFiles
366+ fps <- lift $ lift $ gets envFiles
374 case infoFileMTime <$> (getFileInfo fp fps) of
367 case infoFileMTime <$> (getFileInfo fp fps) of
375 Just tm -> return tm
368 Just tm -> return tm
376 Nothing -> throwError $ PandocFileReadError fp
369 Nothing -> throwError $ PandocFileReadError fp