{-# 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.
module Text.Pandoc.Filter.Utils (
  -- * Definitions
  PartialFilterM,
  PartialFilter,
  PandocFilterM,
  PandocFilter,
  -- * Filter application
  applyFilterM,
  applyFilter,
  -- * Filter composition
  applyFiltersM,
  applyFilters,
  -- * Filter conversion
  getFilterM,
  getFilter,
  getConcatedFilterM,
  getConcatedFilter,
  ToPartialFilter (..),
  mkConcatedFilter,
  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.
--
-- * @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.
--
-- * @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 an ordinary filter to @p@, which returns @p@ directly.
applyFilter
  :: PartialFilter p -- ^ A wrapped partial 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' and should be used when you don't
-- need to apply the filter immediately. The only difference is that it will
-- perform an implicit conversion if the requested filter function is of a
-- different type.
getFilterM
  :: (Monad m, Walkable a b)
  => PartialFilterM m a -- ^ A wrapped partial filter on @a@.
  -> (b -> m b)         -- ^ Unwrapped 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' and should be used when you don't
-- need to apply the filter immediately. The only difference is that it will
-- perform an implicit conversion if the requested filter function is of a
-- different type.
getFilter
  :: (Walkable a b)
  => PartialFilter a -- ^ A wrapped partial filter on @a@.
  -> (b -> b)        -- ^ Unwrapped 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 'PartialFilterM'. It can also be used
  -- to convert between different types of @'PartialFilterM' m@.
  mkFilter
    :: f                  -- ^ A partial filter function, usually @a -> a@ for some @'Walkable' a p@.
    -> PartialFilterM m p -- ^ Wrapped partial 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 '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.
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 'PartialFilter' to the monadic version
-- 'PartialFilterM'.
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 partial 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 partial 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 partial 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 partial 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

-- | An alias for 'applyFiltersM', used when the filter is not used
-- immediately.
getConcatedFilterM
  :: (Foldable t, Monad m)
  => t (PartialFilterM m p) -- ^ A list of monadic partial filters.
  -> (p -> m p)             -- ^ Unwrapped monadic filter applicable to @p@ directly.
getConcatedFilterM :: t (PartialFilterM m p) -> p -> m p
getConcatedFilterM = t (PartialFilterM m p) -> p -> m p
forall (t :: * -> *) (m :: * -> *) p.
(Foldable t, Monad m) =>
t (PartialFilterM m p) -> p -> m p
applyFiltersM

-- | An alias for 'applyFilters', used when the filter is not used immediately.
getConcatedFilter
  :: (Foldable t)
  => t (PartialFilter p) -- ^ A list of partial filter.
  -> (p -> p)            -- ^ Unwrapped filter applicable to @p@ directly.
getConcatedFilter :: t (PartialFilter p) -> p -> p
getConcatedFilter = t (PartialFilter p) -> p -> p
forall (t :: * -> *) p. Foldable t => t (PartialFilter p) -> p -> p
applyFilters