{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Text.MMark.Extension.LinkTarget
( linkTarget,
)
where
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Lucid
import Text.MMark.Extension (Extension, Inline (..))
import qualified Text.MMark.Extension as Ext
linkTarget :: Extension
linkTarget :: Extension
linkTarget = ((Inline -> Html ()) -> Inline -> Html ()) -> Extension
Ext.inlineRender (((Inline -> Html ()) -> Inline -> Html ()) -> Extension)
-> ((Inline -> Html ()) -> Inline -> Html ()) -> Extension
forall a b. (a -> b) -> a -> b
$ \Inline -> Html ()
old Inline
inline ->
case Inline
inline of
l :: Inline
l@(Link NonEmpty Inline
txt URI
url (Just Text
title)) -> Html () -> Maybe (Html ()) -> Html ()
forall a. a -> Maybe a -> a
fromMaybe (Inline -> Html ()
old Inline
l) (Maybe (Html ()) -> Html ()) -> Maybe (Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ do
let f :: Text -> Maybe (Text, Text)
f Text
prefix =
(Text
prefix,) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripStart
(Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
title
(Text
prefix, Text
title') <-
[Maybe (Text, Text)] -> Maybe (Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Text, Text)] -> Maybe (Text, Text))
-> [Maybe (Text, Text)] -> Maybe (Text, Text)
forall a b. (a -> b) -> a -> b
$
Text -> Maybe (Text, Text)
f (Text -> Maybe (Text, Text)) -> [Text] -> [Maybe (Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"_blank", Text
"_self", Text
"_parent", Text
"_top"]
let mtitle :: Maybe Text
mtitle = if Text -> Bool
T.null Text
title' then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
title'
Html () -> Maybe (Html ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Html () -> Maybe (Html ())) -> Html () -> Maybe (Html ())
forall a b. (a -> b) -> a -> b
$ Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with (Inline -> Html ()
old (NonEmpty Inline -> URI -> Maybe Text -> Inline
Link NonEmpty Inline
txt URI
url Maybe Text
mtitle)) [Text -> Attribute
target_ Text
prefix]
Inline
other -> Inline -> Html ()
old Inline
other