    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Text.Emoji
    ( emojis
    , emojiFromAlias
    , aliasesFromEmoji
    , replaceEmojis
    , baseEmojis
    , zwjEmojis
    ) where

    import Prelude
    import Data.Char (chr, ord)
    import qualified Data.Map as M
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Bifunctor (first)
    import Trie as Trie
    import Data.List (foldl')

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

    emojiAliasMap :: M.Map Text [Text]
    emojiAliasMap :: Map Text [Text]
    emojiAliasMap =
      (Map Text [Text] -> (Text, Text) -> Map Text [Text])
    -> Map Text [Text] -> [(Text, Text)] -> Map Text [Text]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Map Text [Text]
    m (Text
    alias, Text
    s) -> (Maybe [Text] -> Maybe [Text])
    -> Text -> Map Text [Text] -> Map Text [Text]
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    M.alter (Text -> Maybe [Text] -> Maybe [Text]
    forall {a}. a -> Maybe [a] -> Maybe [a]
    go Text
    alias) Text
    s Map Text [Text]
    m) Map Text [Text]
    forall a. Monoid a => a
    mempty [(Text, Text)]
    emojis
        where
         go :: a -> Maybe [a] -> Maybe [a]
    go a
    alias Maybe [a]
    Nothing   = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a
    alias]
         go a
    alias (Just [a]
    as) = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just (a
    aliasa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    as)

    -- | Lookup an emoji given its alias.
    emojiFromAlias :: Text -> Maybe Text
    emojiFromAlias :: Text -> Maybe Text
    emojiFromAlias Text
    name = Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    name Map Text Text
    emojiMap

    -- | Lookup the aliases of an emoji.
    aliasesFromEmoji :: Text -> Maybe [Text]
    aliasesFromEmoji :: Text -> Maybe [Text]
    aliasesFromEmoji Text
    s = Text -> Map Text [Text] -> Maybe [Text]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    s Map Text [Text]
    emojiAliasMap

    -- | Replace emojis in a text with alternative text.
    -- The replacement function maps an emoji and a list of emoji aliases
    -- to a replacement text.
    replaceEmojis :: (Text -> [Text] -> Text) -> Text -> Text
    replaceEmojis :: (Text -> [Text] -> Text) -> Text -> Text
    replaceEmojis Text -> [Text] -> Text
    getReplacement = [Int] -> Text
    fromCodePoints ([Int] -> Text) -> (Text -> [Int]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [Int]
    go ([Int] -> [Int]) -> (Text -> [Int]) -> Text -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Int]
    toCodePoints
     where
       go :: [Int] -> [Int]
    go [] = []
       go (Int
    c:[Int]
    cs) =
           case Trie [Text] -> [Int] -> Maybe ([Text], Int, Trie [Text])
    forall (t :: * -> *) a.
    Foldable t =>
    Trie a -> t Int -> Maybe (a, Int, Trie a)
    Trie.matchLongestPrefix Trie [Text]
    emojiTrie (Int
    cInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    cs) of
             Just ([Text]
    aliases, Int
    numcps, Trie [Text]
    _subtrie) ->
               let ([Int]
    consumed, [Int]
    remaining) = Int -> [Int] -> ([Int], [Int])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    numcps (Int
    cInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    cs)
                in Text -> [Int]
    toCodePoints (Text -> [Text] -> Text
    getReplacement ([Int] -> Text
    fromCodePoints [Int]
    consumed) [Text]
    aliases)
                     [Int] -> [Int] -> [Int]
    forall a. Semigroup a => a -> a -> a
    <> [Int] -> [Int]
    go [Int]
    remaining
             Maybe ([Text], Int, Trie [Text])
    Nothing -> -- go forward one UTF8 code point
               Int
    c Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int] -> [Int]
    go [Int]
    cs

    toCodePoints :: Text -> [Int]
    toCodePoints :: Text -> [Int]
    toCodePoints = (Char -> Int) -> [Char] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Int
    ord ([Char] -> [Int]) -> (Text -> [Char]) -> Text -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Char]
    T.unpack

    fromCodePoints :: [Int] -> Text
    fromCodePoints :: [Int] -> Text
    fromCodePoints = [Char] -> Text
    T.pack ([Char] -> Text) -> ([Int] -> [Char]) -> [Int] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    chr

    emojiTrie :: Trie.Trie [Text]
    emojiTrie :: Trie [Text]
    emojiTrie =
      [([Int], [Text])] -> Trie [Text]
    forall a. [([Int], a)] -> Trie a
    Trie.fromList ([([Int], [Text])] -> Trie [Text])
    -> (Map Text [Text] -> [([Int], [Text])])
    -> Map Text [Text]
    -> Trie [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, [Text]) -> ([Int], [Text]))
    -> [(Text, [Text])] -> [([Int], [Text])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> [Int]) -> (Text, [Text]) -> ([Int], [Text])
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Text -> [Int]
    toCodePoints) ([(Text, [Text])] -> [([Int], [Text])])
    -> (Map Text [Text] -> [(Text, [Text])])
    -> Map Text [Text]
    -> [([Int], [Text])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text [Text] -> [(Text, [Text])]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map Text [Text] -> Trie [Text]) -> Map Text [Text] -> Trie [Text]
    forall a b. (a -> b) -> a -> b
    $ Map Text [Text]
    emojiAliasMap

    -- | Association list of (alias, emoji) pairs.  Note that the
    -- same emoji may have multiple aliases.
    emojis :: [(Text, Text)]

    -- | A list of all valid emoji (not containing zero-width joiners), taken from
    -- the Unicode Emoji Specification.
    baseEmojis :: [Text]

    -- | A list of all valid emoji built from zero-width joiners, taken from the
    -- Unicode Emoji Specification.
    zwjEmojis :: [Text]
    #include "emojis.inc"