{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Emoji
   Copyright   : Copyright (C) 2015 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Emoji symbol lookup from canonical string identifier.
-}
module Text.Pandoc.Emoji ( emojis, emojiToInline ) where
import qualified Text.Emoji as E
import Text.Pandoc.Definition (Inline (Span, Str))
import Data.Text (Text)
import qualified Data.Map as M

emojis :: M.Map Text Text
emojis :: Map Text Text
emojis = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Text)]
E.emojis

emojiToInline :: Text -> Maybe Inline
emojiToInline :: Text -> Maybe Inline
emojiToInline Text
emojikey = Text -> Inline
makeSpan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
E.emojiFromAlias Text
emojikey
  where makeSpan :: Text -> Inline
makeSpan = Attr -> [Inline] -> Inline
Span (Text
"", [Text
"emoji"], [(Text
"data-emoji", Text
emojikey)]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Str