{-# LANGUAGE ScopedTypeVariables #-}
module Matterhorn.Emoji
( EmojiCollection
, loadEmoji
, emptyEmojiCollection
, getMatchingEmoji
, matchesEmoji
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Control.Exception as E
import Control.Monad.Except
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Foldable as F
import qualified Data.Text as T
import qualified Data.Sequence as Seq
import Network.Mattermost.Types ( Session )
import qualified Network.Mattermost.Endpoints as MM
newtype EmojiData = EmojiData (Seq.Seq T.Text)
newtype EmojiCollection = EmojiCollection [T.Text]
instance A.FromJSON EmojiData where
parseJSON = A.withArray "EmojiData" $ \v -> do
aliasVecs <- forM v $ \val ->
flip (A.withObject "EmojiData Entry") val $ \obj -> do
as <- obj A..: "aliases"
forM as $ A.withText "Alias list element" return
return $ EmojiData $ mconcat $ F.toList aliasVecs
emptyEmojiCollection :: EmojiCollection
emptyEmojiCollection = EmojiCollection mempty
loadEmoji :: FilePath -> IO (Either String EmojiCollection)
loadEmoji path = runExceptT $ do
result <- lift $ E.try $ BSL.readFile path
case result of
Left (e::E.SomeException) -> throwError $ show e
Right bs -> do
EmojiData es <- ExceptT $ return $ A.eitherDecode bs
return $ EmojiCollection $ T.toLower <$> F.toList es
lookupEmoji :: EmojiCollection -> T.Text -> [T.Text]
lookupEmoji (EmojiCollection es) search =
filter (matchesEmoji search) es
matchesEmoji :: T.Text
-> T.Text
-> Bool
matchesEmoji searchString e =
sanitizeEmojiSearch searchString `T.isInfixOf` e
sanitizeEmojiSearch :: T.Text -> T.Text
sanitizeEmojiSearch = stripColons . T.toLower . T.strip
getMatchingEmoji :: Session -> EmojiCollection -> T.Text -> IO [T.Text]
getMatchingEmoji session em rawSearchString = do
let localAlts = lookupEmoji em rawSearchString
sanitized = sanitizeEmojiSearch rawSearchString
customResult <- E.try $ case T.null sanitized of
True -> MM.mmGetListOfCustomEmoji Nothing Nothing session
False -> MM.mmSearchCustomEmoji sanitized session
let custom = case customResult of
Left (_::E.SomeException) -> []
Right result -> result
return $ sort $ (MM.emojiName <$> custom) <> localAlts
stripColons :: T.Text -> T.Text
stripColons t =
stripHeadColon $ stripTailColon t
where
stripHeadColon v = if ":" `T.isPrefixOf` v
then T.tail v
else v
stripTailColon v = if ":" `T.isSuffixOf` v
then T.init v
else v