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
setExternalLinkIcon :: W.Walkable B.Inline b => b -> b
setExternalLinkIcon :: forall b. Walkable Inline b => b -> b
setExternalLinkIcon =
(Inline -> Inline) -> b -> b
forall a b. Walkable a b => (a -> a) -> b -> b
W.walk ((Inline -> Inline) -> b -> b) -> (Inline -> Inline) -> b -> b
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 = [(Text, Text)] -> (Text, Text) -> [(Text, Text)]
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
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
| (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
a a -> [a] -> Bool
forall (f :: Type -> Type) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> [(a, b)] -> [a]
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 (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
as
hasURIScheme :: Text -> Bool
hasURIScheme :: Text -> Bool
hasURIScheme =
Either ParseError [Char] -> Bool
forall a b. Either a b -> Bool
isRight (Either ParseError [Char] -> Bool)
-> (Text -> Either ParseError [Char]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () [Char] -> [Char] -> Text -> Either ParseError [Char]
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
P.parse Parsec Text () [Char]
forall {u}. ParsecT Text u Identity [Char]
schemeP [Char]
""
where
schemeP :: ParsecT Text u Identity [Char]
schemeP = do
Char
c <- ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
PC.letter
[Char]
cs <- ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m [a]
P.many (ParsecT Text u Identity Char -> ParsecT Text u Identity [Char])
-> ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
ParsecT s u m Char
PC.alphaNum ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> [Char] -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
".-+"
ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (ParsecT Text u Identity Char -> ParsecT Text u Identity ())
-> ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text u Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
PC.char Char
':'
[Char] -> ParsecT Text u Identity [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
containsText :: [B.Inline] -> Bool
containsText :: [Inline] -> Bool
containsText =
Any -> Bool
getAny
(Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
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
)