{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      :  Text.MMark.Extension.LinkTarget
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Specify the @target@ attribute of links in link titles. This allows, e.g.
-- make a link open in new tab.
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

-- | When title of a link starts with the word @\"_blank\"@, @\"_self\"@,
-- @\"_parent\"@, or @\"_top\"@, it's stripped from title (as well as all
-- whitespace after it) and added as the value of @target@ attribute of the
-- resulting link.
--
-- For example:
--
-- > This [link](/url '_blank My title') opens in new tab.
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