{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | This module contains some utility functions to work with different levels
-- of Pandoc filters. For example, for the conversion from @'Inline' ->
-- ['Inline']@ to @'Pandoc' -> 'Pandoc'@ filter.
--
-- If you don't need to compose filters and only want to convert between Pandoc
-- filter functions, just use 'convertFilter' and 'convertFilterM'.
--
-- However, if you are working with multiple Pandoc filters of different type
-- and want to compose them, this module also provides a monoid wrapper type
-- 'PartialFilterM', which I call a "wrapped filter", and a few functions to
-- apply, compose, and convert them.
module Text.Pandoc.Filter.Utils (
  -- * Filter function conversion
  convertFilter,
  convertFilterM,
  -- * Wrapped filter definitions
  PartialFilter,
  PandocFilter,
  PartialFilterM,
  PandocFilterM,
  -- * Filter function → Wrapped filter
  ToPartialFilter (..),
  mkConcatedFilter,
  -- * Wrapped filter application/composition
  applyFilter,
  applyFilters,
  applyFilterM,
  applyFiltersM,
  -- * Wrapped filter → filter function
  getFilter,
  getConcatedFilter,
  getFilterM,
  getConcatedFilterM,
  -- * Wrapped filter conversion
  toFilterM,
  ) where

import Control.Monad          ((>=>))
import Data.Foldable          (fold)
import Data.Functor.Identity  (Identity (..))
import Text.Pandoc.Definition
import Text.Pandoc.Walk

-- | @PartialFilterM m p@ is a wrapper for any monadic @p -> m p@ Pandoc
-- filters acting on a subnode (e.g. 'Inline' or 'Block') of the 'Pandoc'
-- abstract syntax tree. On this page, we will call it a "wrapped" filter to
-- distinguish it from filter functions @a -> m b@.
--
-- * @m@: a monad.
-- * @p@: the type of a subnode of 'Pandoc' (e.g. 'Inline').
newtype PartialFilterM m p =
  PartialFilterM
    { -- | Apply a monadic filter to @p@.
      PartialFilterM m p -> p -> m p
applyFilterM :: p -> m p
    }

-- | @PartialFilter p@ is a wrapper for ordinary @p -> p@ Pandoc filters acting
-- on a subnode (e.g. 'Inline' or 'Block') of the 'Pandoc' abstract syntax
-- tree. On this page, we will call it a "wrapped" filter to distinguish it
-- from filter functions @a -> b@.
--
-- * @p@: the type of a subnode of 'Pandoc' (e.g. 'Inline').
type PartialFilter = PartialFilterM Identity

-- | An alias for @PartialFilter Pandoc@. It encapsulates a monadic
-- filter @'Pandoc' -> m 'Pandoc'@ acting directly on 'Pandoc'.
--
-- * @m@: a monad.
type PandocFilter = PartialFilter Pandoc

-- | An alias for @PartialFilterM m Pandoc@, a monadic version of
-- 'PandocFilter'.
--
-- * @m@: a monad.
type PandocFilterM m = PartialFilterM m Pandoc

-- | Apply a wrapped filter to @p@, which returns @p@ directly.
applyFilter
  :: PartialFilter p -- ^ A wrapped filter.
  -> p               -- ^ 'Pandoc' AST node.
  -> p               -- ^ Transformed node.
applyFilter :: PartialFilter p -> p -> p
applyFilter = (Identity p -> p
forall a. Identity a -> a
runIdentity (Identity p -> p) -> (p -> Identity p) -> p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((p -> Identity p) -> p -> p)
-> (PartialFilter p -> p -> Identity p)
-> PartialFilter p
-> p
-> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialFilter p -> p -> Identity p
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM

-- | It is mostly the same as 'applyFilterM', which converts a wrapped monadic
-- filter to a monadic filter function, but it should be used when you don't
-- need to apply the filter immediately. There is a slight difference in that
-- it will perform an implicit conversion if the requested filter function is
-- of a different type.
--
-- For example, it can be used to convert a wrapped monadic filter
-- @'PartialFilterM' 'IO' 'Inline'@ to monadic filter function @'Block' -> 'IO'
-- 'Block'@.
getFilterM
  :: (Monad m, Walkable a b)
  => PartialFilterM m a -- ^ A wrapped filter on @a@.
  -> (b -> m b)         -- ^ Filter function that can be directly applied to @b@.
getFilterM :: PartialFilterM m a -> b -> m b
getFilterM = PartialFilterM m b -> b -> m b
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM (PartialFilterM m b -> b -> m b)
-> (PartialFilterM m a -> PartialFilterM m b)
-> PartialFilterM m a
-> b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialFilterM m a -> PartialFilterM m b
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter

-- | It is mostly the same as 'applyFilter', which converts a wrapped filter to
-- a filter function, but it should be used when you don't need to apply the
-- filter immediately. There is a slight difference in that it will perform an
-- implicit conversion if the requested filter function is of a different type.
--
-- For example, it can be used to convert a wrapped filter @'PartialFilter'
-- 'Inline'@ to filter function @'Block' -> 'Block'@.
getFilter
  :: (Walkable a b)
  => PartialFilter a -- ^ A wrapped partial filter on @a@.
  -> (b -> b)        -- ^ Filter function that can be directly applied to @b@.
getFilter :: PartialFilter a -> b -> b
getFilter = PartialFilter b -> b -> b
forall p. PartialFilter p -> p -> p
applyFilter (PartialFilter b -> b -> b)
-> (PartialFilter a -> PartialFilter b)
-> PartialFilter a
-> b
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialFilter a -> PartialFilter b
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter

-- | The 'Semigroup' instance of `PartialFilterM`. @f1 <> f2@ will apply @f1@
-- first followed by @f2@.
instance (Monad m) => Semigroup (PartialFilterM m p) where
  f1 :: PartialFilterM m p
f1 <> :: PartialFilterM m p -> PartialFilterM m p -> PartialFilterM m p
<> f2 :: PartialFilterM m p
f2 = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM (PartialFilterM m p -> p -> m p
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM PartialFilterM m p
f1 (p -> m p) -> (p -> m p) -> p -> m p
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PartialFilterM m p -> p -> m p
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM PartialFilterM m p
f2)

-- | The 'Monoid' instance of `PartialFilterM`.
instance (Monad m) => Monoid (PartialFilterM m p) where
  mempty :: PartialFilterM m p
mempty = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM p -> m p
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | A helper typeclass used as a polymorphic constructor of 'PartialFilterM'.
class ToPartialFilter m f p where
  -- | The actual constructor of 'PartialFilterM'. It takes an ordinary filter
  -- function @a -> b@ and wraps it as a wrapped filter 'PartialFilterM'. It
  -- can also be used to convert between different types of @'PartialFilterM'
  -- m@.
  mkFilter
    :: f                  -- ^ A filter function, usually @a -> a@ for some @'Walkable' a p@.
    -> PartialFilterM m p -- ^ Wrapped Pandoc filter.

instance (Monad m, Walkable a p) => ToPartialFilter m (a -> a) p where
  mkFilter :: (a -> a) -> PartialFilterM m p
mkFilter = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM ((p -> m p) -> PartialFilterM m p)
-> ((a -> a) -> p -> m p) -> (a -> a) -> PartialFilterM m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> m p
forall (m :: * -> *) a. Monad m => a -> m a
return (p -> m p) -> (p -> p) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((p -> p) -> p -> m p)
-> ((a -> a) -> p -> p) -> (a -> a) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> p -> p
forall a b. Walkable a b => (a -> a) -> b -> b
walk

instance (Monad m, Walkable a p) => ToPartialFilter m (a -> m a) p where
  mkFilter :: (a -> m a) -> PartialFilterM m p
mkFilter = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM ((p -> m p) -> PartialFilterM m p)
-> ((a -> m a) -> p -> m p) -> (a -> m a) -> PartialFilterM m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> p -> m p
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM

instance (Monad m, Walkable [a] p) => ToPartialFilter m (a -> [a]) p where
  mkFilter :: (a -> [a]) -> PartialFilterM m p
mkFilter = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM ((p -> m p) -> PartialFilterM m p)
-> ((a -> [a]) -> p -> m p) -> (a -> [a]) -> PartialFilterM m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> m p
forall (m :: * -> *) a. Monad m => a -> m a
return (p -> m p) -> (p -> p) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((p -> p) -> p -> m p)
-> ((a -> [a]) -> p -> p) -> (a -> [a]) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> p -> p
forall a b. Walkable a b => (a -> a) -> b -> b
walk (([a] -> [a]) -> p -> p)
-> ((a -> [a]) -> [a] -> [a]) -> (a -> [a]) -> p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap

instance (Monad m, Walkable [a] p) => ToPartialFilter m (a -> m [a]) p where
  mkFilter :: (a -> m [a]) -> PartialFilterM m p
mkFilter = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM ((p -> m p) -> PartialFilterM m p)
-> ((a -> m [a]) -> p -> m p) -> (a -> m [a]) -> PartialFilterM m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> m [a]) -> p -> m p
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (([a] -> m [a]) -> p -> m p)
-> ((a -> m [a]) -> [a] -> m [a]) -> (a -> m [a]) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([[a]] -> [a]) -> m [[a]] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[a]] -> m [a]) -> ([a] -> m [[a]]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([a] -> m [[a]]) -> [a] -> m [a])
-> ((a -> m [a]) -> [a] -> m [[a]]) -> (a -> m [a]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m [a]) -> [a] -> m [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM

-- | This instance can be used to convert @'PartialFilterM' m a@ to
-- @'PartialFilterM' m b@.
instance (Monad m, Walkable a b) => ToPartialFilter m (PartialFilterM m a) b where
  mkFilter :: PartialFilterM m a -> PartialFilterM m b
mkFilter = (a -> m a) -> PartialFilterM m b
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter ((a -> m a) -> PartialFilterM m b)
-> (PartialFilterM m a -> a -> m a)
-> PartialFilterM m a
-> PartialFilterM m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialFilterM m a -> a -> m a
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM

-- | Construct a wrapped filter 'PartialFilterM' from a list of filter
-- functions of the same type. The final filter is concatenated from left to
-- right such that the first element in the list will be applied first and the
-- last element will be applied at the end.
--
-- For example, it can be used to convert an list of filter functions
-- @['Inline' -> ['Inline']]@ to a wrapped filter @'PandocFilter'@.
mkConcatedFilter
  :: (Monad m, ToPartialFilter m f p, Foldable t)
  => t f                -- ^ A list of filter functions of the same type.
  -> PartialFilterM m p -- ^ Concatenated filter.
mkConcatedFilter :: t f -> PartialFilterM m p
mkConcatedFilter = (f -> PartialFilterM m p) -> t f -> PartialFilterM m p
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap f -> PartialFilterM m p
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter

-- | Convert an ordinary wrapped filter 'PartialFilter' to the monadic version
-- 'PartialFilterM'.
--
-- For example, it can be used to convert an ordinary wrapped filter
-- @'PartialFilter' 'Inline'@ to monadic wrapped filter @'PartialFilterM' 'IO'
-- 'Inline'@.
toFilterM
  :: (Monad m)
  => PartialFilter p    -- ^ An ordinary filter.
  -> PartialFilterM m p -- ^ The monadic version.
toFilterM :: PartialFilter p -> PartialFilterM m p
toFilterM = (p -> m p) -> PartialFilterM m p
forall (m :: * -> *) p. (p -> m p) -> PartialFilterM m p
PartialFilterM ((p -> m p) -> PartialFilterM m p)
-> (PartialFilter p -> p -> m p)
-> PartialFilter p
-> PartialFilterM m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> m p
forall (m :: * -> *) a. Monad m => a -> m a
return (p -> m p) -> (p -> p) -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((p -> p) -> p -> m p)
-> (PartialFilter p -> p -> p) -> PartialFilter p -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialFilter p -> p -> p
forall p. PartialFilter p -> p -> p
applyFilter

-- | Apply a list of monadic wrapped filters sequentially, from left to right,
-- i.e. the first element in the list will be applied first and the last
-- element will be applied at the end.
applyFiltersM
  :: (Foldable t, Monad m)
  => t (PartialFilterM m p) -- ^ A list of monadic wrapped filters.
  -> p                      -- ^ 'Pandoc' AST node.
  -> m p                    -- ^ Transformed node.
applyFiltersM :: t (PartialFilterM m p) -> p -> m p
applyFiltersM = PartialFilterM m p -> p -> m p
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM (PartialFilterM m p -> p -> m p)
-> (t (PartialFilterM m p) -> PartialFilterM m p)
-> t (PartialFilterM m p)
-> p
-> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (PartialFilterM m p) -> PartialFilterM m p
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Apply a list of wrapped filters sequentially, from left to right, i.e.
-- the first element in the list will be applied first and the last element
-- will be applied at the end.
applyFilters
  :: (Foldable t)
  => t (PartialFilter p) -- ^ A list of wrapped filter.
  -> p                   -- ^ 'Pandoc' AST node.
  -> p                   -- ^ Transformed node.
applyFilters :: t (PartialFilter p) -> p -> p
applyFilters = PartialFilter p -> p -> p
forall p. PartialFilter p -> p -> p
applyFilter (PartialFilter p -> p -> p)
-> (t (PartialFilter p) -> PartialFilter p)
-> t (PartialFilter p)
-> p
-> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (PartialFilter p) -> PartialFilter p
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | It is mostly the same as 'applyFiltersM', which converts a list of wrapped
-- monadic filter to a monadic filter function, but it should be used when you
-- don't need to apply the filter immediately. There is a slight difference in
-- that it will perform an implicit conversion if the requested filter function
-- is of a different type.
--
-- For example, it can be used to convert a list of wrapped monadic filter
-- @['PartialFilterM' 'IO' 'Inline']@ to a filter function @'Block' -> 'IO'
-- 'Block'@.
getConcatedFilterM
  :: (Foldable t, Monad m, Walkable a b)
  => t (PartialFilterM m a) -- ^ A list of monadic partial filters on @a@.
  -> (b -> m b)             -- ^ Monadic filter function applicable to @b@ directly.
getConcatedFilterM :: t (PartialFilterM m a) -> b -> m b
getConcatedFilterM = PartialFilterM m b -> b -> m b
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM (PartialFilterM m b -> b -> m b)
-> (t (PartialFilterM m a) -> PartialFilterM m b)
-> t (PartialFilterM m a)
-> b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (PartialFilterM m a) -> PartialFilterM m b
forall (m :: * -> *) f p (t :: * -> *).
(Monad m, ToPartialFilter m f p, Foldable t) =>
t f -> PartialFilterM m p
mkConcatedFilter

-- | It is mostly the same as 'applyFilters', which converts a list of wrapped
-- filter to a filter function, but it should be used when you don't need to
-- apply the filter immediately. There is a slight difference in that it will
-- perform an implicit conversion if the requested filter function is of a
-- different type.
--
-- For example, it can be used to convert a list of wrapped filter
-- @['PartialFilter' 'Inline']@ to a filter function @'Block' -> 'Block'@.
getConcatedFilter
  :: (Foldable t, Walkable a b)
  => t (PartialFilter a) -- ^ A list of wrapped filter acting on @a@
  -> (b -> b)            -- ^ Filter function applicable to @b@ directly.
getConcatedFilter :: t (PartialFilter a) -> b -> b
getConcatedFilter = PartialFilter b -> b -> b
forall p. PartialFilter p -> p -> p
applyFilter (PartialFilter b -> b -> b)
-> (t (PartialFilter a) -> PartialFilter b)
-> t (PartialFilter a)
-> b
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (PartialFilter a) -> PartialFilter b
forall (m :: * -> *) f p (t :: * -> *).
(Monad m, ToPartialFilter m f p, Foldable t) =>
t f -> PartialFilterM m p
mkConcatedFilter

-- | Conversion between monadic filter functions, e.g. from @'Inline' ->
-- 'IO' ['Inline']@ filter to @'Pandoc' -> 'IO' 'Pandoc'@ filter.
convertFilterM
  :: (Monad m, ToPartialFilter m f p)
  => f                -- ^ A monadic filter function.
  -> (p -> m p)       -- ^ Monadic filter function acting on @p@.
convertFilterM :: f -> p -> m p
convertFilterM = PartialFilterM m p -> p -> m p
forall (m :: * -> *) p. PartialFilterM m p -> p -> m p
applyFilterM (PartialFilterM m p -> p -> m p)
-> (f -> PartialFilterM m p) -> f -> p -> m p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> PartialFilterM m p
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter

-- | Conversion between filter functions, e.g. from @'Inline' -> ['Inline']@
-- filter to @'Pandoc' -> 'Pandoc'@ filter.
convertFilter
  :: (ToPartialFilter Identity f p)
  => f        -- ^ A filter function.
  -> (p -> p) -- ^ Filter function acting on @p@.
convertFilter :: f -> p -> p
convertFilter = PartialFilter p -> p -> p
forall p. PartialFilter p -> p -> p
applyFilter (PartialFilter p -> p -> p)
-> (f -> PartialFilter p) -> f -> p -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> PartialFilter p
forall (m :: * -> *) f p.
ToPartialFilter m f p =>
f -> PartialFilterM m p
mkFilter