1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE OverloadedStrings #-}
4module Commonmark.Extensions.Emoji
5  ( HasEmoji(..)
6  , emojiSpec )
7where
8import Commonmark.Types
9import Commonmark.Tokens
10import Commonmark.Syntax
11import Commonmark.Inlines
12import Commonmark.SourceMap
13import Commonmark.TokParsers
14import Commonmark.Html
15import Text.Emoji (emojiFromAlias)
16import Text.Parsec
17import Data.Text (Text)
18
19emojiSpec :: (Monad m, IsBlock il bl, IsInline il, HasEmoji il)
20          => SyntaxSpec m il bl
21emojiSpec = mempty
22  { syntaxInlineParsers = [withAttributes parseEmoji]
23  }
24
25class HasEmoji a where
26  emoji :: Text   -- the ascii keyword
27        -> Text   -- the emoji characters
28        -> a
29
30instance HasEmoji (Html a) where
31  emoji kw t = addAttribute ("class", "emoji") .
32               addAttribute ("data-emoji", kw) $
33    htmlInline "span" $ Just $ htmlText t
34
35instance (HasEmoji i, Monoid i) => HasEmoji (WithSourceMap i) where
36  emoji kw t = emoji kw t <$ addName "emoji"
37
38parseEmoji :: (Monad m, HasEmoji a) => InlineParser m a
39parseEmoji = try $ do
40  symbol ':'
41  ts <- many1 $ satisfyWord (const True)
42             <|> symbol '_'
43             <|> symbol '+'
44             <|> symbol '-'
45  symbol ':'
46  let kw = untokenize ts
47  case emojiFromAlias kw of
48    Nothing -> fail "emoji not found"
49    Just t  -> return $! emoji kw t
50