module Emanote.Pandoc.BuiltinFilters (
  prepareNoteDoc,
  preparePandoc,
) where

import Emanote.Model.Note qualified as N
import Emanote.Pandoc.ExternalLink (setExternalLinkIcon)
import Emanote.Pandoc.Markdown.Syntax.HashTag qualified as HT
import Emanote.Route (encodeRoute)
import Emanote.Route.SiteRoute.Type (encodeTagIndexR)
import Optics.Core ((^.))
import Relude
import Text.Pandoc.Definition qualified as B
import Text.Pandoc.Walk qualified as W

-- TODO: Run this in `parseNote`?
prepareNoteDoc :: N.Note -> B.Pandoc
prepareNoteDoc :: Note -> Pandoc
prepareNoteDoc Note
note =
  forall b. Walkable Inline b => b -> b
preparePandoc forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Pandoc
N.noteDoc

preparePandoc :: W.Walkable B.Inline b => b -> b
preparePandoc :: forall b. Walkable Inline b => b -> b
preparePandoc =
  forall b. Walkable Inline b => b -> b
linkifyInlineTags
    forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> forall b. Walkable Inline b => b -> b
fixEmojiFontFamily
    forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> forall b. Walkable Inline b => b -> b
setExternalLinkIcon

-- HashTag.hs generates a Span for inline tags.
-- Here, we must link them to the special tag index page.
linkifyInlineTags :: W.Walkable B.Inline b => b -> b
linkifyInlineTags :: forall b. Walkable Inline b => b -> b
linkifyInlineTags =
  forall a b. Walkable a b => (a -> a) -> b -> b
W.walk forall a b. (a -> b) -> a -> b
$ \case
    inline :: Inline
inline@(B.Span Attr
attr [Inline]
is) ->
      if
          | Just Tag
inlineTag <- Inline -> Maybe Tag
HT.getTagFromInline Inline
inline ->
              Attr -> [Inline] -> Inline
B.Span Attr
attr [Attr -> [Inline] -> (Text, Text) -> Inline
B.Link forall a. Monoid a => a
mempty [Inline]
is (Tag -> Text
tagUrl Tag
inlineTag, Text
"Tag")]
          | Bool
otherwise ->
              Inline
inline
    Inline
x ->
      Inline
x
  where
    tagUrl :: Tag -> Text
tagUrl =
      forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
encodeRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagNode] -> R @() 'Html
encodeTagIndexR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Tag -> NonEmpty TagNode
HT.deconstructTag

-- 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 :: forall b. Walkable Inline b => b -> b
fixEmojiFontFamily =
  forall a b. Walkable a b => (a -> a) -> b -> b
W.walk forall a b. (a -> b) -> a -> b
$ \case
    B.Span (Text
id', [Text]
classes, [(Text, Text)]
attrs) [Inline]
is
      | [Text]
classes forall a. Eq a => a -> a -> Bool
== [Text
"emoji"] ->
          let emojiFontAttr :: (Text, Text)
emojiFontAttr = (Text
"style", Text
"font-family: emoji")
              newAttrs :: [(Text, Text)]
newAttrs = [(Text, Text)]
attrs forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one (Text, Text)
emojiFontAttr
           in Attr -> [Inline] -> Inline
B.Span (Text
id', [Text]
classes, [(Text, Text)]
newAttrs) [Inline]
is
    Inline
x -> Inline
x