module Emanote.Model.Note.Filter (applyPandocFilters) where
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Writer.Strict (MonadWriter (tell))
import Data.Default (def)
import Emanote.Prelude (logE, logW)
import Relude
import System.Directory (doesFileExist)
import System.FilePath (takeExtension)
import Text.Pandoc (runIO)
import Text.Pandoc.Definition (Pandoc (..))
import Text.Pandoc.Filter qualified as PF
import UnliftIO.Exception (handle)
applyPandocFilters :: (MonadIO m, MonadLogger m, MonadWriter [Text] m) => [FilePath] -> Pandoc -> m Pandoc
applyPandocFilters :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m, MonadWriter [Text] m) =>
[FilePath] -> Pandoc -> m Pandoc
applyPandocFilters [FilePath]
paths Pandoc
doc = do
[Either Text Filter]
res <- forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: Type -> Type).
MonadIO m =>
FilePath -> m (Either Text Filter)
mkLuaFilter [FilePath]
paths
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [Either a b] -> [a]
lefts [Either Text Filter]
res) forall a b. (a -> b) -> a -> b
$ \Text
err ->
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell [Text
err]
case forall a b. [Either a b] -> [b]
rights [Either Text Filter]
res of
[] ->
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Pandoc
doc
[Filter]
filters ->
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
[Filter] -> Pandoc -> m (Either Text Pandoc)
applyPandocLuaFilters [Filter]
filters Pandoc
doc forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell [Text
err] forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Pandoc
doc
Right Pandoc
x -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Pandoc
x
mkLuaFilter :: MonadIO m => FilePath -> m (Either Text PF.Filter)
mkLuaFilter :: forall (m :: Type -> Type).
MonadIO m =>
FilePath -> m (Either Text Filter)
mkLuaFilter FilePath
relPath = do
if FilePath -> FilePath
takeExtension FilePath
relPath forall a. Eq a => a -> a -> Bool
== FilePath
".lua"
then do
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
relPath) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FilePath -> Filter
PF.LuaFilter FilePath
relPath
Bool
False -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ FilePath
"Lua filter missing: " forall a. Semigroup a => a -> a -> a
<> FilePath
relPath
else forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unsupported filter: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
relPath
applyPandocLuaFilters :: (MonadIO m, MonadLogger m) => [PF.Filter] -> Pandoc -> m (Either Text Pandoc)
applyPandocLuaFilters :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
[Filter] -> Pandoc -> m (Either Text Pandoc)
applyPandocLuaFilters [Filter]
filters Pandoc
x = do
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logW forall a b. (a -> b) -> a -> b
$ Text
"[Experimental feature] Applying pandoc filters: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [Filter]
filters
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (forall {b}. PandocIO b -> IO (Either PandocError b)
runIOCatchingErrors forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
(PandocMonad m, MonadIO m) =>
Environment -> [Filter] -> [FilePath] -> Pandoc -> m Pandoc
PF.applyFilters forall a. Default a => a
def [Filter]
filters [FilePath
"markdown"] Pandoc
x) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left PandocError
err -> do
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logE forall a b. (a -> b) -> a -> b
$ Text
"Error applying pandoc filters: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show PandocError
err
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall b a. (Show a, IsString b) => a -> b
show PandocError
err)
Right Pandoc
x' -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Pandoc
x'
where
runIOCatchingErrors :: PandocIO b -> IO (Either PandocError b)
runIOCatchingErrors =
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. PandocIO b -> IO (Either PandocError b)
runIO