{-# LANGUAGE QuasiQuotes #-}

-- |
-- Module      :  Text.MMark.Extension.Kbd
-- Copyright   :  © 2018–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Introduce @kbd@ tags by wrapping content in links with @kbd@ scheme.
module Text.MMark.Extension.Kbd
  ( kbd,
  )
where

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)

-- | Introduce @kbd@ tags by wrapping content in links with @kbd@ scheme.
--
-- For example:
--
-- > To enable that mode press [Ctrl+A][kbd].
-- >
-- > [kbd]: kbd:
--
-- The use of reference-style links seems more aesthetically pleasant to me,
-- but you can of course do somethnig like this instead:
--
-- > To enable that mode press [Ctrl+A](kbd:).
kbd :: Extension
kbd :: Extension
kbd = ((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
inner URI
uri Maybe Text
_) ->
      if URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri 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|kbd|]
        then Html () -> Html ()
forall arg result. Term arg result => arg -> result
kbd_ ((Inline -> Html ()) -> NonEmpty Inline -> Html ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> Html ()
old NonEmpty Inline
inner)
        else Inline -> Html ()
old Inline
l
    Inline
other -> Inline -> Html ()
old Inline
other