module Emanote.Pandoc.ExternalLink (
  setExternalLinkIcon,
) where

import Relude
import Text.Pandoc.Definition qualified as B
import Text.Pandoc.Walk qualified as W
import Text.Parsec qualified as P
import Text.Parsec.Char qualified as PC

-- Add a data-linkicon=external attribute to external links that contain some
-- text in their description, provided that they do not already have a
-- data-linkicon attribute.
setExternalLinkIcon :: W.Walkable B.Inline b => b -> b
setExternalLinkIcon :: forall b. Walkable Inline b => b -> b
setExternalLinkIcon =
  forall a b. Walkable a b => (a -> a) -> b -> b
W.walk forall a b. (a -> b) -> a -> b
$ \case
    B.Link (Text
id', [Text]
classes, [(Text, Text)]
attrs) [Inline]
inlines (Text
url, Text
title)
      | Text -> Bool
hasURIScheme Text
url Bool -> Bool -> Bool
&& [Inline] -> Bool
containsText [Inline]
inlines ->
          let showLinkIconAttr :: (Text, Text)
showLinkIconAttr = (Text
"data-linkicon", Text
"external")
              newAttrs :: [(Text, Text)]
newAttrs = forall a b. Eq a => [(a, b)] -> (a, b) -> [(a, b)]
insert [(Text, Text)]
attrs (Text, Text)
showLinkIconAttr
           in (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
B.Link (Text
id', [Text]
classes, [(Text, Text)]
newAttrs) [Inline]
inlines (Text
url, Text
title)
    Inline
x -> Inline
x
  where
    -- Inserts an element in a key-value list if the element's key is not
    -- already in the list.
    insert :: Eq a => [(a, b)] -> (a, b) -> [(a, b)]
    insert :: forall a b. Eq a => [(a, b)] -> (a, b) -> [(a, b)]
insert [(a, b)]
as (a, b)
a
      | forall a b. (a, b) -> a
fst (a, b)
a forall (f :: Type -> Type) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
as) = [(a, b)]
as
      | Bool
otherwise = (a, b)
a forall a. a -> [a] -> [a]
: [(a, b)]
as
    -- Checks whether the given text begins with an RFC 3986 compliant URI
    -- scheme.
    hasURIScheme :: Text -> Bool
    hasURIScheme :: Text -> Bool
hasURIScheme =
      forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
P.parse forall {u}. ParsecT Text u Identity SourceName
schemeP SourceName
""
      where
        schemeP :: ParsecT Text u Identity SourceName
schemeP = do
          Char
c <- forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
PC.letter
          SourceName
cs <- forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m [a]
P.many forall a b. (a -> b) -> a -> b
$ forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
PC.alphaNum forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s (m :: Type -> Type) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
P.oneOf SourceName
".-+"
          forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
PC.char Char
':'
          forall (m :: Type -> Type) a. Monad m => a -> m a
return (Char
c forall a. a -> [a] -> [a]
: SourceName
cs)
    -- Checks whether a list of inlines contains a (perhaps nested) "textual
    -- element", understood as a Pandoc `Str`, `Code` or `Math`.
    containsText :: [B.Inline] -> Bool
    containsText :: [Inline] -> Bool
containsText =
      Any -> Bool
getAny
        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
          ( \case
              B.Str Text
_ -> Bool -> Any
Any Bool
True
              B.Code (Text, [Text], [(Text, Text)])
_ Text
_ -> Bool -> Any
Any Bool
True
              B.Math MathType
_ Text
_ -> Bool -> Any
Any Bool
True
              Inline
_ -> Bool -> Any
Any Bool
False
          )