{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Network.Reddit.Types.Emoji
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Emoji
    ( Emoji(..)
    , mkEmoji
    , NewEmoji
    , EmojiName
    , mkEmojiName
    , EmojiList
    ) where

import           Control.Monad.Catch            ( MonadThrow )

import           Data.Aeson
                 ( (.:)
                 , FromJSON(..)
                 , Value(..)
                 , withObject
                 )
import           Data.Coerce                    ( coerce )
import           Data.Generics.Product
import qualified Data.HashMap.Strict            as HM
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import           Data.Traversable               ( for )

import           GHC.Exts                       ( IsList(fromList) )
import           GHC.Generics                   ( Generic )

import           Lens.Micro

import           Network.Reddit.Types.Account
import           Network.Reddit.Types.Internal
import           Network.Reddit.Types.Subreddit

import           Web.FormUrlEncoded             ( ToForm(..) )
import           Web.HttpApiData                ( ToHttpApiData(toQueryParam)
                                                )

-- | A single emoji. This can either be one of Reddit\'s builtin \"snoomojis\"
-- or a custom emoji for a subreddit. See 'mkEmoji' for creating news ones
data Emoji = Emoji
    { -- | Depending on how the emoji was obtained, this field may be empty,
      -- as names must be taken from keys of a larger JSON object
      Emoji -> EmojiName
name             :: EmojiName
      -- | This field will be present when obtaining existing emojis, but
      -- should be left empty when creating new ones
    , Emoji -> Bool
modFlairOnly     :: Bool
    , Emoji -> Bool
postFlairAllowed :: Bool
    , Emoji -> Bool
userFlairAllowed :: Bool
      -- | Points to a Reddit-hosted image. This will be present for
      --  existing emoji, but should be left empty when creating them
    , Emoji -> Maybe UserID
createdBy        :: Maybe UserID
    , Emoji -> Maybe UploadURL
url              :: Maybe UploadURL
    }
    deriving stock ( Int -> Emoji -> ShowS
[Emoji] -> ShowS
Emoji -> String
(Int -> Emoji -> ShowS)
-> (Emoji -> String) -> ([Emoji] -> ShowS) -> Show Emoji
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emoji] -> ShowS
$cshowList :: [Emoji] -> ShowS
show :: Emoji -> String
$cshow :: Emoji -> String
showsPrec :: Int -> Emoji -> ShowS
$cshowsPrec :: Int -> Emoji -> ShowS
Show, Emoji -> Emoji -> Bool
(Emoji -> Emoji -> Bool) -> (Emoji -> Emoji -> Bool) -> Eq Emoji
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Emoji -> Emoji -> Bool
$c/= :: Emoji -> Emoji -> Bool
== :: Emoji -> Emoji -> Bool
$c== :: Emoji -> Emoji -> Bool
Eq, (forall x. Emoji -> Rep Emoji x)
-> (forall x. Rep Emoji x -> Emoji) -> Generic Emoji
forall x. Rep Emoji x -> Emoji
forall x. Emoji -> Rep Emoji x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Emoji x -> Emoji
$cfrom :: forall x. Emoji -> Rep Emoji x
Generic )

instance FromJSON Emoji where
    parseJSON :: Value -> Parser Emoji
parseJSON = String -> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Emoji" ((Object -> Parser Emoji) -> Value -> Parser Emoji)
-> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a b. (a -> b) -> a -> b
$ \Object
o -> EmojiName
-> Bool -> Bool -> Bool -> Maybe UserID -> Maybe UploadURL -> Emoji
Emoji EmojiName
forall a. Monoid a => a
mempty
        (Bool -> Bool -> Bool -> Maybe UserID -> Maybe UploadURL -> Emoji)
-> Parser Bool
-> Parser
     (Bool -> Bool -> Maybe UserID -> Maybe UploadURL -> Emoji)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mod_flair_only"
        Parser (Bool -> Bool -> Maybe UserID -> Maybe UploadURL -> Emoji)
