diff options
| -rw-r--r-- | pandoc.hs | 17 | ||||
| -rw-r--r-- | src/Text/Pandoc/Class.hs | 12 |
2 files changed, 21 insertions, 8 deletions
@@ -70,7 +70,6 @@ import Data.Yaml (decode) import qualified Data.Yaml as Yaml import qualified Data.Text as T import Control.Applicative ((<|>)) -import Text.Pandoc.Readers.Txt2Tags (getT2TMeta) import Paths_pandoc (getDataDir) import Text.Printf (printf) #ifndef _WINDOWS @@ -78,8 +77,7 @@ import System.Posix.Terminal (queryTerminal) import System.Posix.IO (stdOutput) #endif import Control.Monad.Trans -import Text.Pandoc.Class (runIOorExplode, PandocMonad, PandocIO) -import qualified Text.Pandoc.Class as P +import Text.Pandoc.Class (runIOorExplode, withMediaBag, PandocIO) type Transform = Pandoc -> Pandoc @@ -916,7 +914,7 @@ options = map ("--" ++) longs let allopts = unwords (concatMap optnames options) UTF8.hPutStrLn stdout $ printf tpl allopts - (unwords (map fst readers)) + (unwords (map fst (readers :: [(String, Reader PandocIO)]))) (unwords (map fst (writers :: [(String, Writer PandocIO)]))) (unwords $ map fst highlightingStyles) ddir @@ -926,7 +924,7 @@ options = , Option "" ["list-input-formats"] (NoArg (\_ -> do - let readers'names = sort (map fst readers) + let readers'names = sort (map fst (readers :: [(String, Reader PandocIO)])) mapM_ (UTF8.hPutStrLn stdout) readers'names exitSuccess )) "" @@ -1410,13 +1408,16 @@ convertWithOpts opts args = do else return . Right let sourceToDoc :: [FilePath] -> IO (Pandoc, MediaBag) - sourceToDoc sources' = fmap handleError $ + sourceToDoc sources' = case reader of StringReader r-> do srcs <- convertTabs . intercalate "\n" <$> readSources sources' doc <- handleIncludes' srcs - either (return . Left) (\s -> fmap (,mempty) <$> r readerOpts s) doc - ByteStringReader r -> readFiles sources' >>= r readerOpts + case doc of + Right doc' -> runIOorExplode $ withMediaBag $ r readerOpts doc' + Left e -> error $ show e + ByteStringReader r -> readFiles sources' >>= + (\bs -> runIOorExplode $ withMediaBag $ r readerOpts bs) -- We parse first if (1) fileScope is set, (2), it's a binary -- reader, or (3) we're reading JSON. This is easier to do of an AND diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 0abd0361e..12566a51c 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -44,6 +44,7 @@ module Text.Pandoc.Class ( PandocMonad(..) , runIO , runIOorExplode , runPure + , withMediaBag ) where import Prelude hiding (readFile, fail) @@ -115,6 +116,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) => -- to the record names, so I'd like to work out a better way to deal -- with it. setMediaBag :: MediaBag -> m () + getMediaBag :: m MediaBag insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m () getInputFiles :: m (Maybe [FilePath]) getOutputFile :: m (Maybe FilePath) @@ -169,6 +171,9 @@ instance Default PandocEnvIO where runIO :: PandocIO a -> IO (Either PandocExecutionError a) runIO ma = flip evalStateT def $ flip runReaderT def $ runExceptT $ unPandocIO ma +withMediaBag :: PandocMonad m => m a -> m (a, MediaBag) +withMediaBag ma = ((,)) <$> ma <*> getMediaBag + runIOorExplode :: PandocIO a -> IO a runIOorExplode ma = do eitherVal <- runIO ma @@ -179,6 +184,10 @@ runIOorExplode ma = do Left (PandocParseError s) -> error $ "parse error" ++ s Left (PandocSomeError s) -> error s + + + + newtype PandocIO a = PandocIO { unPandocIO :: ExceptT PandocExecutionError (ReaderT PandocEnvIO (StateT PandocStateIO IO)) a } deriving ( MonadIO @@ -225,6 +234,7 @@ instance PandocMonad PandocIO where -- Common functions setMediaBag mb = modify $ \st -> st{ioStMediaBag = mb} + getMediaBag = gets ioStMediaBag insertMedia fp mime bs = modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) } getInputFiles = asks ioEnvInputFiles @@ -383,6 +393,8 @@ instance PandocMonad PandocPure where setMediaBag mb = modify $ \st -> st{stMediaBag = mb} + getMediaBag = gets stMediaBag + insertMedia fp mime bs = modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) } |