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 =
  Pandoc -> Pandoc
forall b. Walkable Inline b => b -> b
preparePandoc (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$ Note
note Note -> Optic' A_Lens NoIx Note Pandoc -> Pandoc
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Note Pandoc
N.noteDoc

preparePandoc :: W.Walkable B.Inline b => b -> b
preparePandoc :: forall b. Walkable Inline b => b -> b
preparePandoc =
  b -> b
forall b. Walkable Inline b => b -> b
linkifyInlineTags
    (b -> b) -> (b -> b) -> b -> b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> b -> b
forall b. Walkable Inline b => b -> b
fixEmojiFontFamily
    (b -> b) -> (b -> b) -> b -> b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> b -> b
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 =
  (Inline -> Inline) -> b -> b
forall a b. Walkable a b => (a -> a) -> b -> b
W.walk ((Inline -> Inline) -> b -> b) -> (Inline -> Inline) -> b -> b
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 Attr
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 =
      FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> (Tag -> FilePath) -> Tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @() 'Html -> FilePath
forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
encodeRoute (R @() 'Html -> FilePath)
-> (Tag -> R @() 'Html) -> Tag -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagNode] -> R @() 'Html
encodeTagIndexR ([TagNode] -> R @() 'Html)
-> (Tag -> [TagNode]) -> Tag -> R @() 'Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TagNode -> [TagNode]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty TagNode -> [TagNode])
-> (Tag -> NonEmpty TagNode) -> Tag -> [TagNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Tag -> NonEmpty TagNode
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 =
  (Inline -> Inline) -> b -> b
forall a b. Walkable a b => (a -> a) -> b -> b
W.walk ((Inline -> Inline) -> b -> b) -> (Inline -> Inline) -> b -> b
forall a b. (a -> b) -> a -> b
$ \case
    B.Span (Text
id', [Text]
classes, [(Text, Text)]
attrs) [Inline]
is
      | [Text]
classes [Text] -> [Text] -> Bool
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 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> OneItem [(Text, Text)] -> [(Text, Text)]
forall x. One x => OneItem x -> x
one (Text, Text)
OneItem [(Text, Text)]
emojiFontAttr
           in Attr -> [Inline] -> Inline
B.Span (Text
id', [Text]
classes, [(Text, Text)]
newAttrs) [Inline]
is
    Inline
x -> Inline
x