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
  -- TODO: Can we constrain this to run Lua code purely (embedded) without using IO?
  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
    -- `runIO` can throw `PandocError`. Fix this nonsense behaviour, by catching
    -- it and returning a `Left`.
    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