-> Parser Bool
-> Parser (Bool -> Maybe UserID -> Maybe UploadURL -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"post_flair_allowed"
        Parser (Bool -> Maybe UserID -> Maybe UploadURL -> Emoji)
-> Parser Bool -> Parser (Maybe UserID -> Maybe UploadURL -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_flair_allowed"
        Parser (Maybe UserID -> Maybe UploadURL -> Emoji)
-> Parser (Maybe UserID) -> Parser (Maybe UploadURL -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UserID)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_by"
        Parser (Maybe UploadURL -> Emoji)
-> Parser (Maybe UploadURL) -> Parser Emoji
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UploadURL)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"

instance ToForm Emoji where
    toForm :: Emoji -> Form
toForm Emoji { Bool
Maybe UploadURL
Maybe UserID
EmojiName
url :: Maybe UploadURL
createdBy :: Maybe UserID
userFlairAllowed :: Bool
postFlairAllowed :: Bool
modFlairOnly :: Bool
name :: EmojiName
$sel:url:Emoji :: Emoji -> Maybe UploadURL
$sel:createdBy:Emoji :: Emoji -> Maybe UserID
$sel:userFlairAllowed:Emoji :: Emoji -> Bool
$sel:postFlairAllowed:Emoji :: Emoji -> Bool
$sel:modFlairOnly:Emoji :: Emoji -> Bool
$sel:name:Emoji :: Emoji -> EmojiName
.. } =
        [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Text
"mod_flair_only", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
modFlairOnly)
                 , (Text
"post_flair_allowed", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
postFlairAllowed)
                 , (Text
"user_flair_allowed", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Bool
userFlairAllowed)
                 ]

-- | Wrapper for creating new 'Emoji's, which includes the @name@ field
newtype NewEmoji = NewEmoji Emoji
    deriving stock ( Int -> NewEmoji -> ShowS
[NewEmoji] -> ShowS
NewEmoji -> String
(Int -> NewEmoji -> ShowS)
-> (NewEmoji -> String) -> ([NewEmoji] -> ShowS) -> Show NewEmoji
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewEmoji] -> ShowS
$cshowList :: [NewEmoji] -> ShowS
show :: NewEmoji -> String
$cshow :: NewEmoji -> String
showsPrec :: Int -> NewEmoji -> ShowS
$cshowsPrec :: Int -> NewEmoji -> ShowS
Show, (forall x. NewEmoji -> Rep NewEmoji x)
-> (forall x. Rep NewEmoji x -> NewEmoji) -> Generic NewEmoji
forall x. Rep NewEmoji x -> NewEmoji
forall x. NewEmoji -> Rep NewEmoji x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewEmoji x -> NewEmoji
$cfrom :: forall x. NewEmoji -> Rep NewEmoji x
Generic )

instance ToForm NewEmoji where
    toForm :: NewEmoji -> Form
toForm (NewEmoji emoji :: Emoji
emoji@Emoji { EmojiName
name :: EmojiName
$sel:name:Emoji :: Emoji -> EmojiName
name }) =
        Emoji -> Form
forall a. ToForm a => a -> Form
toForm Emoji
emoji Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [Item Form] -> Form
forall l. IsList l => [Item l] -> l
fromList [ (Text
"name", EmojiName -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam EmojiName
name) ]

-- | Create a new 'Emoji' by providing an 'EmojiName'; default values are provided
-- for all other fields
mkEmoji :: EmojiName -> Emoji
mkEmoji :: EmojiName -> Emoji
mkEmoji EmojiName
name = Emoji :: EmojiName
-> Bool -> Bool -> Bool -> Maybe UserID -> Maybe UploadURL -> Emoji
Emoji
    { $sel:createdBy:Emoji :: Maybe UserID
createdBy        = Maybe UserID
forall a. Maybe a
Nothing
    , $sel:url:Emoji :: Maybe UploadURL
url              = Maybe UploadURL
forall a. Maybe a
Nothing
    , $sel:modFlairOnly:Emoji :: Bool
modFlairOnly     = Bool
False
    , $sel:postFlairAllowed:Emoji :: Bool
postFlairAllowed = Bool
True
    , $sel:userFlairAllowed:Emoji :: Bool
userFlairAllowed = Bool
True
    , EmojiName
name :: EmojiName
$sel:name:Emoji :: EmojiName
..
    }

