{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.Emoji
( HasEmoji(..)
, emojiSpec )
where
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.Inlines
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Html
import Text.Emoji (emojiFromAlias)
import Text.Parsec
import Data.Text (Text)
emojiSpec :: (Monad m, IsBlock il bl, IsInline il, HasEmoji il)
=> SyntaxSpec m il bl
emojiSpec = mempty
{ syntaxInlineParsers = [withAttributes parseEmoji]
}
class HasEmoji a where
emoji :: Text
-> Text
-> a
instance HasEmoji (Html a) where
emoji kw t = addAttribute ("class", "emoji") .
addAttribute ("data-emoji", kw) $
htmlInline "span" $ Just $ htmlText t
instance (HasEmoji i, Monoid i) => HasEmoji (WithSourceMap i) where
emoji kw t = emoji kw t <$ addName "emoji"
parseEmoji :: (Monad m, HasEmoji a) => InlineParser m a
parseEmoji = try $ do
symbol ':'
ts <- many1 $ satisfyWord (const True)
<|> symbol '_'
<|> symbol '+'
<|> symbol '-'
symbol ':'
let kw = untokenize ts
case emojiFromAlias kw of
Nothing -> fail "emoji not found"
Just t -> return $! emoji kw t