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
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
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
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