-- | The name of an individual 'Emoji'
newtype EmojiName = EmojiName Text
    deriving stock ( Int -> EmojiName -> ShowS
[EmojiName] -> ShowS
EmojiName -> String
(Int -> EmojiName -> ShowS)
-> (EmojiName -> String)
-> ([EmojiName] -> ShowS)
-> Show EmojiName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmojiName] -> ShowS
$cshowList :: [EmojiName] -> ShowS
show :: EmojiName -> String
$cshow :: EmojiName -> String
showsPrec :: Int -> EmojiName -> ShowS
$cshowsPrec :: Int -> EmojiName -> ShowS
Show, (forall x. EmojiName -> Rep EmojiName x)
-> (forall x. Rep EmojiName x -> EmojiName) -> Generic EmojiName
forall x. Rep EmojiName x -> EmojiName
forall x. EmojiName -> Rep EmojiName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmojiName x -> EmojiName
$cfrom :: forall x. EmojiName -> Rep EmojiName x
Generic )
    deriving newtype ( EmojiName -> EmojiName -> Bool
(EmojiName -> EmojiName -> Bool)
-> (EmojiName -> EmojiName -> Bool) -> Eq EmojiName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmojiName -> EmojiName -> Bool
$c/= :: EmojiName -> EmojiName -> Bool
== :: EmojiName -> EmojiName -> Bool
$c== :: EmojiName -> EmojiName -> Bool
Eq, b -> EmojiName -> EmojiName
NonEmpty EmojiName -> EmojiName
EmojiName -> EmojiName -> EmojiName
(EmojiName -> EmojiName -> EmojiName)
-> (NonEmpty EmojiName -> EmojiName)
-> (forall b. Integral b => b -> EmojiName -> EmojiName)
-> Semigroup EmojiName
forall b. Integral b => b -> EmojiName -> EmojiName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> EmojiName -> EmojiName
$cstimes :: forall b. Integral b => b -> EmojiName -> EmojiName
sconcat :: NonEmpty EmojiName -> EmojiName
$csconcat :: NonEmpty EmojiName -> EmojiName
<> :: EmojiName -> EmojiName -> EmojiName
$c<> :: EmojiName -> EmojiName -> EmojiName
Semigroup, Semigroup EmojiName
EmojiName
Semigroup EmojiName
-> EmojiName
-> (EmojiName -> EmojiName -> EmojiName)
-> ([EmojiName] -> EmojiName)
-> Monoid EmojiName
[EmojiName] -> EmojiName
EmojiName -> EmojiName -> EmojiName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EmojiName] -> EmojiName
$cmconcat :: [EmojiName] -> EmojiName
mappend :: EmojiName -> EmojiName -> EmojiName
$cmappend :: EmojiName -> EmojiName -> EmojiName
mempty :: EmojiName
$cmempty :: EmojiName
$cp1Monoid :: Semigroup EmojiName
Monoid, Value -> Parser [EmojiName]
Value -> Parser EmojiName
(Value -> Parser EmojiName)
-> (Value -> Parser [EmojiName]) -> FromJSON EmojiName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EmojiName]
$cparseJSONList :: Value -> Parser [EmojiName]
parseJSON :: Value -> Parser EmojiName
$cparseJSON :: Value -> Parser EmojiName
FromJSON, EmojiName -> ByteString
EmojiName -> Builder
EmojiName -> Text
(EmojiName -> Text)
-> (EmojiName -> Builder)
-> (EmojiName -> ByteString)
-> (EmojiName -> Text)
-> ToHttpApiData EmojiName
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: EmojiName -> Text
$ctoQueryParam :: EmojiName -> Text
toHeader :: EmojiName -> ByteString
$ctoHeader :: EmojiName -> ByteString
toEncodedUrlPiece :: EmojiName -> Builder
$ctoEncodedUrlPiece :: EmojiName -> Builder
toUrlPiece :: EmojiName -> Text
$ctoUrlPiece :: EmojiName -> Text
ToHttpApiData )

