{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{- |
Module      : Text.Pandoc.Lua.Topdown
Copyright   : © 2012-2021 John MacFarlane,
              © 2017-2021 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Walk documents in a filter-suitable way, descending from the root
towards the leaves.
-}
module Text.Pandoc.Lua.Topdown
  ( TraversalNode (..)
  , Topdown (..)
  , TraversalControl (..)
  )
where

import Control.Monad ((>=>))
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Walk
import Text.Pandoc.Walk

-- | Helper type to do a preorder traversal of a subtree.
data TraversalNode
  = TBlock Block
  | TBlocks [Block]
  | TInline Inline
  | TInlines [Inline]

-- | Type used to traverse a 'Pandoc' AST from top to bottom, i.e.,
-- processing the root element first and then continue towards the
-- leaves depth-first. Aborts the descend if 'topdownControl' is 'Stop'.
data Topdown = Topdown
  { Topdown -> TraversalControl
topdownControl :: TraversalControl
  , Topdown -> TraversalNode
topdownNode :: TraversalNode
  }

-- | Extracts a list of 'Inline' elements from a 'TraversalNode'.
-- WARNING: This is a partial function and will throw an error if the
-- node contains a 'Block' or a list of 'Block's.
nodeInlines :: TraversalNode -> [Inline]
nodeInlines :: TraversalNode -> [Inline]
nodeInlines = \case
  TInlines [Inline]
xs -> [Inline]
xs
  TInline Inline
x   -> [Inline
x]
  TraversalNode
_            -> [Char] -> [Inline]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Inline]) -> [Char] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Char]
"The 'impossible' has happened."
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Please report this as a bug"

-- | Extracts a list of 'Block' elements from a 'TraversalNode'.
nodeBlocks :: TraversalNode -> [Block]
nodeBlocks :: TraversalNode -> [Block]
nodeBlocks = \case
  TBlocks [Block]
xs  -> [Block]
xs
  TBlock Block
x    -> [Block
x]
  TInlines [Inline]
xs -> [[Inline] -> Block
Plain [Inline]
xs]
  TInline Inline
x   -> [[Inline] -> Block
Plain [Inline
x]]

-- | Creates a topdown-walking function for a list of elements.
walkTopdownM :: (Monad m, Walkable Topdown a)
             => ([a] -> TraversalNode)
             -> (a -> TraversalNode)
             -> (TraversalNode -> [a])
             -> (Topdown -> m Topdown)
             -> [a] -> m [a]
walkTopdownM :: ([a] -> TraversalNode)
-> (a -> TraversalNode)
-> (TraversalNode -> [a])
-> (Topdown -> m Topdown)
-> [a]
-> m [a]
walkTopdownM [a] -> TraversalNode
mkListNode a -> TraversalNode
mkElemNode TraversalNode -> [a]
nodeToList Topdown -> m Topdown
f =
  Topdown -> m Topdown
f (Topdown -> m Topdown) -> ([a] -> Topdown) -> [a] -> m Topdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraversalControl -> TraversalNode -> Topdown
Topdown TraversalControl
Continue (TraversalNode -> Topdown)
-> ([a] -> TraversalNode) -> [a] -> Topdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> TraversalNode
mkListNode ([a] -> m Topdown) -> (Topdown -> m [a]) -> [a] -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    Topdown TraversalControl
Stop     TraversalNode
node -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ TraversalNode -> [a]
nodeToList TraversalNode
node
    Topdown TraversalControl
