module Spotify.Servant.Playlists where

import Spotify.Servant.Core
import Spotify.Types.Internal.CustomJSON
import Spotify.Types.Misc
import Spotify.Types.Playlists
import Spotify.Types.Simple

import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Servant.API (
    Capture,
    type (:>),
 )

type GetPlaylist =
    "playlists"
        :> Capture "playlist_id" PlaylistID
        :> SpotGet Playlist

type AddToPlaylist =
    "playlists"
        :> Capture "playlist_id" PlaylistID
        :> "tracks"
        :> SpotBody AddToPlaylistBody
        :> SpotPostCreated AddToPlaylistResponse
data AddToPlaylistBody = AddToPlaylistBody
    { AddToPlaylistBody -> Maybe Int
position :: Maybe Int
    , AddToPlaylistBody -> [URI]
uris :: [URI]
    }
    deriving (forall x. Rep AddToPlaylistBody x -> AddToPlaylistBody
forall x. AddToPlaylistBody -> Rep AddToPlaylistBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddToPlaylistBody x -> AddToPlaylistBody
$cfrom :: forall x. AddToPlaylistBody -> Rep AddToPlaylistBody x
Generic)
    deriving ([AddToPlaylistBody] -> Encoding
[AddToPlaylistBody] -> Value
AddToPlaylistBody -> Encoding
AddToPlaylistBody -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AddToPlaylistBody] -> Encoding
$ctoEncodingList :: [AddToPlaylistBody] -> Encoding
toJSONList :: [AddToPlaylistBody] -> Value
$ctoJSONList :: [AddToPlaylistBody] -> Value
toEncoding :: AddToPlaylistBody -> Encoding
$ctoEncoding :: AddToPlaylistBody -> Encoding
toJSON :: AddToPlaylistBody -> Value
$ctoJSON :: AddToPlaylistBody -> Value
ToJSON)
newtype AddToPlaylistResponse = AddToPlaylistResponse
    { AddToPlaylistResponse -> SnapshotID
snapshotId :: SnapshotID
    }
    deriving (forall x. Rep AddToPlaylistResponse x -> AddToPlaylistResponse
forall x. AddToPlaylistResponse -> Rep AddToPlaylistResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddToPlaylistResponse x -> AddToPlaylistResponse
$cfrom :: forall x. AddToPlaylistResponse -> Rep AddToPlaylistResponse x
Generic)
    deriving (Value -> Parser [AddToPlaylistResponse]
Value -> Parser AddToPlaylistResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AddToPlaylistResponse]
$cparseJSONList :: Value -> Parser [AddToPlaylistResponse]
parseJSON :: Value -> Parser AddToPlaylistResponse
$cparseJSON :: Value -> Parser AddToPlaylistResponse
FromJSON) via CustomJSON AddToPlaylistResponse

type GetMyPlaylists =
    "me"
        :> "playlists"
        :> SpotPaging PlaylistSimple

type CreatePlaylist =
    "users"
        :> Capture "user_id" UserID
        :> "playlists"
        :> SpotBody CreatePlaylistOpts
        :> SpotPostCreated PlaylistSimple
data CreatePlaylistOpts = CreatePlaylistOpts
    { CreatePlaylistOpts -> Text
name :: Text
    , CreatePlaylistOpts -> Bool
public :: Bool
    , CreatePlaylistOpts -> Bool
collaborative :: Bool
    , CreatePlaylistOpts -> Text
description :: Text
    }
    deriving (forall x. Rep CreatePlaylistOpts x -> CreatePlaylistOpts
forall x. CreatePlaylistOpts -> Rep CreatePlaylistOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePlaylistOpts x -> CreatePlaylistOpts
$cfrom :: forall x. CreatePlaylistOpts -> Rep CreatePlaylistOpts x
Generic)
    deriving ([CreatePlaylistOpts] -> Encoding
[CreatePlaylistOpts] -> Value
CreatePlaylistOpts -> Encoding
CreatePlaylistOpts -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreatePlaylistOpts] -> Encoding
$ctoEncodingList :: [CreatePlaylistOpts] -> Encoding
toJSONList :: [CreatePlaylistOpts] -> Value
$ctoJSONList :: [CreatePlaylistOpts] -> Value
toEncoding :: CreatePlaylistOpts -> Encoding
$ctoEncoding :: CreatePlaylistOpts -> Encoding
toJSON :: CreatePlaylistOpts -> Value
$ctoJSON :: CreatePlaylistOpts -> Value
ToJSON)