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:
parent
9d9f615593
commit
6a9a38c92d
1 changed files with 48 additions and 12 deletions
|
@ -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
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue