Add external link icon (srid#136) (srid#189)

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 - UI
   - Index pages are no longer marked as 'experimental'
+  - Add external link icon to external links (this behaviour is customizable). [\#189](https://github.com/EmaApps/emanote/pull/189)
 - Dev
   - Move test sources to Cabal's `other-modules` so they are not exposed.
   - Wikilink parser is now a separate library: https://github.com/srid/commonmark-wikilink

default/templates/base.tpl

@@ -23,13 +23,41 @@
   </ema:metadata>
   <tailwindCssShim />
 
-  <!-- Heist error element -->
   <style>
+    /* Heist error element */
     strong.error {
       color: lightcoral;
       font-size: 90%;
       font-family: monospace;
     }
+
+    /* External link icon */
+    a[data-linkicon]:not([data-linkicon=""]):not([data-linkicon="none"])::after {
+      /* filter converts black to rgb(156,163,175) */
+      filter: invert(71%) sepia(3%) saturate(904%) hue-rotate(179deg) brightness(92%) contrast(87%);
+      margin-left: 1px;
+    }
+
+    a[data-linkicon]:not([data-linkicon=""]):not([data-linkicon="none"]):hover::after {
+      /* filter converts black to  rgb(175,85,99) */
+      filter: invert(32%) sepia(10%) saturate(834%) hue-rotate(176deg) brightness(92%) contrast(88%);
+    }
+
+    a[data-linkicon=""]::after {
+      content: ""
+    }
+
+    a[data-linkicon=none]::after {
+      content: ""
+    }
+
+    a[data-linkicon="external"]::after {
+      content: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' height='1em' fill='none' viewBox='0 0 24 24' stroke='black' stroke-width='2'%3E%3Cpath stroke-linecap='round' stroke-linejoin='round' d='M10 6H6a2 2 0 00-2 2v10a2 2 0 002 2h10a2 2 0 002-2v-4M14 4h6m0 0v6m0-6L10 14' /%3E%3C/svg%3E");
+    }
+
+    a[data-linkicon="external"][href^="mailto:"]::after {
+      content: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' height='1em' fill='none' viewBox='0 0 24 24' stroke='black' stroke-width='2'%3E%3Cpath stroke-linecap='round' stroke-linejoin='round' d='M3 8l7.89 5.26a2 2 0 002.22 0L21 8M5 19h14a2 2 0 002-2V7a2 2 0 00-2-2H5a2 2 0 00-2 2v10a2 2 0 002 2z' /%3E%3C/svg%3E");
+    }
   </style>
   <apply template="/templates/hooks/more-head" />
 

default/templates/components/pandoc.tpl

@@ -105,4 +105,4 @@
     <h6 class="mt-6 mb-2 text-xl font-bold text-gray-700" />
   </Header>
 
-</ema:note:pandoc>
+</ema:note:pandoc>

docs/guide/html-template/external-links.md

@@ -0,0 +1,46 @@
+---
+page:
+  headHtml: |
+    <snippet var="js.mathjax" />
+---
+
+# External link icons
+
+A link whose address begins with an [URI scheme](https://en.wikipedia.org/wiki/Uniform_Resource_Identifier#Syntax) component is considered an **external link**. 
+
+## Heuristic 
+
+Emanote displays an icon next to an external hyperlink if its description contains some text, including inline code and math formulas.[^noneg]  The heuristic is intended to make the site look good in most cases. 
+
+### Overriding the heuristic
+
+This behaviour can be overriden by setting the value of the `data-linkicon` [data attribute](https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/data-*) of a link:
+
+| Attribute to use                               | Description                                    |
+| ---------------------------------------------- | ---------------------------------------------- |
+| `{data-linkicon=external}`                     | *Force* displaying the icon next to the link   |
+| `{data-linkicon=none}` or `{data-linkicon=""}` | *Prevent* displaying the icon next to the link |
+
+[^noneg]: A common non-example is a hyperlink containing only an image in the description.
+
+Note that the attribute can also be used to display the icons in the [[html-template|HTML templates]] (like the footer or the sidebar) or in raw HTML of [[markdown]].
+
+## URL properties
+
+The displayed icon may depend on the link properties (e.g. the actual URI scheme). This is [[custom-style|customized using CSS]]. By default, Emanote displays a different icon if the URI scheme component is `mailto:`. Check the <https://github.com/EmaApps/emanote/blob/master/default/templates/base.tpl> of [[html-template|HTML template]] for details.
+
+## Demo
+
+* Default styling:
+  * [the emanote repo](https://github.com/EmaApps/emanote)
+  * [why the external link symbol ![[external-link-icon.svg]] is not in Unicode](https://www.unicode.org/alloc/nonapprovals.html)
+  * [$e^{i \pi} + 1 = 0$](https://en.wikipedia.org/wiki/Euler%27s_identity)
+  * [`(>>=) :: forall a b. m a -> (a -> m b) -> m b`](https://hackage.haskell.org/package/base/docs/Prelude.html#v:-62--62--61-)
+  * [![[hello-badge.svg]]](https://emanote.srid.ca)
+  * [email protected]
+* `{data-linkicon=none}` used to suppress the icon:
+  * Water's formula is [H](https://en.wikipedia.org/wiki/Hydrogen){data-linkicon=none}₂[O](https://en.wikipedia.org/wiki/Oxygen){data-linkicon=none}.
+  * A 90's style hyperlink:
+    [➡➡➡ **CLICK HERE!!!** ⬅⬅⬅](https://emanote.srid.ca){class="shadow-lg border-8 rounded-md bg-yellow-400 border-red-200" data-linkicon=none}
+* `{data-linkicon=external}` used to forcefully show the icon
+  * [![[pIqaD.svg]]](https://en.wikipedia.org/wiki/Klingon_scripts){data-linkicon=external}

docs/guide/markdown/custom-style.md

@@ -4,7 +4,7 @@ tags: [emanote/syntax/demo]
 
 # Custom CSS styling
 
-Parts of your Markdown may be styled using custom CSS classes provided by TailwindCSS.  
+Parts of your Markdown may be styled using custom CSS classes provided by TailwindCSS.
 
 The [attributes extension](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/attributes.md) provides the ability to set CSS classes on inline or block level elements of Markdown. You can also specify a "class map" in [[yaml-config|index.yaml]], the default value of which provides some builtin-in styles.
 
@@ -30,9 +30,9 @@ You should expect the above text to appear styled like a yellow sticky note, bec
 A portion of Markdown that is highlighted compared to the rest
 :::
 
-## Advanced styling 
+## Advanced styling
 
-Using [fenced_divs](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/fenced_divs.md) with [attributes](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/attributes.md) extension, you can wrap parts of your Markdown using a [div], and then style it en masse. For example, to [[embed|embed multiple notes]] in a "matrix" arrangement[^mob] you can make use of CSS grids as provided by Tailwind's classes. 
+Using [fenced_divs](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/fenced_divs.md) with [attributes](https://github.com/jgm/commonmark-hs/blob/master/commonmark-extensions/test/attributes.md) extension, you can wrap parts of your Markdown using a [div], and then style it en masse. For example, to [[embed|embed multiple notes]] in a "matrix" arrangement[^mob] you can make use of CSS grids as provided by Tailwind's classes.
 
 [div]: https://developer.mozilla.org/en-US/docs/Web/HTML/Element/div
 
@@ -46,3 +46,4 @@ Using [fenced_divs](https://github.com/jgm/commonmark-hs/blob/master/commonmark-
 
 
 [^mob]: If you are viewing this page on mobile or smaller screens, the embedded notes will be stacked on top of one another because we use Tailwind's [responsive classes](https://tailwindcss.com/docs/responsive-design). Incidentally, we use the `{class=".."}` syntax, rather than the `{.someClass}` syntax, only because the former is [more lenient](https://github.com/jgm/commonmark-hs/issues/76) in accepting non-standard class names, such as the Tailwind responsive classes (eg. `lg:grid-cols-2`).
+

emanote.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               emanote
-version:            0.8.1.3
+version:            0.8.1.4
 license:            AGPL-3.0-only
 copyright:          2022 Sridhar Ratnakumar
 maintainer:         [email protected]
@@ -175,6 +175,7 @@ library
     Emanote.Model.Title
     Emanote.Model.Type
     Emanote.Pandoc.BuiltinFilters
+    Emanote.Pandoc.BuiltinFiltersSpec
     Emanote.Pandoc.Link
     Emanote.Pandoc.Markdown.Parser
     Emanote.Pandoc.Markdown.Syntax.HashTag

src/Emanote/Pandoc/BuiltinFilters.hs

@@ -12,6 +12,8 @@ import Optics.Core ((^.))
 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
 
 -- TODO: Run this in `parseNote`?
 prepareNoteDoc :: N.Note -> B.Pandoc
@@ -22,6 +24,7 @@ preparePandoc :: W.Walkable B.Inline b => b -> b
 preparePandoc =
   linkifyInlineTags
     >>> fixEmojiFontFamily
+    >>> setExternalLinkIcon
 
 -- HashTag.hs generates a Span for inline tags.
 -- Here, we must link them to the special tag index page.
@@ -40,7 +43,7 @@ linkifyInlineTags =
     tagUrl =
       toText . encodeRoute . encodeTagIndexR . toList . HT.deconstructTag
 
--- Undo font-familly on emoji spans, so the browser uses an emoji font.
+-- Undo font-family on emoji spans, so the browser uses an emoji font.
 -- Ref: https://github.com/jgm/commonmark-hs/blob/3d545d7afa6c91820b4eebf3efeeb80bf1b27128/commonmark-extensions/src/Commonmark/Extensions/Emoji.hs#L30-L33
 fixEmojiFontFamily :: W.Walkable B.Inline b => b -> b
 fixEmojiFontFamily =
@@ -51,3 +54,46 @@ fixEmojiFontFamily =
               newAttrs = attrs <> one emojiFontAttr
            in B.Span (id', classes, newAttrs) is
     x -> x
+
+-- Add a data-linkicon=external attribute to external links that contain some
+-- text in their description, provided that they do not already have a
+-- data-linkicon attribute.
+setExternalLinkIcon :: W.Walkable B.Inline b => b -> b
+setExternalLinkIcon =
+  W.walk $ \case
+    B.Link (id', classes, attrs) inlines (url, title)
+      | hasURIScheme url && containsText inlines ->
+          let showLinkIconAttr = ("data-linkicon", "external")
+              newAttrs = insert attrs showLinkIconAttr
+           in B.Link (id', classes, newAttrs) inlines (url, title)
+    x -> x
+  where
+    -- Inserts an element in a key-value list if the element's key is not
+    -- already in the list.
+    insert :: Eq a => [(a, b)] -> (a, b) -> [(a, b)]
+    insert as a
+      | fst a `elem` (fst <$> as) = as
+      | otherwise = a : as
+    -- Checks whether the given text begins with an RFC 3986 compliant URI
+    -- scheme.
+    hasURIScheme :: Text -> Bool
+    hasURIScheme =
+      isRight . P.parse schemeP ""
+      where
+        schemeP = do
+          c <- PC.letter
+          cs <- P.many $ PC.alphaNum P.<|> P.oneOf ".-+"
+          void $ PC.char ':'
+          return (c : cs)
+    -- Checks whether a list of inlines contains a (perhaps nested) "textual
+    -- element", understood as a Pandoc `Str`, `Code` or `Math`.
+    containsText :: [B.Inline] -> Bool
+    containsText =
+      getAny
+        . W.query
+          ( \case
+              B.Str _ -> Any True
+              B.Code _ _ -> Any True
+              B.Math _ _ -> Any True
+              _ -> Any False
+          )

src/Emanote/Pandoc/BuiltinFiltersSpec.hs

@@ -0,0 +1,56 @@
+module Emanote.Pandoc.BuiltinFiltersSpec where
+
+import Emanote.Pandoc.BuiltinFilters (preparePandoc)
+import Emanote.Pandoc.Markdown.Parser (parseMarkdown)
+import Hedgehog
+import Relude
+import Test.Hspec
+import Test.Hspec.Hedgehog (hedgehog)
+import Text.Pandoc.Definition (Inline (..))
+import Text.Pandoc.Walk qualified as W
+
+spec :: Spec
+spec = do
+  describe "setExternalLinkIcon" $ do
+    it "respects user-specified data-linkicon attribute" . hedgehog $ do
+      getDataLinkIconAttrs "[test](https://www.test.com){data-linkicon=abc}" === Right ["abc"]
+      getDataLinkIconAttrs "[test](https://www.test.com){data-linkicon=\"\"}" === Right [""]
+      getDataLinkIconAttrs "[[foo]]{data-linkicon=external}" === Right ["external"]
+      getDataLinkIconAttrs "[abc](x/y/z){data-linkicon=none}" === Right ["none"]
+    it "does not add attribute if link is internal" . hedgehog $ do
+      getDataLinkIconAttrs "[[foo]]" === Right []
+      getDataLinkIconAttrs "[abc](x/y/z)" === Right []
+      getDataLinkIconAttrs "![[image.jpg]]" === Right []
+      getDataLinkIconAttrs "[![](path/to/image.png)](foo/bar/baz)" === Right []
+      getDataLinkIconAttrs "[[bar|baz]]" === Right []
+      getDataLinkIconAttrs "[`abc`](./test.txt)" === Right []
+      getDataLinkIconAttrs "[$$abc$$](/just/test#ing)" === Right []
+      getDataLinkIconAttrs "#tag" === Right []
+      getDataLinkIconAttrs "[[abc|def]]" === Right []
+    it "adds attribute if link is external and its description contains text, code or math" . hedgehog $ do
+      getDataLinkIconAttrs "[Emanote](https://github.com/EmaApps/emanote)" === Right ["external"]
+      getDataLinkIconAttrs "[`text`](http://somehost:1234/test)" === Right ["external"]
+      getDataLinkIconAttrs "[$$E=mc^2$$](ssh://[email protected]/~/path/)" === Right ["external"]
+      getDataLinkIconAttrs "[![[picture.png]] ~~**`code`**~~](scheme://host:port/path?query)" === Right ["external"]
+      getDataLinkIconAttrs "[==$$e^{i \\pi} + 1 = 0$$== ![[image.svg]]](git://host.xz/path/to/repo.git/)" === Right ["external"]
+      getDataLinkIconAttrs "[email protected]" === Right ["external"]
+      getDataLinkIconAttrs "https://www.test.gov" === Right ["external"]
+      getDataLinkIconAttrs "[**![[image.jpg]] *qwerty* ![[image.jpg]]**](doi:10.1000/182)" === Right ["external"]
+      getDataLinkIconAttrs "[:video_game:](bolo://hostname/)" === Right ["external"]
+    it "does not add attribute if link description contains no text, code or math" . hedgehog $ do
+      getDataLinkIconAttrs "[](http://nothing.interesting.here)" === Right []
+      getDataLinkIconAttrs "[![[image.png]]](https://www.example.com)" === Right []
+      getDataLinkIconAttrs "[==*_**~~![[img.png]]~~**_*==](http://something.info)" === Right []
+
+-- | Extract "data-linkicon" attributes present in the given Markdown content.
+getDataLinkIconAttrs :: Text -> Either Text [Text]
+getDataLinkIconAttrs =
+  fmap (W.query $ getLinkAttr "data-linkicon") . parseEmanoteMarkdown
+  where
+    parseEmanoteMarkdown = fmap (preparePandoc . snd) . parseMarkdown "<test>"
+
+getLinkAttr :: Text -> Inline -> [Text]
+getLinkAttr name (Link (_, _, attrs) _ (_, _)) =
+  snd <$> filter ((== name) . fst) attrs
+getLinkAttr _ _ =
+  []

src/Spec.hs

@@ -2,6 +2,7 @@ module Spec (main) where
 
 import Emanote.Model.Link.RelSpec qualified as RelSpec
 import Emanote.Model.QuerySpec qualified as QuerySpec
+import Emanote.Pandoc.BuiltinFiltersSpec qualified as BuiltinFiltersSpec
 import Relude
 import Test.Hspec (hspec)
 
@@ -10,3 +11,4 @@ main = do
   hspec $ do
     QuerySpec.spec
     RelSpec.spec
+    BuiltinFiltersSpec.spec