{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Live
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Live
    ( LiveThread(..)
    , LiveThreadID(LiveThreadID)
    , PostableLiveThread(..)
    , NewLiveThread
    , UpdatedLiveThread
    , liveThreadToPostable
    , mkNewLiveThread
    , PostedLiveThread
    , LiveUpdate(..)
    , LiveUpdateID(LiveUpdateID)
    , LiveUpdateEmbed(..)
    , LiveContributor(..)
    , LiveContributorList(..)
    , LivePermission(..)
    , LiveReportType(..)
    , LiveState(..)
    ) where

import           Control.Monad                 ( (<=<) )

import           Data.Aeson
                 ( (.!=)
                 , (.:)
                 , (.:?)
                 , FromJSON(parseJSON)
                 , Options(constructorTagModifier)
                 , Value(Object)
                 , defaultOptions
                 , genericParseJSON
                 , withArray
                 , withObject
                 , withText
                 )
import           Data.Char                     ( toLower )
import           Data.Coerce                   ( coerce )
import           Data.Foldable                 ( asum )
import           Data.Maybe                    ( fromMaybe )
import           Data.Sequence                 ( Seq )
import           Data.Text                     ( Text )
import           Data.Time                     ( UTCTime )

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

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

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

-- | An existing Reddit live thread. It may be currently live or already
-- complete
data LiveThread = LiveThread
    { liveThreadID    :: LiveThreadID
    , title           :: Title
    , description     :: Maybe Body
    , descriptionHTML :: Maybe Body
    , resources       :: Maybe Body
    , resourcesHTML   :: Maybe Body
    , created         :: UTCTime
      -- | The current number of viewers; will be @Nothing@ if the
      -- @liveState@ is 'Complete'
    , viewerCount     :: Maybe Integer
    , liveState       :: LiveState
    , nsfw            :: Bool
      -- | If the thread is still live, this will allow you to connect to
      -- a websocket server to receive live updates as the thread progresses
    , websocketURL    :: Maybe URL
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON LiveThread where
    parseJSON = withKind LiveThreadKind "LiveThread" $ \o -> LiveThread
        <$> o .: "id"
        <*> o .: "title"
        <*> (nothingTxtNull =<< o .: "description")
        <*> (nothingTxtNull =<< o .: "description_html")
        <*> (nothingTxtNull =<< o .: "resources")
        <*> (nothingTxtNull =<< o .: "resources_html")
        <*> (integerToUTC <$> o .: "created_utc")
        <*> o .: "viewer_count"
        <*> o .: "state"
        <*> o .: "nsfw"
        <*> o .:? "websocket_url"

-- The endpoints that list @LiveThread@s are a @Listing@, but there are no
-- additional options that can be passed to them. This dummy instance at least
-- allows using a @Listing ... LiveThread@ with existing convenience actions
instance Paginable LiveThread where
    type PaginateOptions LiveThread = ()

    type PaginateThing LiveThread = LiveThreadID

    defaultOpts = ()

    optsToForm _ = mempty

    getFullname LiveThread { liveThreadID } = liveThreadID

-- | ID for a single 'LiveThread'
newtype LiveThreadID = LiveThreadID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, ToHttpApiData )

instance FromJSON LiveThreadID where
    parseJSON =
        withText "LiveThreadID" $ coerce . dropTypePrefix LiveThreadKind

instance Thing LiveThreadID where
    fullname (LiveThreadID ltid) = prependType LiveThreadKind ltid

-- | The state of the 'LiveThread'
data LiveState
    = Current
    | Complete
    deriving stock ( Show, Eq, Generic )

instance FromJSON LiveState where
    parseJSON = withText "LiveState" $ \case
        "live"     -> pure Current
        "complete" -> pure Complete
        _          -> mempty

-- | Data to create a new 'LiveThread' or update an existing one. In the latter
-- case, see 'liveThreadToPostable' for conversion
data PostableLiveThread = PostableLiveThread
    { title       :: Title
      -- | Markdown-formatted; if @Nothing@, defaults to an empty string
    , description :: Maybe Body
      -- | Markdown-formatted; if @Nothing@, defaults to an empty string
    , resources   :: Maybe Body
    , nsfw        :: Bool
    }
    deriving stock ( Show, Eq, Generic )

instance ToForm PostableLiveThread where
    toForm PostableLiveThread { .. } =
        fromList [ ("title", title)
                 , ("description", fromMaybe mempty description)
                 , ("resources", fromMaybe mempty description)
                 , ("nsfw", toQueryParam nsfw)
                 , ("api_type", "json")
                 ]

-- | Type synonym for creating new live threads
type NewLiveThread = PostableLiveThread

-- | Type synonym for updating existing live threads
type UpdatedLiveThread = PostableLiveThread

-- | Create a 'NewLiveThread' with default values for most fields
mkNewLiveThread :: Title -> NewLiveThread
mkNewLiveThread title = PostableLiveThread
    { title
    , description = Nothing
    , resources   = Nothing  --
    , nsfw        = False
    }

-- | Convenience function to transform an existing 'LiveThread' into
-- a 'PostableLiveThread', which may be used in updates
liveThreadToPostable :: LiveThread -> UpdatedLiveThread
liveThreadToPostable LiveThread { .. } = PostableLiveThread { .. }

-- | Wrapper for parsing the ID returned from POSTing a livethred
newtype PostedLiveThread = PostedLiveThread LiveThreadID
    deriving stock ( Show, Generic )

instance FromJSON PostedLiveThread where
    parseJSON = withObject "PostedLiveThread"
        $ fmap PostedLiveThread . ((.: "id") <=< (.: "data") <=< (.: "json"))

-- | An individual update in a 'LiveThread'
data LiveUpdate = LiveUpdate
    { liveUpdateID :: LiveUpdateID
    , author       :: Username
    , body         :: Body
    , bodyHTML     :: Body
    , stricken     :: Bool
    , embeds       :: Seq LiveUpdateEmbed
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON LiveUpdate where
    parseJSON = withKind LiveUpdateKind "LiveUpdate" $ \o -> LiveUpdate
        <$> o .: "name"
        <*> o .: "author" .!= DeletedUser
        <*> o .: "body"
        <*> o .: "body_html"
        <*> o .: "stricken"
        <*> o .: "embeds"

-- The endpoints that list @LiveUpdate@s are a @Listing@, but there are no
-- additional options that can be passed to them. This dummy instance at least
-- allows using a @Listing ... LiveUpdate@ with existing convenience actions
instance Paginable LiveUpdate where
    type PaginateOptions LiveUpdate = ()

    type PaginateThing LiveUpdate = LiveUpdateID

    defaultOpts = ()

    optsToForm _ = mempty

    getFullname LiveUpdate { liveUpdateID } = liveUpdateID

-- | ID for a 'LiveUpdate'
newtype LiveUpdateID = LiveUpdateID Text
    deriving stock ( Show, Generic )
    deriving newtype ( Eq, ToHttpApiData )

instance Thing LiveUpdateID where
    fullname (LiveUpdateID lid) = prependType LiveUpdateKind lid

instance FromJSON LiveUpdateID where
    parseJSON =
        withText "LiveUpdateID" $ coerce . dropTypePrefix LiveUpdateKind

-- | External resources embedded in a 'LiveUpdate'
data LiveUpdateEmbed = LiveUpdateEmbed
    { -- | URL pointing to a Reddit-external resource
      url    :: URL
    , height :: Maybe Integer
    , width  :: Maybe Integer
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON LiveUpdateEmbed

-- | A user contributor in a 'LiveThread'
data LiveContributor = LiveContributor
    { userID      :: UserID
    , username    :: Username
    , permissions :: [LivePermission]
    }
    deriving stock ( Show, Eq, Generic )

instance FromJSON LiveContributor where
    parseJSON = withObject "LiveContributor" $ \o -> LiveContributor
        <$> o .: "id"
        <*> o .: "name"
        <*> (permissionsP =<< o .: "permissions")
      where
        permissionsP = withArray "[LivePermission]" $ \a -> case toList a of
            [ "all" ] -> pure $ fromList [ Edit .. Manage ]
            xs        -> traverse parseJSON xs

-- | Wrapper to parse lists of 'LiveContributor's
newtype LiveContributorList = LiveContributorList (Seq LiveContributor)
    deriving stock ( Show, Generic )

instance FromJSON LiveContributorList where
    -- Depending on the number of contributors, the actual type of the returned
    -- JSON changes
    parseJSON v = asum [ contribArray v, contribObject v ]
      where
        contribArray  =
            withArray "[LiveContributorList]" $ \a -> case toList a of
                o@(Object _) : _ -> contribObject o
                _                -> mempty

        contribObject = withKind UserListKind "LiveContributorList"
            $ fmap (LiveContributorList . fromList)
            . (contribListP <=< (.: "children"))

        contribListP  =
            withArray "[LiveContributor]" (traverse parseJSON . toList)

-- | Permission granted to a 'LiveContributor'
data LivePermission
    = Edit
    | Update
    | Manage
    | Settings
    deriving stock ( Show, Eq, Generic, Ord, Enum, Bounded )

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

instance ToHttpApiData LivePermission where
    toQueryParam = showTextData

-- | The reason for reporting the 'LiveThread' to the Reddit admins
data LiveReportType
    = Spam
    | VoteManipulation
    | PersonalInfo
    | Sexualizing
    | SiteBreaking
    deriving stock ( Show, Eq, Generic )

instance ToHttpApiData LiveReportType where
    toQueryParam = \case
        Spam             -> "spam"
        VoteManipulation -> "vote-manipulation"
        PersonalInfo     -> "personal-info"
        Sexualizing      -> "sexualizing-minors"
        SiteBreaking     -> "site-breaking"