{-# 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 ( MonadError(..), ExceptT(..), runExceptT )
import Control.Monad.Trans ( MonadTrans(..) )
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 :: Value -> Parser EmojiData
parseJSON = String -> (Array -> Parser EmojiData) -> Value -> Parser EmojiData
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"EmojiData" ((Array -> Parser EmojiData) -> Value -> Parser EmojiData)
-> (Array -> Parser EmojiData) -> Value -> Parser EmojiData
forall a b. (a -> b) -> a -> b
$ \Array
v -> do
Vector (Seq Text)
aliasVecs <- Array -> (Value -> Parser (Seq Text)) -> Parser (Vector (Seq Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Array
v ((Value -> Parser (Seq Text)) -> Parser (Vector (Seq Text)))
-> (Value -> Parser (Seq Text)) -> Parser (Vector (Seq Text))
forall a b. (a -> b) -> a -> b
$ \Value
val ->
((Object -> Parser (Seq Text)) -> Value -> Parser (Seq Text))
-> Value -> (Object -> Parser (Seq Text)) -> Parser (Seq Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser (Seq Text)) -> Value -> Parser (Seq Text)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"EmojiData Entry") Value
val ((Object -> Parser (Seq Text)) -> Parser (Seq Text))
-> (Object -> Parser (Seq Text)) -> Parser (Seq Text)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
Seq Value
as <- Object
obj Object -> Key -> Parser (Seq Value)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"short_names"
Seq Value -> (Value -> Parser Text) -> Parser (Seq Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Seq Value
as ((Value -> Parser Text) -> Parser (Seq Text))
-> (Value -> Parser Text) -> Parser (Seq Text)
forall a b. (a -> b) -> a -> b
$ String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Alias list element" Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return
EmojiData -> Parser EmojiData
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (EmojiData -> Parser EmojiData) -> EmojiData -> Parser EmojiData
forall a b. (a -> b) -> a -> b
$ Seq Text -> EmojiData
EmojiData (Seq Text -> EmojiData) -> Seq Text -> EmojiData
forall a b. (a -> b) -> a -> b
$ [Seq Text] -> Seq Text
forall a. Monoid a => [a] -> a
mconcat ([Seq Text] -> Seq Text) -> [Seq Text] -> Seq Text
forall a b. (a -> b) -> a -> b
$ Vector (Seq Text) -> [Seq Text]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector (Seq Text)
aliasVecs
emptyEmojiCollection :: EmojiCollection
emptyEmojiCollection :: EmojiCollection
emptyEmojiCollection = [Text] -> EmojiCollection
EmojiCollection [Text]
forall a. Monoid a => a
mempty
loadEmoji :: FilePath -> IO (Either String EmojiCollection)
loadEmoji :: String -> IO (Either String EmojiCollection)
loadEmoji String
path = ExceptT String IO EmojiCollection
-> IO (Either String EmojiCollection)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO EmojiCollection
-> IO (Either String EmojiCollection))
-> ExceptT String IO EmojiCollection
-> IO (Either String EmojiCollection)
forall a b. (a -> b) -> a -> b
$ do
Either SomeException ByteString
result <- IO (Either SomeException ByteString)
-> ExceptT String IO (Either SomeException ByteString)
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either SomeException ByteString)
-> ExceptT String IO (Either SomeException ByteString))
-> IO (Either SomeException ByteString)
-> ExceptT String IO (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either SomeException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO ByteString -> IO (Either SomeException ByteString))
-> IO ByteString -> IO (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BSL.readFile String
path
case Either SomeException ByteString
result of
Left (SomeException
e::E.SomeException) -> String -> ExceptT String IO EmojiCollection
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO EmojiCollection)
-> String -> ExceptT String IO EmojiCollection
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right ByteString
bs -> do
EmojiData Seq Text
es <- IO (Either String EmojiData) -> ExceptT String IO EmojiData
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String EmojiData) -> ExceptT String IO EmojiData)
-> IO (Either String EmojiData) -> ExceptT String IO EmojiData
forall a b. (a -> b) -> a -> b
$ Either String EmojiData -> IO (Either String EmojiData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String EmojiData -> IO (Either String EmojiData))
-> Either String EmojiData -> IO (Either String EmojiData)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String EmojiData
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
bs
EmojiCollection -> ExceptT String IO EmojiCollection
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EmojiCollection -> ExceptT String IO EmojiCollection)
-> EmojiCollection -> ExceptT String IO EmojiCollection
forall a b. (a -> b) -> a -> b
$ [Text] -> EmojiCollection
EmojiCollection ([Text] -> EmojiCollection) -> [Text] -> EmojiCollection
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Text
es
lookupEmoji :: EmojiCollection -> T.Text -> [T.Text]
lookupEmoji :: EmojiCollection -> Text -> [Text]
lookupEmoji (EmojiCollection [Text]
es) Text
search =
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
matchesEmoji Text
search) [Text]
es
matchesEmoji :: T.Text
-> T.Text
-> Bool
matchesEmoji :: Text -> Text -> Bool
matchesEmoji Text
searchString Text
e =
Text -> Text
sanitizeEmojiSearch Text
searchString Text -> Text -> Bool
`T.isInfixOf` Text
e
sanitizeEmojiSearch :: T.Text -> T.Text
sanitizeEmojiSearch :: Text -> Text
sanitizeEmojiSearch = Text -> Text
stripColons (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
getMatchingEmoji :: Session -> EmojiCollection -> T.Text -> IO [T.Text]
getMatchingEmoji :: Session -> EmojiCollection -> Text -> IO [Text]
getMatchingEmoji Session
session EmojiCollection
em Text
rawSearchString = do
let localAlts :: [Text]
localAlts = EmojiCollection -> Text -> [Text]
lookupEmoji EmojiCollection
em Text
rawSearchString
sanitized :: Text
sanitized = Text -> Text
sanitizeEmojiSearch Text
rawSearchString
Either SomeException [Emoji]
customResult <- IO [Emoji] -> IO (Either SomeException [Emoji])
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO [Emoji] -> IO (Either SomeException [Emoji]))
-> IO [Emoji] -> IO (Either SomeException [Emoji])
forall a b. (a -> b) -> a -> b
$ case Text -> Bool
T.null Text
sanitized of
Bool
True -> Maybe Integer -> Maybe Integer -> Session -> IO [Emoji]
MM.mmGetListOfCustomEmoji Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Session
session
Bool
False -> Text -> Session -> IO [Emoji]
MM.mmSearchCustomEmoji Text
sanitized Session
session
let custom :: [Emoji]
custom = case Either SomeException [Emoji]
customResult of
Left (SomeException
_::E.SomeException) -> []
Right [Emoji]
result -> [Emoji]
result
[Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Emoji -> Text
MM.emojiName (Emoji -> Text) -> [Emoji] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Emoji]
custom) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
localAlts
stripColons :: T.Text -> T.Text
stripColons :: Text -> Text
stripColons Text
t =
Text -> Text
stripHeadColon (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTailColon Text
t
where
stripHeadColon :: Text -> Text
stripHeadColon Text
v = if Text
":" Text -> Text -> Bool
`T.isPrefixOf` Text
v
then HasCallStack => Text -> Text
Text -> Text
T.tail Text
v
else Text
v
stripTailColon :: Text -> Text
stripTailColon Text
v = if Text
":" Text -> Text -> Bool
`T.isSuffixOf` Text
v
then HasCallStack => Text -> Text
Text -> Text
T.init Text
v
else Text
v