Continue TraversalNode
node -> [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> m [[a]] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (a -> m [a]) -> [a] -> m [[a]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Topdown -> m Topdown
f (Topdown -> m Topdown) -> (a -> Topdown) -> a -> m Topdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraversalControl -> TraversalNode -> Topdown
Topdown TraversalControl
Continue (TraversalNode -> Topdown) -> (a -> TraversalNode) -> a -> Topdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TraversalNode
mkElemNode (a -> m Topdown) -> (Topdown -> m [a]) -> a -> m [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
                   Topdown TraversalControl
Stop     TraversalNode
node' -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ TraversalNode -> [a]
nodeToList TraversalNode
node'
                   Topdown TraversalControl
Continue TraversalNode
node' -> (a -> m a) -> [a] -> m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Topdown -> m Topdown) -> a -> m a
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Topdown -> m Topdown
f) ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$
                                             TraversalNode -> [a]
nodeToList TraversalNode
node')
               (TraversalNode -> [a]
nodeToList TraversalNode
node)

-- | Creates a topdown-query function for a list of elements.
queryTopdown :: (Monoid a, Walkable Topdown b)
             => ([b] -> TraversalNode)
             -> (Topdown -> a) -> [b] -> a
queryTopdown :: ([b] -> TraversalNode) -> (Topdown -> a) -> [b] -> a
queryTopdown [b] -> TraversalNode
mkListNode Topdown -> a
f [b]
xs =
  Topdown -> a
f (TraversalControl -> TraversalNode -> Topdown
Topdown TraversalControl
Continue (TraversalNode -> Topdown) -> TraversalNode -> Topdown
forall a b. (a -> b) -> a -> b
$ [b] -> TraversalNode
mkListNode [b]
xs) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [a] -> a
forall a. Monoid a => [a] -> a
mconcat ((b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Topdown -> a) -> b -> a
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Topdown -> a
f) [b]
xs)

instance {-# OVERLAPPING #-} Walkable Topdown [Block] where
  walkM :: (Topdown -> m Topdown) -> [Block] -> m [Block]
walkM = ([Block] -> TraversalNode)
-> (Block -> TraversalNode)
-> (TraversalNode -> [Block])
-> (Topdown -> m Topdown)
-> [Block]
-> m [Block]
forall (m :: * -> *) a.
(Monad m, Walkable Topdown a) =>
([a] -> TraversalNode)
-> (a -> TraversalNode)
-> (TraversalNode -> [a])
-> (Topdown -> m Topdown)
-> [a]
-> m [a]
walkTopdownM [Block] -> TraversalNode
TBlocks Block -> TraversalNode
TBlock TraversalNode -> [Block]
nodeBlocks
  query :: (Topdown -> c) -> [Block] -> c
query = ([Block] -> TraversalNode) -> (Topdown -> c) -> [Block] -> c
forall a b.
(Monoid a, Walkable Topdown b) =>
([b] -> TraversalNode) -> (Topdown -> a) -> [b] -> a
queryTopdown [Block] -> TraversalNode
TBlocks

instance {-# OVERLAPPING #-} Walkable Topdown [Inline] where
  walkM :: (Topdown -> m Topdown) -> [Inline] -> m [Inline]
walkM = ([Inline] -> TraversalNode)
-> (Inline -> TraversalNode)
-> (TraversalNode -> [Inline])
-> (Topdown -> m Topdown)
-> [Inline]
-> m [Inline]
forall (m :: * -> *) a.
(Monad m, Walkable Topdown a) =>
([a] -> TraversalNode)
-> (a -> TraversalNode)
-> (TraversalNode -> [a])
-> (Topdown -> m Topdown)
-> [a]
-> m [a]
walkTopdownM [Inline] -> TraversalNode
TInlines Inline -> TraversalNode
TInline TraversalNode -> [Inline]
nodeInlines
  query :: (Topdown -> c) -> [Inline] -> c
query = ([Inline] -> TraversalNode) -> (Topdown -> c) -> [Inline] -> c
forall a b.
(Monoid a, Walkable Topdown b) =>
([b] -> TraversalNode) -> (Topdown -> a) -> [b] -> a
queryTopdown [Inline] -> TraversalNode
TInlines

instance Walkable Topdown Block where
  walkM :: (Topdown -> m Topdown) -> Block -> m Block
walkM = (Topdown -> m Topdown) -> Block -> m Block
forall a (m :: * -> *).
(Walkable a [Block], Walkable a [Inline], Walkable a Row,
 Walkable a Caption, Walkable a TableHead, Walkable a TableBody,
 Walkable a TableFoot, Monad m, Applicative m, Functor m) =>
(a -> m a) -> Block -> m Block
walkBlockM
  query :: (Topdown -> c) -> Block -> c
query = (Topdown -> c) -> Block -> c
forall a c.
(Walkable a Citation, Walkable a [Block], Walkable a Row,
 Walkable a Caption, Walkable a TableHead, Walkable a TableBody,
 Walkable a TableFoot, Walkable a [Inline], Monoid c) =>
(a -> c) -> Block -> c
queryBlock

instance Walkable Topdown Inline where
  walkM :: (Topdown -> m Topdown) -> Inline -> m Inline
walkM = (Topdown -> m Topdown) -> Inline -> m Inline
forall a (m :: * -> *).
(Walkable a Citation, Walkable a [Block], Walkable a [Inline],
 Monad m, Applicative m, Functor m) =>
(a -> m a) -> Inline -> m Inline
walkInlineM
  query :: (Topdown -> c) -> Inline -> c
query = (Topdown -> c) -> Inline -> c
forall a c.
(Walkable a Citation, Walkable a [Block], Walkable a [Inline],
 Monoid c) =>
(a -> c) -> Inline -> c
queryInline

instance Walkable Topdown Pandoc where
  walkM :: (Topdown -> m Topdown) -> Pandoc -> m Pandoc
walkM = (Topdown -> m Topdown) -> Pandoc -> m Pandoc
forall a (m :: * -> *).
(Walkable a Meta, Walkable a [Block], Monad m, Applicative m,
 Functor m) =>
(a -> m a) -> Pandoc -> m Pandoc
walkPandocM
  query :: (Topdown -> c) -> Pandoc -> c
query = (Topdown -> c) -> Pandoc -> c
forall a c.
(Walkable a Meta, Walkable a [Block], Monoid c) =>
(a -> c) -> Pandoc -> c
queryPandoc

instance Walkable Topdown Citation where
  walkM :: (Topdown -> m Topdown) -> Citation -> m Citation
walkM = (Topdown -> m Topdown) -> Citation -> m Citation
forall a (m :: * -> *).
(Walkable a [Inline], Monad m, Applicative m, Functor m) =>
(a -> m a) -> Citation -> m Citation
walkCitationM
  query :: (Topdown -> c) -> Citation -> c
query = (Topdown -> c) -> Citation -> c
forall a c.
(Walkable a [Inline], Monoid c) =>
(a -> c) -> Citation -> c
queryCitation

instance Walkable Topdown Row where
  walkM :: (Topdown -> m Topdown) -> Row -> m Row
walkM = (Topdown -> m Topdown) -> Row -> m Row
forall a (m :: * -> *).
(Walkable a Cell, Monad m) =>
(a -> m a) -> Row -> m Row
walkRowM
  query :: (Topdown -> c) -> Row -> c
query = (Topdown -> c) -> Row -> c
forall a c. (Walkable a Cell, Monoid c) => (a -> c) -> Row -> c
queryRow

instance Walkable Topdown TableHead where
  walkM :: (Topdown -> m Topdown) -> TableHead -> m TableHead
walkM = (Topdown -> m Topdown) -> TableHead -> m TableHead
forall a (m :: * -> *).
(Walkable a Row, Monad m) =>
(a -> m a) -> TableHead -> m TableHead
walkTableHeadM
  query :: (Topdown -> c) -> TableHead -> c
query = (Topdown -> c) -> TableHead -> c
forall a c.
(Walkable a Row, Monoid c) =>
(a -> c) -> TableHead -> c
queryTableHead

instance Walkable Topdown TableBody where
  walkM :: (Topdown -> m Topdown) -> TableBody -> m TableBody
walkM = (Topdown -> m Topdown) -> TableBody -> m TableBody
forall a (m :: * -> *).
(Walkable a Row, Monad m) =>
(a -> m a) -> TableBody -> m TableBody
walkTableBodyM
  query :: (Topdown -> c) -> TableBody -> c
query = (Topdown -> c) -> TableBody -> c
forall a c.
(Walkable a Row, Monoid c) =>
(a -> c) -> TableBody -> c
queryTableBody

instance Walkable Topdown TableFoot where
  walkM :: (Topdown -> m Topdown) -> TableFoot -> m TableFoot
walkM = (Topdown -> m Topdown) -> TableFoot -> m TableFoot
forall a (m :: * -> *).
(Walkable a Row, Monad m) =>
(a -> m a) -> TableFoot -> m TableFoot
walkTableFootM
  query :: (Topdown -> c) -> TableFoot -> c
query = (Topdown -> c) -> TableFoot -> c
forall a c.
(Walkable a Row, Monoid c) =>
(a -> c) -> TableFoot -> c
queryTableFoot

instance Walkable Topdown Caption where
  walkM :: (Topdown -> m Topdown) -> Caption -> m Caption
walkM = (Topdown -> m Topdown) -> Caption -> m Caption
forall a (m :: * -> *).
(Walkable a [Block], Walkable a [Inline], Monad m,
 Walkable a [Inline]) =>
(a -> m a) -> Caption -> m Caption
walkCaptionM
  query :: (Topdown -> c) -> Caption -> c
query = (Topdown -> c) -> Caption -> c
forall a c.
(Walkable a [Block], Walkable a [Inline], Walkable a [Inline],
 Monoid c) =>
(a -> c) -> Caption -> c
queryCaption

instance Walkable Topdown Cell where
  walkM :: (Topdown -> m Topdown) -> Cell -> m Cell
walkM = (Topdown -> m Topdown) -> Cell -> m Cell
forall a (m :: * -> *).
(Walkable a [Block], Monad m) =>
(a -> m a) -> Cell -> m Cell
walkCellM
  query :: (Topdown -> c) -> Cell -> c
query = (Topdown -> c) -> Cell -> c
forall a c. (Walkable a [Block], Monoid c) => (a -> c) -> Cell -> c
queryCell

instance Walkable Topdown MetaValue where
  walkM :: (Topdown -> m Topdown) -> MetaValue -> m MetaValue
walkM = (Topdown -> m Topdown) -> MetaValue -> m MetaValue
forall a (f :: * -> *).
(Walkable a MetaValue, Walkable a [Block], Walkable a [Inline],
 Monad f, Applicative f, Functor f) =>
(a -> f a) -> MetaValue -> f MetaValue
walkMetaValueM
  query :: (Topdown -> c) -> MetaValue -> c
query = (Topdown -> c) -> MetaValue -> c
forall a c.
(Walkable a MetaValue, Walkable a [Block], Walkable a [Inline],
 Monoid c) =>
(a -> c) -> MetaValue -> c
queryMetaValue

instance Walkable Topdown Meta where
  walkM :: (Topdown -> m Topdown) -> Meta -> m Meta
walkM Topdown -> m Topdown
f (Meta Map Text MetaValue
metamap) = Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta) -> m (Map Text MetaValue) -> m Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Topdown -> m Topdown)
-> Map Text MetaValue -> m (Map Text MetaValue)
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Topdown -> m Topdown
f Map Text MetaValue
metamap
  query :: (Topdown -> c) -> Meta -> c
query Topdown -> c
f (Meta Map Text MetaValue
metamap) = (Topdown -> c) -> Map Text MetaValue -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Topdown -> c
f Map Text MetaValue
metamap