{-# 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
      name             :: EmojiName
      -- | This field will be present when obtaining existing emojis, but
      -- should be left empty when creating new ones
    , modFlairOnly     :: Bool
    , postFlairAllowed :: Bool
    , userFlairAllowed :: Bool
      -- | Points to a Reddit-hosted image. This will be present for
      --  existing emoji, but should be left empty when creating them
    , createdBy        :: Maybe UserID
    , url              :: Maybe UploadURL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Emoji where
    parseJSON = withObject "Emoji" $ \o -> Emoji mempty
        <$> o .: "mod_flair_only"
        <*> o .: "post_flair_allowed"
        <*> o .: "user_flair_allowed"
        <*> o .: "created_by"
        <*> o .: "url"

instance ToForm Emoji where
    toForm Emoji { .. } =
        fromList [ ("mod_flair_only", toQueryParam modFlairOnly)
                 , ("post_flair_allowed", toQueryParam postFlairAllowed)
                 , ("user_flair_allowed", toQueryParam userFlairAllowed)
                 ]

-- | Wrapper for creating new 'Emoji's, which includes the @name@ field
newtype NewEmoji = NewEmoji Emoji
    deriving stock ( Show, Generic )

instance ToForm NewEmoji where
    toForm (NewEmoji emoji@Emoji { name }) =
        toForm emoji <> fromList [ ("name", toQueryParam name) ]

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

-- | The name of an individual 'Emoji'
newtype EmojiName = EmojiName Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, Semigroup, Monoid, FromJSON, 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 = validateName (Just [ '_', '-', '&' ]) (Just (1, 24)) "EmojiName"

-- | Wrapper for parsing response JSON. Subreddit emojis must be extracted from a
-- larger structure
newtype EmojiList = EmojiList (Seq Emoji)
    deriving stock ( Show, Generic )

instance FromJSON EmojiList where
    parseJSON = withObject "EmojiList"
        $ fmap (EmojiList . fromList) . emojiListP
      where
        emojiListP o = case HM.toList o of
            [ _, (sid, Object es) ] -> for (HM.toList es) $ \(n, e) ->
                -- HACK make sure that this is a valid subreddit ID
                parseJSON @SubredditID (String sid) --
                >> parseJSON @Emoji e
                <&> field @"name" .~ coerce n
            _ -> mempty