{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
-- Module      :  Text.MMark.Extension.ObfuscateEmail
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Obfuscate email addresses.
module Text.MMark.Extension.ObfuscateEmail
  ( obfuscateEmail,
  )
where

import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import Lucid
import Text.MMark.Extension (Extension, Inline (..))
import qualified Text.MMark.Extension as Ext
import qualified Text.URI as URI
import Text.URI.QQ (scheme, uri)

-- | This extension makes email addresses in autolinks be rendered as
-- something like this:
--
-- > <a class="protected-email"
-- >    data-email="something@example.org"
-- >    href="javascript:void(0)">Enable JavaScript to see this email</a>
--
-- You'll also need to include jQuery and this bit of JS code for the magic
-- to work:
--
-- > $(document).ready(function () {
-- >     $(".protected-email").each(function () {
-- >         var item = $(this);
-- >         var email = item.data('email');
-- >         item.attr('href', 'mailto:' + email);
-- >         item.html(email);
-- >     });
-- > });
obfuscateEmail ::
  -- | Name of class to assign to the links, e.g. @\"protected-email\"@
  Text ->
  Extension
obfuscateEmail :: Text -> Extension
obfuscateEmail Text
class' = ((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
_ URI
email Maybe Text
mtitle) ->
      if URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
email Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just [scheme|mailto|]
        then
          let txt :: NonEmpty Inline
txt = Text -> Inline
Plain Text
"Enable JavaScript to see this email" Inline -> [Inline] -> NonEmpty Inline
forall a. a -> [a] -> NonEmpty a
:| []
              js :: URI
js = [uri|javascript:void(0)|]
           in 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
js Maybe Text
mtitle))
                [ Text -> Attribute
class_ Text
class',
                  Text -> Text -> Attribute
data_
                    Text
"email"
                    (Int -> Text -> Text
T.drop Int
7 (URI -> Text
URI.render URI
email))
                ]
        else Inline -> Html ()
old Inline
l
    Inline
other -> Inline -> Html ()
old Inline
other