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 <- (FilePath -> m (Either Text Filter))
-> [FilePath] -> m [Either Text Filter]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m (Either Text Filter)
forall (m :: Type -> Type).
MonadIO m =>
FilePath -> m (Either Text Filter)
mkLuaFilter [FilePath]
paths
  [Text] -> (Text -> m ()) -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Either Text Filter] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text Filter]
res) ((Text -> m ()) -> m ()) -> (Text -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Text
err ->
    [Text] -> m ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell [Text
err]
  case [Either Text Filter] -> [Filter]
forall a b. [Either a b] -> [b]
rights [Either Text Filter]
res of
    [] ->
      Pandoc -> m Pandoc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Pandoc
doc
    [Filter]
filters ->
      [Filter] -> Pandoc -> m (Either Text Pandoc)
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
[Filter] -> Pandoc -> m (Either Text Pandoc)
applyPandocLuaFilters [Filter]
filters Pandoc
doc m (Either Text Pandoc)
-> (Either Text Pandoc -> m Pandoc) -> m Pandoc
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
err -> [Text] -> m ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell [Text
err] m () -> m Pandoc -> m Pandoc
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Pandoc -> m Pandoc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Pandoc
doc
        Right Pandoc
x -> Pandoc -> m Pandoc
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 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".lua"
    then do
      IO Bool -> m Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
relPath) m Bool
-> (Bool -> m (Either Text Filter)) -> m (Either Text Filter)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> Either Text Filter -> m (Either Text Filter)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either Text Filter -> m (Either Text Filter))
-> Either Text Filter -> m (Either Text Filter)
forall a b. (a -> b) -> a -> b
$ Filter -> Either Text Filter
forall a b. b -> Either a b
Right (Filter -> Either Text Filter) -> Filter -> Either Text Filter
forall a b. (a -> b) -> a -> b
$ FilePath -> Filter
PF.LuaFilter FilePath
relPath
        Bool
False -> Either Text Filter -> m (Either Text Filter)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either Text Filter -> m (Either Text Filter))
-> Either Text Filter -> m (Either Text Filter)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Filter
forall a b. a -> Either a b
Left (Text -> Either Text Filter) -> Text -> Either Text Filter
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Lua filter missing: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
relPath
    else Either Text Filter -> m (Either Text Filter)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either Text Filter -> m (Either Text Filter))
-> Either Text Filter -> m (Either Text Filter)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Filter
forall a b. a -> Either a b
Left (Text -> Either Text Filter) -> Text -> Either Text Filter
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported filter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
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
  Text -> m ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logW (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"[Experimental feature] Applying pandoc filters: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Filter] -> Text
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?
  IO (Either PandocError Pandoc) -> m (Either PandocError Pandoc)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall {b}. PandocIO b -> IO (Either PandocError b)
runIOCatchingErrors (PandocIO Pandoc -> IO (Either PandocError Pandoc))
-> PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ Environment -> [Filter] -> [FilePath] -> Pandoc -> PandocIO Pandoc
forall (m :: Type -> Type).
(PandocMonad m, MonadIO m) =>
Environment -> [Filter] -> [FilePath] -> Pandoc -> m Pandoc
PF.applyFilters Environment
forall a. Default a => a
def [Filter]
filters [FilePath
"markdown"] Pandoc
x) m (Either PandocError Pandoc)
-> (Either PandocError Pandoc -> m (Either Text Pandoc))
-> m (Either Text Pandoc)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left PandocError
err -> do
      Text -> m ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logE (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error applying pandoc filters: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PandocError -> Text
forall b a. (Show a, IsString b) => a -> b
show PandocError
err
      Either Text Pandoc -> m (Either Text Pandoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either Text Pandoc -> m (Either Text Pandoc))
-> Either Text Pandoc -> m (Either Text Pandoc)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Pandoc
forall a b. a -> Either a b
Left (PandocError -> Text
forall b a. (Show a, IsString b) => a -> b
show PandocError
err)
    Right Pandoc
x' -> Either Text Pandoc -> m (Either Text Pandoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either Text Pandoc -> m (Either Text Pandoc))
-> Either Text Pandoc -> m (Either Text Pandoc)
forall a b. (a -> b) -> a -> b
$ Pandoc -> Either Text Pandoc
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 =
      (PandocError -> IO (Either PandocError b))
-> IO (Either PandocError b) -> IO (Either PandocError b)
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (Either PandocError b -> IO (Either PandocError b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either PandocError b -> IO (Either PandocError b))
-> (PandocError -> Either PandocError b)
-> PandocError
-> IO (Either PandocError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> Either PandocError b
forall a b. a -> Either a b
Left) (IO (Either PandocError b) -> IO (Either PandocError b))
-> (PandocIO b -> IO (Either PandocError b))
-> PandocIO b
-> IO (Either PandocError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocIO b -> IO (Either PandocError b)
forall {b}. PandocIO b -> IO (Either PandocError b)
runIO