-- | Smart constructor for 'EmojiName's, which may only contain alphanumeric characters,
-- \'_\', \'-\', and \'&\', and may not exceed 24 characters in length
mkEmojiName :: MonadThrow m => Text -> m EmojiName
mkEmojiName :: Text -> m EmojiName
mkEmojiName = Maybe String -> Maybe (Int, Int) -> Text -> Text -> m EmojiName
forall (m :: * -> *) a.
(MonadThrow m, Coercible a Text) =>
Maybe String -> Maybe (Int, Int) -> Text -> Text -> m a
validateName (String -> Maybe String
forall a. a -> Maybe a
Just [ Char
'_', Char
'-', Char
'&' ]) ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
24)) Text
"EmojiName"

-- | Wrapper for parsing response JSON. Subreddit emojis must be extracted from a
-- larger structure
newtype EmojiList = EmojiList (Seq Emoji)
    deriving stock ( Int -> EmojiList -> ShowS
[EmojiList] -> ShowS
EmojiList -> String
(Int -> EmojiList -> ShowS)
-> (EmojiList -> String)
-> ([EmojiList] -> ShowS)
-> Show EmojiList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmojiList] -> ShowS
$cshowList :: [EmojiList] -> ShowS
show :: EmojiList -> String
$cshow :: EmojiList -> String
showsPrec :: Int -> EmojiList -> ShowS
$cshowsPrec :: Int -> EmojiList -> ShowS
Show, (forall x. EmojiList -> Rep EmojiList x)
-> (forall x. Rep EmojiList x -> EmojiList) -> Generic EmojiList
forall x. Rep EmojiList x -> EmojiList
forall x. EmojiList -> Rep EmojiList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmojiList x -> EmojiList
$cfrom :: forall x. EmojiList -> Rep EmojiList x
Generic )

instance FromJSON EmojiList where
    parseJSON :: Value -> Parser EmojiList
parseJSON = String -> (Object -> Parser EmojiList) -> Value -> Parser EmojiList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EmojiList"
        ((Object -> Parser EmojiList) -> Value -> Parser EmojiList)
-> (Object -> Parser EmojiList) -> Value -> Parser EmojiList
forall a b. (a -> b) -> a -> b
$ ([Emoji] -> EmojiList) -> Parser [Emoji] -> Parser EmojiList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq Emoji -> EmojiList
EmojiList (Seq Emoji -> EmojiList)
-> ([Emoji] -> Seq Emoji) -> [Emoji] -> EmojiList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Emoji] -> Seq Emoji
forall l. IsList l => [Item l] -> l
fromList) (Parser [Emoji] -> Parser EmojiList)
-> (Object -> Parser [Emoji]) -> Object -> Parser EmojiList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Parser [Emoji]
emojiListP
      where
        emojiListP :: Object -> Parser [Emoji]
emojiListP Object
o = case Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o of
            [ (Text, Value)
_, (Text
sid, Object Object
es) ] -> [(Text, Value)]
-> ((Text, Value) -> Parser Emoji) -> Parser [Emoji]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
es) (((Text, Value) -> Parser Emoji) -> Parser [Emoji])
-> ((Text, Value) -> Parser Emoji) -> Parser [Emoji]
forall a b. (a -> b) -> a -> b
$ \(Text
n, Value
e) ->
                -- HACK make sure that this is a valid subreddit ID
                Value -> Parser SubredditID
forall a. FromJSON a => Value -> Parser a
parseJSON @SubredditID (Text -> Value
String Text
sid) --
                Parser SubredditID -> Parser Emoji -> Parser Emoji
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> Parser Emoji
forall a. FromJSON a => Value -> Parser a
parseJSON @Emoji Value
e
                Parser Emoji -> (Emoji -> Emoji) -> Parser Emoji
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall s t a b. HasField "name" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"name" ((EmojiName -> Identity EmojiName) -> Emoji -> Identity Emoji)
-> EmojiName -> Emoji -> Emoji
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> EmojiName
coerce Text
n
            [(Text, Value)]
_ -> Parser [Emoji]
forall a. Monoid a => a
mempty