Add input and output filepaths to PandocMonad.

We'll want these in a number of places, but right now it will be
necessary for the macros in T2T.
This commit is contained in:
Jesse Rosenthal 2016-11-30 12:55:30 -05:00 committed by John MacFarlane
parent 9d9f615593
commit 6a9a38c92d

View file

@ -110,9 +110,15 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) =>
getWarnings :: m [String] getWarnings :: m [String]
fail :: String -> m b fail :: String -> m b
glob :: String -> m [FilePath] glob :: String -> m [FilePath]
getModificationTime :: FilePath -> m UTCTime
-- The following are common to all instantiations of the monad, up
-- to the record names, so I'd like to work out a better way to deal
-- with it.
setMediaBag :: MediaBag -> m () setMediaBag :: MediaBag -> m ()
insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m () insertMedia :: FilePath -> Maybe MimeType -> BL.ByteString -> m ()
getModificationTime :: FilePath -> m UTCTime getInputFiles :: m (Maybe [FilePath])
getOutputFile :: m (Maybe FilePath)
--Some functions derived from Primitives: --Some functions derived from Primitives:
@ -152,8 +158,16 @@ instance Default PandocStateIO where
, ioStMediaBag = mempty , ioStMediaBag = mempty
} }
data PandocEnvIO = PandocEnvIO { ioEnvInputFiles :: Maybe [FilePath]
, ioEnvOutputFile :: Maybe FilePath
}
instance Default PandocEnvIO where
def = PandocEnvIO { ioEnvInputFiles = Nothing -- stdin
, ioEnvOutputFile = Nothing -- stdout
}
runIO :: PandocIO a -> IO (Either PandocExecutionError a) runIO :: PandocIO a -> IO (Either PandocExecutionError a)
runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma runIO ma = flip evalStateT def $ flip runReaderT def $ runExceptT $ unPandocIO ma
runIOorExplode :: PandocIO a -> IO a runIOorExplode :: PandocIO a -> IO a
runIOorExplode ma = do runIOorExplode ma = do
@ -166,11 +180,12 @@ runIOorExplode ma = do
Left (PandocSomeError s) -> error s Left (PandocSomeError s) -> error s
newtype PandocIO a = PandocIO { newtype PandocIO a = PandocIO {
unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a unPandocIO :: ExceptT PandocExecutionError (ReaderT PandocEnvIO (StateT PandocStateIO IO)) a
} deriving ( MonadIO } deriving ( MonadIO
, Functor , Functor
, Applicative , Applicative
, Monad , Monad
, MonadReader PandocEnvIO
, MonadState PandocStateIO , MonadState PandocStateIO
, MonadError PandocExecutionError , MonadError PandocExecutionError
) )
@ -202,15 +217,20 @@ instance PandocMonad PandocIO where
liftIO $ IO.warn msg liftIO $ IO.warn msg
getWarnings = gets ioStWarnings getWarnings = gets ioStWarnings
glob = liftIO . IO.glob glob = liftIO . IO.glob
setMediaBag mb =
modify $ \st -> st{ioStMediaBag = mb}
insertMedia fp mime bs =
modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
getModificationTime fp = do getModificationTime fp = do
eitherMtime <- liftIO (tryIOError $ IO.getModificationTime fp) eitherMtime <- liftIO (tryIOError $ IO.getModificationTime fp)
case eitherMtime of case eitherMtime of
Right mtime -> return mtime Right mtime -> return mtime
Left _ -> throwError $ PandocFileReadError fp Left _ -> throwError $ PandocFileReadError fp
-- Common functions
setMediaBag mb =
modify $ \st -> st{ioStMediaBag = mb}
insertMedia fp mime bs =
modify $ \st -> st{ioStMediaBag = MB.insertMedia fp mime bs (ioStMediaBag st) }
getInputFiles = asks ioEnvInputFiles
getOutputFile = asks ioEnvOutputFile
data PureState = PureState { stStdGen :: StdGen data PureState = PureState { stStdGen :: StdGen
, stWord8Store :: [Word8] -- should be , stWord8Store :: [Word8] -- should be
@ -253,6 +273,8 @@ data PureEnv = PureEnv { envEnv :: [(String, String)]
, envUserDataDir :: FileTree , envUserDataDir :: FileTree
, envCabalDataDir :: FileTree , envCabalDataDir :: FileTree
, envFontFiles :: [FilePath] , envFontFiles :: [FilePath]
, envInputFiles :: Maybe [FilePath]
, envOutputFile :: Maybe FilePath
} }
-- We have to figure this out a bit more. But let's put some empty -- We have to figure this out a bit more. But let's put some empty
@ -267,6 +289,8 @@ instance Default PureEnv where
, envUserDataDir = mempty , envUserDataDir = mempty
, envCabalDataDir = mempty , envCabalDataDir = mempty
, envFontFiles = [] , envFontFiles = []
, envInputFiles = Nothing
, envOutputFile = Nothing
} }
instance E.Exception PandocExecutionError instance E.Exception PandocExecutionError
@ -348,14 +372,26 @@ instance PandocMonad PandocPure where
fontFiles <- asks envFontFiles fontFiles <- asks envFontFiles
return (filter (match (compile s)) fontFiles) return (filter (match (compile s)) fontFiles)
getModificationTime fp = do
fps <- asks envFiles
case infoFileMTime <$> (getFileInfo fp fps) of
Just tm -> return tm
Nothing -> throwError $ PandocFileReadError fp
-- Common files
setMediaBag mb = setMediaBag mb =
modify $ \st -> st{stMediaBag = mb} modify $ \st -> st{stMediaBag = mb}
insertMedia fp mime bs = insertMedia fp mime bs =
modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) } modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
getModificationTime fp = do getInputFiles = asks envInputFiles
fps <- asks envFiles
case infoFileMTime <$> (getFileInfo fp fps) of getOutputFile = asks envOutputFile
Just tm -> return tm
Nothing -> throwError $ PandocFileReadError fp