    {-# 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 :: forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il, HasEmoji il) =>
    SyntaxSpec m il bl
    emojiSpec = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxInlineParsers = [withAttributes parseEmoji]
      }

    class HasEmoji a where
      emoji :: Text   -- the ascii keyword
            -> Text   -- the emoji characters
            -> a

    instance HasEmoji (Html a) where
      emoji :: Text -> Text -> Html a
    emoji Text
    kw Text
    t = Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "emoji") (Html a -> Html a) -> (Html a -> Html a) -> Html a -> Html a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                   Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "data-emoji", Text
    kw) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "span" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    t

    instance (HasEmoji i, Monoid i) => HasEmoji (WithSourceMap i) where
      emoji :: Text -> Text -> WithSourceMap i
    emoji Text
    kw Text
    t = Text -> Text -> i
    forall a. HasEmoji a => Text -> Text -> a
    emoji Text
    kw Text
    t i -> WithSourceMap () -> WithSourceMap i
    forall a b. a -> WithSourceMap b -> WithSourceMap a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Text -> WithSourceMap ()
    addName Text
    "emoji"

    parseEmoji :: (Monad m, HasEmoji a) => InlineParser m a
    parseEmoji :: forall (m :: * -> *) a. (Monad m, HasEmoji a) => InlineParser m a
    parseEmoji = ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] (IPState m) (StateT Enders m) a
     -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $ do
      Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    ':'
      ts <- ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (ParsecT [Tok] (IPState m) (StateT Enders m) Tok
     -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok])
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) [Tok]
    forall a b. (a -> b) -> a -> b
    $ (Text -> Bool) -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Text -> Bool) -> ParsecT [Tok] s m Tok
    satisfyWord (Bool -> Text -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
                 ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '_'
                 ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '+'
                 ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '-'
      symbol ':'
      let kw = [Tok] -> Text
    untokenize [Tok]
    ts
      case emojiFromAlias kw of
        Maybe Text
    Nothing -> String -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a. String -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "emoji not found"
        Just Text
    t  -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $! Text -> Text -> a
    forall a. HasEmoji a => Text -> Text -> a
    emoji Text
    kw Text
    t