{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Text.Pandoc.Class.PandocIO
( PandocIO(..)
, runIO
, runIOorExplode
, extractMedia
) where
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (StateT, evalStateT, lift, get, put)
import Data.Default (Default (def))
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Definition
import Text.Pandoc.Error
import qualified Text.Pandoc.Class.IO as IO
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
runIO :: PandocIO a -> IO (Either PandocError a)
runIO :: forall a. PandocIO a -> IO (Either PandocError a)
runIO PandocIO a
ma = (StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a))
-> CommonState
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a))
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a))
-> ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
forall a.
PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO PandocIO a
ma
runIOorExplode :: PandocIO a -> IO a
runIOorExplode :: forall a. PandocIO a -> IO a
runIOorExplode PandocIO a
ma = PandocIO a -> IO (Either PandocError a)
forall a. PandocIO a -> IO (Either PandocError a)
runIO PandocIO a
ma IO (Either PandocError a) -> (Either PandocError a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either PandocError a -> IO a
forall a. Either PandocError a -> IO a
handleError
newtype PandocIO a = PandocIO {
forall a.
PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO :: ExceptT PandocError (StateT CommonState IO) a
} deriving ( Monad PandocIO
Monad PandocIO =>
(forall a. IO a -> PandocIO a) -> MonadIO PandocIO
forall a. IO a -> PandocIO a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> PandocIO a
liftIO :: forall a. IO a -> PandocIO a
MonadIO
, (forall a b. (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b. a -> PandocIO b -> PandocIO a) -> Functor PandocIO
forall a b. a -> PandocIO b -> PandocIO a
forall a b. (a -> b) -> PandocIO a -> PandocIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PandocIO a -> PandocIO b
fmap :: forall a b. (a -> b) -> PandocIO a -> PandocIO b
$c<$ :: forall a b. a -> PandocIO b -> PandocIO a
<$ :: forall a b. a -> PandocIO b -> PandocIO a
Functor
, Functor PandocIO
Functor PandocIO =>
(forall a. a -> PandocIO a)
-> (forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO a)
-> Applicative PandocIO
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> PandocIO a
pure :: forall a. a -> PandocIO a
$c<*> :: forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
<*> :: forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
liftA2 :: forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
$c*> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
*> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
$c<* :: forall a b. PandocIO a -> PandocIO b -> PandocIO a
<* :: forall a b. PandocIO a -> PandocIO b -> PandocIO a
Applicative
, Applicative PandocIO
Applicative PandocIO =>
(forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a. a -> PandocIO a)
-> Monad PandocIO
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
>>= :: forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
$c>> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
>> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
$creturn :: forall a. a -> PandocIO a
return :: forall a. a -> PandocIO a
Monad
, MonadThrow PandocIO
MonadThrow PandocIO =>
(forall e a.
(HasCallStack, Exception e) =>
PandocIO a -> (e -> PandocIO a) -> PandocIO a)
-> MonadCatch PandocIO
forall e a.
(HasCallStack, Exception e) =>
PandocIO a -> (e -> PandocIO a) -> PandocIO a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
PandocIO a -> (e -> PandocIO a) -> PandocIO a
catch :: forall e a.
(HasCallStack, Exception e) =>
PandocIO a -> (e -> PandocIO a) -> PandocIO a
MonadCatch
, MonadCatch PandocIO
MonadCatch PandocIO =>
(forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b)
-> (forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b)
-> (forall a b c.
HasCallStack =>
PandocIO a
-> (a -> ExitCase b -> PandocIO c)
-> (a -> PandocIO b)
-> PandocIO (b, c))
-> MonadMask PandocIO
forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b
forall a b c.
HasCallStack =>
PandocIO a
-> (a -> ExitCase b -> PandocIO c)
-> (a -> PandocIO b)
-> PandocIO (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b
mask :: forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. PandocIO a -> PandocIO a) -> PandocIO b) -> PandocIO b
$cgeneralBracket :: forall a b c.
HasCallStack =>
PandocIO a
-> (a -> ExitCase b -> PandocIO c)
-> (a -> PandocIO b)
-> PandocIO (b, c)
generalBracket :: forall a b c.
HasCallStack =>
PandocIO a
-> (a -> ExitCase b -> PandocIO c)
-> (a -> PandocIO b)
-> PandocIO (b, c)
MonadMask
, Monad PandocIO
Monad PandocIO =>
(forall e a. (HasCallStack, Exception e) => e -> PandocIO a)
-> MonadThrow PandocIO
forall e a. (HasCallStack, Exception e) => e -> PandocIO a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> PandocIO a
throwM :: forall e a. (HasCallStack, Exception e) => e -> PandocIO a
MonadThrow
, MonadError PandocError
)
instance PandocMonad PandocIO where
lookupEnv :: Text -> PandocIO (Maybe Text)
lookupEnv = Text -> PandocIO (Maybe Text)
forall (m :: * -> *). MonadIO m => Text -> m (Maybe Text)
IO.lookupEnv
getCurrentTime :: PandocIO UTCTime
getCurrentTime = PandocIO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
IO.getCurrentTime
getCurrentTimeZone :: PandocIO TimeZone
getCurrentTimeZone = PandocIO TimeZone
forall (m :: * -> *). MonadIO m => m TimeZone
IO.getCurrentTimeZone
newStdGen :: PandocIO StdGen
newStdGen = PandocIO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
IO.newStdGen
newUniqueHash :: PandocIO Int
newUniqueHash = PandocIO Int
forall (m :: * -> *). MonadIO m => m Int
IO.newUniqueHash
openURL :: Text -> PandocIO (ByteString, Maybe Text)
openURL = Text -> PandocIO (ByteString, Maybe Text)
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Text -> m (ByteString, Maybe Text)
IO.openURL
readFileLazy :: FilePath -> PandocIO ByteString
readFileLazy = FilePath -> PandocIO ByteString
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m ByteString
IO.readFileLazy
readFileStrict :: FilePath -> PandocIO ByteString
readFileStrict = FilePath -> PandocIO ByteString
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m ByteString
IO.readFileStrict
readStdinStrict :: PandocIO ByteString
readStdinStrict = PandocIO ByteString
forall (m :: * -> *). (PandocMonad m, MonadIO m) => m ByteString
IO.readStdinStrict
glob :: FilePath -> PandocIO [FilePath]
glob = FilePath -> PandocIO [FilePath]
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m [FilePath]
IO.glob
fileExists :: FilePath -> PandocIO Bool
fileExists = FilePath -> PandocIO Bool
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m Bool
IO.fileExists
getDataFileName :: FilePath -> PandocIO FilePath
getDataFileName = FilePath -> PandocIO FilePath
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m FilePath
IO.getDataFileName
getModificationTime :: FilePath -> PandocIO UTCTime
getModificationTime = FilePath -> PandocIO UTCTime
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m UTCTime
IO.getModificationTime
getCommonState :: PandocIO CommonState
getCommonState = ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState)
-> ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a b. (a -> b) -> a -> b
$ StateT CommonState IO CommonState
-> ExceptT PandocError (StateT CommonState IO) CommonState
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT CommonState IO CommonState
forall s (m :: * -> *). MonadState s m => m s
get
putCommonState :: CommonState -> PandocIO ()
putCommonState = ExceptT PandocError (StateT CommonState IO) () -> PandocIO ()
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) () -> PandocIO ())
-> (CommonState -> ExceptT PandocError (StateT CommonState IO) ())
-> CommonState
-> PandocIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ())
-> (CommonState -> StateT CommonState IO ())
-> CommonState
-> ExceptT PandocError (StateT CommonState IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> StateT CommonState IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
logOutput :: LogMessage -> PandocIO ()
logOutput = LogMessage -> PandocIO ()
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
LogMessage -> m ()
IO.logOutput
extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
= FilePath -> Pandoc -> m Pandoc
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> Pandoc -> m Pandoc
IO.extractMedia