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