module Emanote.Pandoc.Markdown.Syntax.HashTag (
  hashTagSpec,
  inlineTagsInPandoc,
  getTagFromInline,
  TT.Tag (..),
  TT.TagPattern (..),
  TT.TagNode (..),
  TT.mkTagPattern,
  TT.tagMatch,
  TT.constructTag,
  TT.deconstructTag,
  TT.tagTree,
) where

import Commonmark (TokType (..))
import Commonmark qualified as CM
import Commonmark.Inlines qualified as CM
import Commonmark.Pandoc qualified as CP
import Commonmark.TokParsers (noneOfToks, symbol)
import Data.Map.Strict qualified as Map
import Data.TagTree qualified as TT
import Data.Text qualified as T
import Relude
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Walk qualified as W
import Text.Parsec qualified as P

inlineTagsInPandoc :: B.Pandoc -> [TT.Tag]
inlineTagsInPandoc :: Pandoc -> [Tag]
inlineTagsInPandoc = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe Tag
getTagFromInline

getTagFromInline :: B.Inline -> Maybe TT.Tag
getTagFromInline :: Inline -> Maybe Tag
getTagFromInline = \case
  B.Span (Text
_, [Text]
_, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList -> Map Text Text
attrs) [Inline]
_ -> do
    Text
tag <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tagDataAttr Map Text Text
attrs
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Tag
TT.Tag Text
tag
  Inline
_ -> forall a. Maybe a
Nothing

class HasHashTag il where
  hashTag :: TT.Tag -> il

instance HasHashTag (CP.Cm b B.Inlines) where
  hashTag :: Tag -> Cm b Inlines
hashTag (TT.Tag Text
tag) =
    let attrs :: [(Text, Text)]
attrs =
          [ (Text
"title", Text
"Tag")
          , (Text
tagDataAttr, Text
tag)
          ]
        classes :: [Text]
classes =
          [ Text
"emanote:inline-tag"
          , -- This must be placed *after* the class above, to allow the user to
            -- override generic styles (of the class above)
            Text
"emanote:inline-tag:" forall a. Semigroup a => a -> a -> a
<> Text
tag
          ]
     in forall b a. a -> Cm b a
CP.Cm forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Inlines -> Inlines
B.spanWith (Text
"", [Text]
classes, [(Text, Text)]
attrs) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
tag

tagDataAttr :: Text
tagDataAttr :: Text
tagDataAttr = Text
"data-tag"

hashTagSpec ::
  (Monad m, CM.IsBlock il bl, CM.IsInline il, HasHashTag il) =>
  CM.SyntaxSpec m il bl
hashTagSpec :: forall (m :: Type -> Type) il bl.
(Monad m, IsBlock il bl, IsInline il, HasHashTag il) =>
SyntaxSpec m il bl
hashTagSpec =
  forall a. Monoid a => a
mempty
    { syntaxInlineParsers :: [InlineParser m il]
CM.syntaxInlineParsers = [forall (m :: Type -> Type) il.
(Monad m, IsInline il, HasHashTag il) =>
InlineParser m il
pTag]
    }
  where
    pTag ::
      (Monad m, CM.IsInline il, HasHashTag il) =>
      CM.InlineParser m il
    pTag :: forall (m :: Type -> Type) il.
(Monad m, IsInline il, HasHashTag il) =>
InlineParser m il
pTag = forall s u (m :: Type -> Type) a.
ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
      Tok
_ <- forall (m :: Type -> Type) s.
Monad m =>
Char -> ParsecT [Tok] s m Tok
symbol Char
'#'
      Text
tag <- [Tok] -> Text
CM.untokenize forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type) s. Monad m => ParsecT [Tok] s m [Tok]
tagP
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall il. HasHashTag il => Tag -> il
hashTag forall a b. (a -> b) -> a -> b
$ Text -> Tag
TT.Tag Text
tag
    tagP :: Monad m => P.ParsecT [CM.Tok] s m [CM.Tok]
    tagP :: forall (m :: Type -> Type) s. Monad m => ParsecT [Tok] s m [Tok]
tagP = do
      [Tok]
s <- forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
some (forall (m :: Type -> Type) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [TokType]
disallowed)
      -- A tag cannot end with a slash (which is a separator in hierarchical tags)
      forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"/" Text -> Text -> Bool
`T.isSuffixOf` [Tok] -> Text
CM.untokenize [Tok]
s
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Tok]
s
      where
        disallowed :: [TokType]
disallowed = [TokType
Spaces, TokType
UnicodeSpace, TokType
LineEnd] forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> TokType
Symbol [Char]
punctuation
        punctuation :: [Char]
punctuation = [Char]
"[];:,.?!"