{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      : Network.Reddit.Types.Award
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Award
    ( Awarding
    , AwardID(AwardID, Silver, Gold, Platinum, Argentium, Ternion)
    , AwardType(..)
    , Award(..)
    , mkAward
    , Trophy
    , TrophyID
    , TrophyList
    , AwardingsSummary(..)
    ) where

import           Control.Monad                  ( (<=<) )

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , FromJSON(parseJSON)
                 , FromJSONKey
                 , Options(..)
                 , defaultOptions
                 , genericParseJSON
                 , withArray
                 , withText
                 )
import           Data.Aeson.Casing              ( snakeCase )
import           Data.Char                      ( toLower )
import           Data.HashMap.Strict            ( HashMap )
import           Data.Hashable                  ( Hashable )
import           Data.Sequence                  ( Seq )
import           Data.Text                      ( Text )
import           Data.Time                      ( UTCTime )

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

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

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

-- | Information about a Reddit award that has been granted. This can be a
-- \"global\" award that may be granted site-wide, or a \"community\" award
-- that is limited to a single subreddit
data Awarding = Awarding
    { awardID       :: AwardID
    , name          :: Name
      -- | This will only be present for 'Community' awards
    , description   :: Body
    , subredditID   :: Maybe SubredditID
    , awardType     :: AwardType
    , count         :: Int
      -- | The number of \"creddits\" required to grant the award
    , coinPrice     :: Int
      -- | The number of \"creddits\" given to the recipient
    , coinReward    :: Int
      -- | How many days of premium Reddit the awardee is granted
    , daysOfPremium :: Int
      -- | URL of Reddit-hosted icon image
    , iconURL       :: URL
      -- | Width of the icon in pixels
    , iconHeight    :: Int
      -- | Width of the icon in pixels
    , iconWidth     :: Int
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Awarding where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier }
      where
        fieldLabelModifier = \case
            "awardID"     -> "id"
            "subredditID" -> "subreddit_id"
            "iconURL"     -> "icon_url"
            s             -> snakeCase s

-- | The ID for an award, which users can grant each other. If you want to create
-- a new 'AwardID', see the bundled pattern synonyms for this type, which include
-- various common awards. Also see \"doc/awards.org\" in this repository for a list
-- of awards and their IDs.
--
-- __Note__: Most newer awards are composed of a UUID identifier and an \"award_\"
-- prefix. If you construct this type directly, you should omit the prefix, which
-- will be added for you when making API requests
newtype AwardID = AwardID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, FromJSONKey, Hashable )

instance FromJSON AwardID where
    parseJSON = withText "AwardID" $ breakOnTypeLenient "award"

instance ToHttpApiData AwardID where
    toQueryParam aw@(AwardID a)
        | aw `elem` [ Silver, Gold, Platinum ] = a
        | otherwise = "award_" <> a

-- | The type of the 'Awarding', either site-wide (\"global\") or limited to a
-- \"community\"
data AwardType
    = Global
    | Community
    deriving stock ( Show, Eq, Generic )

instance FromJSON AwardType where
    parseJSON = genericParseJSON --
        defaultOptions { constructorTagModifier = fmap toLower }

-- | Options for awarding an item
data Award = Award
    { -- | The ID of the award you wish to grant. See 'AwardID' and
      -- its bundled pattern synonyms for common awards (e.g. gold)
      awardID     :: AwardID
      -- | If the award is issued anonymously
    , isAnonymous :: Bool
      -- | Optional message sent to the recipient
    , message     :: Maybe Body
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm Award where
    toForm Award { .. } = fromList
        $ [ ("gild_type", toQueryParam awardID)
          , ("is_anonymous", toQueryParam isAnonymous)
          , ("api_type", "json")
          ]
        <> foldMap pure (("award", ) <$> message)

-- | Create a new anonymous 'Awarding' without a message, given an 'AwardID'
mkAward :: AwardID -> Award
mkAward awardID = Award { isAnonymous = True, message = Nothing, .. }

-- | A summary of your 'Awardings', returned after you have awarded an item
data AwardingsSummary = AwardingsSummary
    { -- | All of the awardings issued by the current user
      allAwardings :: Seq Awarding
      -- | A mapping of award IDs to the number of times the
      -- authenticated user has granted each one
    , gildings     :: HashMap AwardID Integer
      -- | Coin balance for the authenticated user
    , coins        :: Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON AwardingsSummary where
    parseJSON =
        genericParseJSON defaultOptions { fieldLabelModifier = snakeCase }

-- | A Reddit trophy, such as the \"one-year club\", that the Reddit grants
-- users. Redditors cannot gift each other these trophies
data Trophy = Trophy
    { name        :: Name
    , trophyID    :: Maybe TrophyID
      -- | It is not clear what this field is referring to, as 'Trophy's and
      -- 'Award's are supposed to be entirely distinct, according to Reddit
    , awardID     :: Maybe Text
    , description :: Maybe Body
    , grantedAt   :: Maybe UTCTime
    , url         :: Maybe URL
      -- | URL for a 41x41 px icon
    , icon40      :: URL
      -- | URL for a 71x71 px icon
    , icon70      :: URL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON Trophy where
    parseJSON = withKind AwardKind "Trophy" $ \o -> Trophy <$> o .: "name"
        <*> o .:? "id"
        <*> o .:? "award_id"
        <*> o .:? "description"
        <*> (fmap integerToUTC <$> o .:? "granted_at")
        <*> o .:? "url"
        <*> o .: "icon_40"
        <*> o .: "icon_70"

-- | The ID of a 'Trophy'
type TrophyID = Text

-- | Wrapper for parsing JSON objects listing 'Trophy's
newtype TrophyList = TrophyList (Seq Trophy)
    deriving stock ( Show, Generic )

instance FromJSON TrophyList where
    parseJSON = withKind TrophyListKind "TrophyList"
        $ fmap (TrophyList . fromList) . (trophiesP <=< (.: "trophies"))
      where
        trophiesP = withArray "[Trophy]" (traverse parseJSON . toList)

pattern Silver :: AwardID
pattern Silver = AwardID "gid_1"

pattern Gold :: AwardID
pattern Gold = AwardID "gid_2"

pattern Platinum :: AwardID
pattern Platinum = AwardID "gid_3"

pattern Argentium :: AwardID
pattern Argentium = AwardID "4ca5a4e6-8873-4ac5-99b9-71b1d5161a91"

pattern Ternion :: AwardID
pattern Ternion = AwardID "2385c499-a1fb-44ec-b9b7-d260f3dc55de"