module Text.Pandoc.LinkContext (queryLinksWithContext) where

import Data.List (nub)
import Data.Map.Strict qualified as Map
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Definition (Block, Inline (Link), Pandoc (..))
import Text.Pandoc.Walk qualified as W

type Url = Text

-- | Attributes other than id and class
type OtherAttr = (Text, Text)

{- | Query the pandoc document for all links

 Return a map, containing the "surrounding context" (as Pandoc blocks) for
 each link.
-}
queryLinksWithContext :: Pandoc -> Map Url (NonEmpty ([OtherAttr], [Block]))
queryLinksWithContext :: Pandoc -> Map Text (NonEmpty ([OtherAttr], [Block]))
queryLinksWithContext =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. Eq a => [a] -> [a]
nub)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query Block -> [(Text, NonEmpty ([OtherAttr], [Block]))]
go
  where
    go :: Block -> [(Url, NonEmpty ([OtherAttr], [Block]))]
    go :: Block -> [(Text, NonEmpty ([OtherAttr], [Block]))]
go Block
blk =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
url, [OtherAttr]
attr) -> (Text
url, forall x. One x => OneItem x -> x
one ([OtherAttr]
attr, [Block
blk]))) forall a b. (a -> b) -> a -> b
$ case Block
blk of
            B.Para [Inline]
is ->
                forall b. Walkable Inline b => b -> [(Text, [OtherAttr])]
queryLinkUrls [Inline]
is
            B.Plain [Inline]
is ->
                forall b. Walkable Inline b => b -> [(Text, [OtherAttr])]
queryLinkUrls [Inline]
is
            B.LineBlock [[Inline]]
is ->
                forall b. Walkable Inline b => b -> [(Text, [OtherAttr])]
queryLinkUrls [[Inline]]
is
            B.Header Int
_ Attr
_ [Inline]
is ->
                forall b. Walkable Inline b => b -> [(Text, [OtherAttr])]
queryLinkUrls [Inline]
is
            Block
_ -> forall a. Monoid a => a
mempty

    queryLinkUrls :: W.Walkable Inline b => b -> [(Url, [OtherAttr])]
    queryLinkUrls :: forall b. Walkable Inline b => b -> [(Text, [OtherAttr])]
queryLinkUrls =
        forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query (forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe (Text, [OtherAttr])
getLinkUrl)

    getLinkUrl :: Inline -> Maybe (Url, [OtherAttr])
    getLinkUrl :: Inline -> Maybe (Text, [OtherAttr])
getLinkUrl = \case
        Link (Text
_, [Text]
_, [OtherAttr]
attrs) [Inline]
_inlines (Text
url, Text
title) -> do
            -- Put title in attrs, as it *is* an attribute
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
url, (Text
"title", Text
title) forall a. a -> [a] -> [a]
: [OtherAttr]
attrs)
        Inline
_ ->
            forall a. Maybe a
Nothing