module Text.Pandoc.LinkContext (queryLinksWithContext) where

import Data.List (nub)
import qualified Data.Map.Strict as Map
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Definition (Block, Inline (Link), Pandoc (..))
import qualified Text.Pandoc.Walk 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 Url (NonEmpty ([OtherAttr], [Block]))
queryLinksWithContext =
  (NonEmpty ([OtherAttr], [Block])
 -> NonEmpty ([OtherAttr], [Block]))
-> Map Url (NonEmpty ([OtherAttr], [Block]))
-> Map Url (NonEmpty ([OtherAttr], [Block]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([OtherAttr], [Block]) -> ([OtherAttr], [Block]))
-> NonEmpty ([OtherAttr], [Block])
-> NonEmpty ([OtherAttr], [Block])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([OtherAttr], [Block]) -> ([OtherAttr], [Block]))
 -> NonEmpty ([OtherAttr], [Block])
 -> NonEmpty ([OtherAttr], [Block]))
-> (([OtherAttr], [Block]) -> ([OtherAttr], [Block]))
-> NonEmpty ([OtherAttr], [Block])
-> NonEmpty ([OtherAttr], [Block])
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block])
-> ([OtherAttr], [Block]) -> ([OtherAttr], [Block])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Block] -> [Block]
forall a. Eq a => [a] -> [a]
nub)
    (Map Url (NonEmpty ([OtherAttr], [Block]))
 -> Map Url (NonEmpty ([OtherAttr], [Block])))
-> (Pandoc -> Map Url (NonEmpty ([OtherAttr], [Block])))
-> Pandoc
-> Map Url (NonEmpty ([OtherAttr], [Block]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty ([OtherAttr], [Block])
 -> NonEmpty ([OtherAttr], [Block])
 -> NonEmpty ([OtherAttr], [Block]))
-> [(Url, NonEmpty ([OtherAttr], [Block]))]
-> Map Url (NonEmpty ([OtherAttr], [Block]))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty ([OtherAttr], [Block])
-> NonEmpty ([OtherAttr], [Block])
-> NonEmpty ([OtherAttr], [Block])
forall a. Semigroup a => a -> a -> a
(<>)
    ([(Url, NonEmpty ([OtherAttr], [Block]))]
 -> Map Url (NonEmpty ([OtherAttr], [Block])))
-> (Pandoc -> [(Url, NonEmpty ([OtherAttr], [Block]))])
-> Pandoc
-> Map Url (NonEmpty ([OtherAttr], [Block]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [(Url, NonEmpty ([OtherAttr], [Block]))])
-> Pandoc -> [(Url, NonEmpty ([OtherAttr], [Block]))]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query Block -> [(Url, NonEmpty ([OtherAttr], [Block]))]
go
  where
    go :: Block -> [(Url, NonEmpty ([OtherAttr], [Block]))]
    go :: Block -> [(Url, NonEmpty ([OtherAttr], [Block]))]
go Block
blk =
      ((Url, [OtherAttr]) -> (Url, NonEmpty ([OtherAttr], [Block])))
-> [(Url, [OtherAttr])] -> [(Url, NonEmpty ([OtherAttr], [Block]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Url
url, [OtherAttr]
attr) -> (Url
url, OneItem (NonEmpty ([OtherAttr], [Block]))
-> NonEmpty ([OtherAttr], [Block])
forall x. One x => OneItem x -> x
one ([OtherAttr]
attr, [Block
blk]))) ([(Url, [OtherAttr])] -> [(Url, NonEmpty ([OtherAttr], [Block]))])
-> [(Url, [OtherAttr])] -> [(Url, NonEmpty ([OtherAttr], [Block]))]
forall a b. (a -> b) -> a -> b
$ case Block
blk of
        B.Para [Inline]
is ->
          [Inline] -> [(Url, [OtherAttr])]
forall b. Walkable Inline b => b -> [(Url, [OtherAttr])]
queryLinkUrls [Inline]
is
        B.Plain [Inline]
is ->
          [Inline] -> [(Url, [OtherAttr])]
forall b. Walkable Inline b => b -> [(Url, [OtherAttr])]
queryLinkUrls [Inline]
is
        B.LineBlock [[Inline]]
is ->
          [[Inline]] -> [(Url, [OtherAttr])]
forall b. Walkable Inline b => b -> [(Url, [OtherAttr])]
queryLinkUrls [[Inline]]
is
        B.Header Int
_ Attr
_ [Inline]
is ->
          [Inline] -> [(Url, [OtherAttr])]
forall b. Walkable Inline b => b -> [(Url, [OtherAttr])]
queryLinkUrls [Inline]
is
        B.DefinitionList [([Inline], [[Block]])]
xs ->
          -- Gather all filenames linked, and have them put (see above) in the
          -- same definition list block.
          [[(Url, [OtherAttr])]] -> [(Url, [OtherAttr])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Url, [OtherAttr])]] -> [(Url, [OtherAttr])])
-> [[(Url, [OtherAttr])]] -> [(Url, [OtherAttr])]
forall a b. (a -> b) -> a -> b
$
            [([Inline], [[Block]])]
xs [([Inline], [[Block]])]
-> (([Inline], [[Block]]) -> [(Url, [OtherAttr])])
-> [[(Url, [OtherAttr])]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([Inline]
is, [[Block]]
bss) ->
              let def :: [(Url, [OtherAttr])]
def = [Inline] -> [(Url, [OtherAttr])]
forall b. Walkable Inline b => b -> [(Url, [OtherAttr])]
queryLinkUrls [Inline]
is
                  body :: [[[Url]]]
body = ([Block] -> [[Url]]) -> [[Block]] -> [[[Url]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Block -> [Url]) -> [Block] -> [[Url]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Url, NonEmpty ([OtherAttr], [Block])) -> Url)
-> [(Url, NonEmpty ([OtherAttr], [Block]))] -> [Url]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Url, NonEmpty ([OtherAttr], [Block])) -> Url
forall a b. (a, b) -> a
fst ([(Url, NonEmpty ([OtherAttr], [Block]))] -> [Url])
-> (Block -> [(Url, NonEmpty ([OtherAttr], [Block]))])
-> Block
-> [Url]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [(Url, NonEmpty ([OtherAttr], [Block]))]
go)) [[Block]]
bss
               in [(Url, [OtherAttr])]
def [(Url, [OtherAttr])]
-> [(Url, [OtherAttr])] -> [(Url, [OtherAttr])]
forall a. Semigroup a => a -> a -> a
<> (Url -> (Url, [OtherAttr])) -> [Url] -> [(Url, [OtherAttr])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[]) ([[Url]] -> [Url]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Url]]] -> [[Url]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Url]]]
body))
        Block
_ -> [(Url, [OtherAttr])]
forall a. Monoid a => a
mempty

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

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